Testing First
I’m not a TDD guy, but I am intrigued by it. With TDD, you write a test that fails and then write code to make it pass. Then you write another test that fails and write code to make it pass. Every so often you stop to refactor the code. I’m not an expert, so this may be overly simplistic or just plain wrong. If I used this methodology, I would end up with a crap load more tests than I do now. Maybe that’s a good thing.
What I like, in principal, about TDD is that nothing slips through the cracks. What I don’t like about it is that implementing it in VBA is probably a big headache. Mike Woodhouse has done some good work in this area, but I wanted to trying something simple from scratch to see what there is to see.
In my scenario, I’m computing commission for salesguys. A salesguy has a standard rate that he earns up to $100k of sales. From $100k to $500k, he gets 1.5 times that rate. And from $500k up, he gets 2x that rate. My first test is to check the commission on the first dollar.
'and 2x over $500k
Sub testFirstDollarShouldBeAtStandardRate()
Dim clsSalesGuy As csalesguy
Dim clsSale As csale
Set clsSalesGuy = New csalesguy
Set clsSale = New csale
clsSale.SaleDate = #1/1/2012#
clsSale.amount = 1
clsSalesGuy.standardrate = 0.1
clsSalesGuy.sales.Add clsSale
Debug.Assert clsSalesGuy.commission = 0.1
End Sub
This doesn’t even compile. Literally all I did was add a module called MTest and write this test. I get no intellisense because I haven’t even created the classes yet. The first compile error is on the csalesguy line, so I’m going to create that class.
Private mdStandardRate As Double
Private mclsSales As csales
Public Property Let SalesGuyID(ByVal lSalesGuyID As Long): mlSalesGuyID = lSalesGuyID: End Property
Public Property Get SalesGuyID() As Long: SalesGuyID = mlSalesGuyID: End Property
Public Property Let StandardRate(ByVal dStandardRate As Double): mdStandardRate = dStandardRate: End Property
Public Property Get StandardRate() As Double: StandardRate = mdStandardRate: End Property
Public Property Set Sales(ByVal clsSales As csales): Set mclsSales = clsSales: End Property
Public Property Get Sales() As csales: Set Sales = mclsSales: End Property
Private Sub Class_Initialize()
Set mclsSales = New csales
End Sub
Private Sub Class_Terminate()
Set mclsSales = Nothing
End Sub
Now I need a CSales class. I create a CSale class with SaleDate and Amount and use my VBHelpers add-in to create the CSales parent class. The next compile error is that I don’t have a Commission property of the CSalesGuy class.
Commission = Me.Sales.Total * Me.StandardRate
End Property
And in the CSales class:
Dim clsSale As CSale
Dim dReturn As Double
For Each clsSale In Me
dReturn = dReturn + clsSale.Amount
Next clsSale
Total = dReturn
End Property
Everything compiles, I run my test, and it works. So far so good. Next I want to test just below the first threshold, so I add another test and a procedure to run all tests.
Dim clsSale As CSale
Dim clsSalesGuy As CSalesGuy
Set clsSalesGuy = New CSalesGuy
clsSalesGuy.StandardRate = 0.1
Set clsSale = New CSale
clsSale.SaleDate = #1/1/2012#
clsSale.Amount = 100000
clsSalesGuy.Sales.Add clsSale
Debug.Assert clsSalesGuy.Commission = 10000
End Sub
Sub testAll()
testFirstDollarShouldBeAtStandardRate
testJustUnderFirstThresholdShouldBeAtStandardRate
End Sub
And they pass. I guess I didn’t write a test that failed, but I will this time. Next I want to test just over the first tier of sales.
Dim clsSale As CSale
Dim clsSalesGuy As CSalesGuy
Set clsSalesGuy = New CSalesGuy
clsSalesGuy.StandardRate = 0.1
Set clsSale = New CSale
clsSale.SaleDate = #1/1/2012#
clsSale.Amount = 100001
clsSalesGuy.Sales.Add clsSale
Debug.Assert clsSalesGuy.Commission = 10000.15
End Sub
That fails. So I fix my commission property.
Dim dTotal As Double
Dim cReturn As Currency
dTotal = Me.Sales.Total
If dTotal > 100000 Then
cReturn = 100000 * Me.StandardRate + ((dTotal - 100000) * Me.StandardRate * 1.5)
Else
cReturn = dTotal * Me.StandardRate
End If
Commission = cReturn
End Property
Note that I changed the data type to Currency to eliminate the precision errors. This is obviously not optimal code, but I think the idea is to write the minimum code to make the test pass, then refactor. Next up, I test just under the next threshold.
Dim clsSale As CSale
Dim clsSalesGuy As CSalesGuy
Set clsSalesGuy = New CSalesGuy
clsSalesGuy.StandardRate = 0.1
Set clsSale = New CSale
clsSale.SaleDate = #1/1/2012#
clsSale.Amount = 500000
clsSalesGuy.Sales.Add clsSale
Debug.Assert clsSalesGuy.Commission = CCur((100000 * 0.1) + (400000 * 0.15))
End Sub
That passes as expected. My last test case is over the second threshold.
Dim clsSale As CSale
Dim clsSalesGuy As CSalesGuy
Set clsSalesGuy = New CSalesGuy
clsSalesGuy.StandardRate = 0.1
Set clsSale = New CSale
clsSale.SaleDate = #1/1/2012#
clsSale.Amount = 500001
clsSalesGuy.Sales.Add clsSale
Debug.Assert clsSalesGuy.Commission = CCur((100000 * 0.1) + (400000 * 0.15) + (1 * 0.2))
End Sub
Now to fix up Commission to pass the test
Dim dTotal As Double
Dim cReturn As Currency
dTotal = Me.Sales.Total
Select Case True
Case dTotal > 500000
cReturn = (100000 * Me.StandardRate) + (400000 * Me.StandardRate * 1.5) + ((dTotal - 500000) * Me.StandardRate * 2)
Case dTotal > 100000
cReturn = (100000 * Me.StandardRate) + ((dTotal - 100000) * Me.StandardRate * 1.5)
Case Else
cReturn = dTotal * Me.StandardRate
End Select
Commission = cReturn
End Property
And they all pass. Now I have only to refactor. That’s not insignificant as this is some really crappy code. The first thing I want to do is create a CRates class to hold all of the rates. The business rule of 1.5x and 2x is fine, but that could change so I need some flexibility. I create a CRate class with Rate and Threshold properties and make the parent CRates class a child of the CSalesGuy class. In CSalesGuy:
Public Property Set Rates(ByVal clsRates As CRates): Set mclsRates = clsRates: End Property
Public Property Get Rates() As CRates: Set Rates = mclsRates: End Property
Private Sub Class_Initialize()
Set mclsSales = New CSales
Set mclsRates = New CRates
End Sub
Private Sub Class_Terminate()
Set mclsSales = Nothing
Set mclsRates = Nothing
End Sub
Then I create a test setup function to instantiate the SalesGuy
Dim clsReturn As CSalesGuy
Dim clsRate As CRate
Dim dRate As Double
dRate = 0.1
Set clsReturn = New CSalesGuy
Set clsRate = New CRate
clsRate.Rate = dRate
clsRate.Threshold = 0
clsReturn.Rates.Add clsRate
Set clsRate = New CRate
clsRate.Rate = dRate * 1.5
clsRate.Threshold = 100000
clsReturn.Rates.Add clsRate
Set clsRate = New CRate
clsRate.Rate = dRate * 2
clsRate.Threshold = 500000
clsReturn.Rates.Add clsRate
Set testsetupSalesGuy = clsReturn
End Function
Finally, I need to change the Commission property to use the Rates rather than the (now eliminated) StandardRate property.
Dim dTotal As Double
Dim cReturn As Currency
Dim clsRate As CRate
dTotal = Me.Sales.Total
For Each clsRate In Me.Rates
If dTotal > clsRate.Threshold Then
cReturn = cReturn + ((dTotal - clsRate.Threshold) * (clsRate.IncrementalRate))
End If
Next clsRate
Commission = cReturn
End Property
That requires an IncrementalRate property of the CRate class.
Dim clsRate As CRate
Dim clsNext As CRate
Dim dMax As Double
For Each clsRate In Me.Parent
If clsRate.Threshold >= dMax And clsRate.Threshold < Me.Threshold Then
dMax = clsRate.Threshold
Set clsNext = clsRate
End If
Next clsRate
If clsNext Is Nothing Then
IncrementalRate = Me.Rate
Else
IncrementalRate = Me.Rate - clsNext.Rate
End If
End Property
All of my tests pass, so I should be good right? It’s nice to be able to refactor the code and see that all the results are still correct. I made the commission rates model more flexible to allow for an unlimited number of sales tiers, but I’m still only testing my original business rules. Maybe I should add more tests, but then it’s not really the tests that drive the development. Do you write tests first? If so, how would you do it differently?
You can download TDD_VBA.zip
