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.

  1. 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.
  2. 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.
  3. 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

Now you have two problems
Some people, when confronted with a problem, think “I know, I’ll use regular expressions.” Now they have two problems. --Jamie Zawinski
Source code for the RegExExtract and RegExReplace functions.

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.