Python-inspired Doc Tests in VBA
Python has a module named doctest. It supports the concept of verifiable documentation. You write usage examples alongside your function. You can then run tests against those examples to verify they are correct.
Why I love the "doc tests" concept
I love this concept for several reasons.
- Learning by example is the programming equivalent to "a picture is worth a thousand words." It's a concise and effective way to show how a function works.
- The documentation doesn't go stale. One of the pitfalls of code comments is that there is nothing forcing them to keep up with the code. Doc testing avoids this problem by verifying that the usage examples are correct. If the code gets out of sync with the usage examples, the tests will break.
- Writing tests is simple and easy. In fact, you're probably already writing them if you include usage samples in your function headers. With a couple of tweaks to your comment formatting, you can convert those usage examples into verifiable documentation tests.
Doc tests vs other kinds of tests
Doc tests are not a replacement for unit or integration testing. But they do provide the best return on investment (ROI) of any type of test, mostly because the effort to write them is near zero.
Deterministic vs. nondeterministic functions
Doc tests work best on deterministic functions that always return the same output given the same set of inputs. It's easiest to explain deterministic functions by showing an example of a nondeterministic function:
'Example of a nondeterministic function:
Function Tomorrow() As Date
Tomorrow = VBA.Date + 1
End Function
'Example of a deterministic equivalent function
Function NextDay(StartDate As Date) As Date
NextDay = StartDate + 1
End Function
The function Tomorrow() is nondeterministic. It accepts no inputs. Yet, given that same input (or lack thereof), it will return a different value literally every single day. Its output is entirely dependent on machine state that is outside of the function's control.
In contrast, the NextDay() function is deterministic. If we pass it a date of #9/21/2020#, it will always return #9/22/2020#. The external state of our system has no impact on the function's output.
Writing doc tests
For consistency, I adopted the doctest format from Python. You precede a sample function call with an apostrophe (to start the comment), then three consecutive greater-than signs, and then the sample function call: '>>>NextDay(#9/21/2020#). You then enter the output on the following line. Here's an example:
'>>> NextDay(#9/21/2020#)
'9/22/2020
By convention, I always place these lines directly above the start of the function.
'>>> NextDay(#9/21/2020#)
'9/22/2020
'>>> NextDay(#2/28/2020#)
'2/29/2020
Function NextDay(StartDate As Date) As Date
NextDay = StartDate + 1
End Function
When I want to run all my doc tests, I simply call DocTests in the immediate window. If everything passes, I get a total count of the passing tests:
DocTests
Tests passed: 2 of 2
What if one of my tests fails? Let's say I add the following test:
'>>> NextDay(#2/28/2100#)
'2/29/2100
Now, when I run the DocTests I get the following output:
DocTests
Module1: NextDay(#2/28/2100#) evaluates to: 3/1/2100 Expected: 2/29/2100
Tests passed: 2 of 3
Every failing test returns the name of the test's code module along with the actual versus expected outputs. On a side note, you probably knew that every four years is a leap year, but did you also know that every 100 years is not a leap year, but every 400 years is?
Sample Code
Without further ado, here is the full sample code implementing my doctest functionality. You can use this code in your projects, but don't resell the code itself or give it away as your own. You will also need the code for the RegExExtract and RegExReplace functions.
Also, you use this at your own risk. I mention that specifically because one of the advanced features allows you to test private functions by temporarily creating and deleting code modules. That sort of thing can lead to database corruption, so you should backup your database to be safe if you want to try it out. I'll go into more detail on that feature in a future post. Until then, you can refer to the code comments for more info.
' 6/22/11: Bug fixes
' 7/ 4/11: Explicitly display mismatched ExpectedResults; bug fixes
' 6/15/12: Test functions that return Dates
' NOTE: Cannot check to see if Expr returns an error because Eval'ed procs are executed outside the call stack:
' http://windowssecrets.com/forums/showthread.php/136831-Error-handling-problem-from-evaling-code-that-raises-error
'12/20/13: Add support for functions that return Currency type
' 4/25/13: Ignore "can't find function name" errors in non-standard modules
' 5/ 1/15: Allow for complex expression evaluation by creating a temporary code module;
' multiple lines may be evaluated but must be separated by a " : " ({space}{colon}{space})
' 9/24/15: Allow check to see if Expr returns an error code; requires complex expr eval (four angle brackets, not three):
'>>>> 1/0
'#ERROR#
' : Also, allow check for a specific error number expected to be returned; the error number may be an expression (e.g., ErrNumFromMsg())
'>>>> 1/0
'#ERROR# 11
' 9/28/15: Replace `n and `t tokens with vbNewLine and vbTab, respectively, to improve string function testing
' 1/ 4/16: Allow DocTests on Private functions by prepending * to function name; e.g., '>>>> *MyPrivateFunc(1, True)
' - NOTE: this temporarily re-writes the source code to make a private function public; it is immediately
' made private again, but a fatal error in the interim could leave the source in the wrong state;
' be careful and KEEP YOUR SOURCE CODE UNDER VERSION CONTROL!
' 8/26/16: Accepts ModNamePattern that uses simple wildcard pattern matching to test only certain modules
Function DocTests(Optional ModNamePattern As String = "*") As Boolean 'vv
#If EnableMsgService Then
Set App.MsgSvc = New iMsgService
#End If
Dim Comp As Object, i As Long, CM As Object
Dim Expr As String, ExpectedResult As Variant, TestsPassed As Long, TestsFailed As Long
Dim Evaluation As Variant
For Each Comp In Application.VBE.ActiveVBProject.VBComponents
Set CM = Comp.CodeModule
If Not CM.Name Like ModNamePattern Then GoTo NextComp
For i = 1 To CM.CountOfLines
If Left(Trim(CM.Lines(i, 1)), 4) = "'>>>" Then
Dim DocTestLine As String
DocTestLine = CM.Lines(i, 1)
Dim IsComplexExpression As Boolean
IsComplexExpression = Left(Trim(CM.Lines(i, 1)), 5) = "'>>>>"
Const SearchPattern As String = "(.*)(\*)([A-Za-z0-9_-]+)\((.*)"
Dim PrivateFunctionName As String
PrivateFunctionName = RegExExtract(SearchPattern, DocTestLine, "$3")
Dim OriginalFunctionVisibility As String
If Len(PrivateFunctionName) > 0 Then
OriginalFunctionVisibility = ChangeFunctionVisibility(CM, PrivateFunctionName, "Public")
If IsComplexExpression Then
'Fully qualify the function call to avoid possible scope ambiguity
DocTestLine = RegExReplace(SearchPattern, DocTestLine, "$1" & Comp.Name & ".$3($4")
Else
'We can't make a fully qualified call via Eval(); if there is scope ambiguity, you need to use '>>>> form
DocTestLine = RegExReplace(SearchPattern, DocTestLine, "$1$3($4")
End If
End If
On Error Resume Next
If IsComplexExpression Then
'Complex expression
Expr = Trim(Mid(DocTestLine, 6))
Evaluation = EvaluateExpression(Expr)
Else
Expr = Trim(Mid(DocTestLine, 5))
Evaluation = Eval(Expr)
End If
If Err.Number = 2425 And Comp.Type <> 1 Then
'The expression you entered has a function name that Vision Viewer can't find.
'This is not surprising because we are not in a standard code module (Comp.Type <> 1).
'So we will just ignore it.
GoTo NextLine
ElseIf Err.Number <> 0 Then
Debug.Print Err.Number, Err.Description, Expr
GoTo NextLine
End If
On Error GoTo 0
ExpectedResult = Trim(Mid(CM.Lines(i + 1, 1), InStr(CM.Lines(i + 1, 1), "'") + 1))
If Left(ExpectedResult, 8) = "#ERROR# " Then
ExpectedResult = "#ERROR# " & Eval(Mid(ExpectedResult, 9))
Else
ExpectedResult = Replace(ExpectedResult, "`n", vbNewLine)
ExpectedResult = Replace(ExpectedResult, "`t", vbTab)
End If
Select Case ExpectedResult
Case "True": ExpectedResult = True
Case "False": ExpectedResult = False
Case "Null": ExpectedResult = Null
Case "#ERROR#": If Evaluation Like "[#]ERROR[#]*" Then ExpectedResult = Evaluation
End Select
Select Case TypeName(Evaluation)
Case "Long", "Integer", "Short", "Byte", "Single", "Double", "Decimal", "Currency"
ExpectedResult = Eval(ExpectedResult)
Case "Date"
If IsDate(ExpectedResult) Then ExpectedResult = CDate(ExpectedResult)
End Select
If (Evaluation = ExpectedResult) Then
TestsPassed = TestsPassed + 1
ElseIf (IsNull(Evaluation) And IsNull(ExpectedResult)) Then
TestsPassed = TestsPassed + 1
Else
Debug.Print Comp.Name; ": "; Expr; " evaluates to: "; Evaluation; " Expected: "; ExpectedResult
TestsFailed = TestsFailed + 1
End If
If Len(PrivateFunctionName) > 0 Then
ChangeFunctionVisibility CM, PrivateFunctionName, OriginalFunctionVisibility
End If
End If
NextLine:
Next i
NextComp:
Next Comp
Debug.Print "Tests passed: "; TestsPassed; " of "; TestsPassed + TestsFailed
DocTests = (TestsFailed = 0) 'Return True if all tests pass
#If EnableMsgService Then
Set App = New clsApp 'restore default App.MsgSvc
#End If
End Function '^^
'---------------------------------------------------------------------------------------vv
' Procedure : ChangeFunctionVisibility
' Author : Mike
' Date : 1/4/2016
' Purpose : Changes the visibility of a VBA function and returns its original state.
'---------------------------------------------------------------------------------------
'^^
Function ChangeFunctionVisibility(CodeMod As Object, FunctionName As String, VisibilityKeyword As String) As String 'vv
Dim StartLine As Long: StartLine = 1
Dim StartCol As Long: StartCol = 1
Dim EndLine As Long: EndLine = 1
Dim EndCol As Long: EndCol = 1
Dim MatchFound As Boolean
MatchFound = CodeMod.Find("Function " & FunctionName & "(", StartLine, StartCol, EndLine, EndCol)
If Not MatchFound Then Exit Function
Dim CodeLineText As String
CodeLineText = CodeMod.Lines(StartLine, 1)
Dim Pattern As String
Pattern = "(Public |Private |Friend |)((Static )?Function " & FunctionName & "\(.*)"
Dim NewLineOfCode As String
NewLineOfCode = RegExReplace(Pattern, CodeLineText, VisibilityKeyword & " $2")
ChangeFunctionVisibility = Trim(RegExExtract(Pattern, CodeLineText, "$1"))
'Debug.Print CodeLineText
'Debug.Print NewLineOfCode
CodeMod.ReplaceLine StartLine, NewLineOfCode
End Function '^^
Private Function EvaluateExpression(ExprText As String) As Variant 'vv
Const vbext_ct_StdModule As Long = 1
Const TempFnName As String = "XXXXXXXXXXXXXXXXXXXX"
Dim VBComps As Object
Set VBComps = Application.VBE.ActiveVBProject.VBComponents
Dim TempModule As Object 'Temporary module
Set TempModule = VBComps.Add(vbext_ct_StdModule)
Dim CM As Object
Set CM = TempModule.CodeModule
Dim i As Long
i = CM.CountOfLines
i = i + 1: CM.InsertLines i, "Public Function " & TempFnName & "() As Variant"
i = i + 1: CM.InsertLines i, "On Error Goto HandleError"
Dim Lines As Variant, line As Variant
Lines = Split(ExprText, " : ")
Dim LineNum As Long, FirstLineNum As Long, LastLineNum As Long
FirstLineNum = LBound(Lines)
LastLineNum = UBound(Lines)
For LineNum = FirstLineNum To LastLineNum
i = i + 1
line = Lines(LineNum)
If LineNum < LastLineNum Then
CM.InsertLines i, line
Else
CM.InsertLines i, TempFnName & " = " & line
End If
Next LineNum
i = i + 1: CM.InsertLines i, "Exit Function"
'If expression generates an error, return the error number with prefix '#'; e.g., '#11' for division by zero errors
i = i + 1: CM.InsertLines i, "HandleError:"
i = i + 1: CM.InsertLines i, TempFnName & " = ""#ERROR# "" & Err.Number"
i = i + 1: CM.InsertLines i, "End Function"
EvaluateExpression = Run(TempFnName)
VBComps.Remove TempModule
End Function '^^
Article references
UPDATE [2021-07-19]: Added links to the source code for dependencies RegExExtract and RegExReplace.
UPDATE [2023-06-02]: Avoid compile errors by wrapping Set App = New clsApp in a conditional compile If...Then block at the end of the DocTests function.
UPDATE [2023-07-06]: Changed sample VBA from...
'>>> NextDay(#2/28/2100#)
'3/1/2100...to...
'>>> NextDay(#2/28/2100#)
'2/29/2100...to properly illustrate the concept of a failing DocTest.