diff --git a/build/dev.vbs b/build/dev.vbs deleted file mode 100644 index ff20ec3..0000000 --- a/build/dev.vbs +++ /dev/null @@ -1,536 +0,0 @@ -'' -' Dev -' (c) Tim Hall - https://github.com/timhall/Excel-REST -' -' Development steps for Excel-TDD -' Run: cscript build/dev.vbs -' -' @author: tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -Option Explicit - -Dim Args -Set Args = WScript.Arguments - -Dim FSO -Set FSO = CreateObject("Scripting.FileSystemObject") - -Dim Excel -Dim ExcelWasOpen -Set Excel = Nothing -Dim Workbook -Dim WorkbookWasOpen -Set Workbook = Nothing - -Dim SrcFolder -Dim SpecsFolder -SrcFolder = ".\src\" -SpecsFolder = ".\specs\" - -Dim BlankWorkbookPath -Dim BlankInlineWorkbookPath -Dim SpecsWorkbookPath -Dim ExampleInlineWorkbookPath -Dim ExampleDisplayWorkbookPath -BlankWorkbookPath = ".\Excel-TDD - Blank.xlsm" -BlankInlineWorkbookPath = ".\Excel-TDD - Blank - Inline.xlsm" -SpecsWorkbookPath = ".\specs\Excel-TDD - Specs.xlsm" -ExampleInlineWorkbookPath = ".\examples\Excel-TDD - Example - Inline.xlsm" -ExampleDisplayWorkbookPath = ".\examples\Excel-TDD - Example - Runner.xlsm" - -Dim Src -Src = Array( _ - "SpecSuite.cls", _ - "SpecDefinition.cls", _ - "SpecExpectation.cls" _ -) - -Dim Specs -Specs = Array( _ - "SpecSuiteSpecs.bas", _ - "SpecDefinitionSpecs.bas", _ - "SpecExpectationSpecs.bas" _ -) - -Dim InlineRunner -InlineRunner = Array( _ - "InlineRunner.bas" _ -) - -Dim DisplayRunner -DisplayRunner = Array( _ - "DisplayRunner.bas" _ -) - -Dim WorkbookExtensions -WorkbookExtensions = Array( _ - "IScenario.cls", _ - "Scenario.cls", _ - "IWBProxy.cls", _ - "WBProxy.cls" _ -) - -Dim Helpers -Helpers = Array( _ - "SpecHelpers.bas" _ -) - -Main - -Sub Main() - ' On Error Resume Next - - PrintLn "Excel-TDD v1.4.0 Development" - - ExcelWasOpen = OpenExcel(Excel) - - If Not Excel Is Nothing Then - Development - - CloseExcel Excel, ExcelWasOpen - ElseIf Err.Number <> 0 Then - PrintLn vbNewLine & "ERROR: Failed to open Excel" & vbNewLIne & Err.Description - End If - - Input vbNewLIne & "Done! Press any key to exit..." -End Sub - -Sub Development - PrintLn vbNewLine & _ - "Options:" & vbNewLine & _ - "- import [src/specs/inline/display/extensions/helpers/all] to [blank/inline/display/specs/example-inline/example-display/all/path...]" & vbNewLine & _ - "- export [src/specs/inline/display/extensions/helpers/all] from [blank/inline/display/specs/all/example-inline/example-display/path...]" & vbNewLine & _ - "- release" - - Dim Action - Action = Input(vbNewLine & "What would you like to do? <") - - If Action = "" Then - Exit Sub - End If - - Dim Parts - Parts = Split(Action, " ") - - ' Dim PartIndex - ' For PartIndex = LBound(Parts) To UBound(Parts) - ' PrintLn "Parts: " & PartIndex & ", " & Parts(PartIndex) - ' Next - - If UCase(Parts(0)) = "RELEASE" Then - Execute "import", "src", "all" - Execute "import", "inline", "inline" - Execute "import", "display", "display" - Execute "import", "extensions", "display" - Execute "import", "helpers", "specs" - Execute "import", "specs", "specs" - Execute "import", "inline", "specs" - Execute "import", "inline", "example-inline" - Execute "import", "display", "example-display" - Execute "import", "extensions", "example-display" - Execute "import", "helpers", "example-display" - ElseIf UBound(Parts) < 3 Or (UCase(Parts(0)) <> "IMPORT" And UCase(Parts(0)) <> "EXPORT") Then - PrintLn vbNewLine & "Error: Unrecognized action" - Else - If UBound(Parts) > 3 Then - ' Combine path (in case there were spaces in name) and remove quotes - Dim CustomPath - Dim i - For i = 3 To UBound(Parts) - If CustomPath = "" Then - CustomPath = Parts(i) - Else - CustomPath = CustomPath & " " & Parts(i) - End If - Next - CustomPath = Replace(CustomPath, """", "") - - Execute Parts(0), Parts(1), CustomPath - Else - Execute Parts(0), Parts(1), Parts(3) - End If - End If - - PrintLn "" - Development -End Sub - -Sub Execute(Name, ModulesDescription, WorkbookDescription) - ' PrintLn "Execute: " & Name & ", " & ModulesDescription & ", " & WorkbookDescription - - Dim Paths - Select Case UCase(WorkbookDescription) - Case "BLANK" - Paths = Array(BlankWorkbookPath, BlankInlineWorkbookPath) - Case "INLINE" - Paths = Array(BlankInlineWorkbookPath) - Case "DISPLAY" - Paths = Array(BlankWorkbookPath) - Case "SPECS" - Paths = Array(SpecsWorkbookPath) - Case "EXAMPLE-INLINE" - Paths = Array(ExampleInlineWorkbookPath) - Case "EXAMPLE-DISPLAY" - Paths = Array(ExampleDisplayWorkbookPath) - Case "ALL" - Paths = Array(BlankWorkbookPath, BlankInlineWorkbookPath, SpecsWorkbookPath, ExampleInlineWorkbookPath, ExampleDisplayWorkbookPath) - Case Else - Paths = Array(WorkbookDescription) - End Select - - Dim i - For i = LBound(Paths) To UBound(Paths) - ' PrintLn "Open: " & FullPath(Paths(i)) - WorkbookWasOpen = OpenWorkbook(Excel, FullPath(Paths(i)), Workbook) - - If Not Workbook Is Nothing Then - If Not VBAIsTrusted(Workbook) Then - PrintLn vbNewLine & _ - "ERROR: In order to install Excel-REST," & vbNewLine & _ - "access to the VBA project object model needs to be trusted in Excel." & vbNewLine & vbNewLine & _ - "To enable:" & vbNewLine & _ - "Options > Trust Center > Trust Center Settings > Macro Settings > " & vbnewLine & _ - "Trust access to the VBA project object model" - Else - If UCase(Name) = "IMPORT" Then - Import ModulesDescription, Workbook - ElseIf UCase(Name) = "EXPORT" Then - Export ModulesDescription, Workbook - End IF - End If - - CloseWorkbook Workbook, WorkbookWasOpen - ElseIf Err.Number <> 0 Then - PrintLn vbNewLine & "ERROR: Failed to open Workbook" & vbNewLine & Err.Description - Err.Clear - End If - Next -End Sub - -Sub Import(ModulesDescription, Workbook) - Dim Modules - Dim Folder - - Select Case UCase(ModulesDescription) - Case "SRC" - Modules = Src - Folder = SrcFolder - Case "INLINE" - Modules = InlineRunner - Folder = SrcFolder - Case "DISPLAY" - Modules = DisplayRunner - Folder = SrcFolder - Case "EXTENSIONS" - Modules = WorkbookExtensions - Folder = SrcFolder - Case "HELPERS" - Modules = Helpers - Folder = SrcFolder - Case "SPECS" - Modules = Specs - Folder = SpecsFolder - Case "ALL" - Import "src", Workbook - Import "specs", Workbook - Exit Sub - Case Else - PrintLn "ERROR: Unknown modules description: " & ModulesDescription - Exit Sub - End Select - - Print vbNewLine & "Importing " & ModulesDescription & " to " & Workbook.Name - - Dim i - For i = LBound(Modules) To UBound(Modules) - ImportModule Workbook, Folder, Modules(i) - Print "." - Next - - Print "Done!" -End Sub - -Sub Export(ModulesDescription, Workbook) - Dim Modules - Dim Folder - - Select Case UCase(ModulesDescription) - Case "SRC" - Modules = Src - Folder = SrcFolder - Case "INLINE" - Modules = InlineRunner - Folder = SrcFolder - Case "DISPLAY" - Modules = DisplayRunner - Folder = SrcFolder - Case "EXTENSIONS" - Modules = WorkbookExtensions - Folder = SrcFolder - Case "HELPERS" - Modules = Helpers - Folder = SrcFolder - Case "SPECS" - Modules = Specs - Folder = SpecsFolder - Case "ALL" - Import "src", Workbook - Import "specs", Workbook - Exit Sub - Case Else - PrintLn "ERROR: Unknown modules description: " & ModulesDescription - Exit Sub - End Select - - Print vbNewLine & "Exporting " & ModulesDescription & " from " & Workbook.Name - - Dim i - Dim Module - For i = LBound(Modules) To UBound(Modules) - Set Module = GetModule(Workbook, RemoveExtension(Modules(i))) - - If Not Module Is Nothing Then - Module.Export FullPath(Folder & Modules(i)) - Print "." - End If - Next - - Print "Done!" -End Sub - -'' -' Excel helpers -' ------------------------------------ ' - -'' -' Open Workbook and return whether Workbook was already open -' -' @param {Object} Excel -' @param {String} Path -' @param {Object} Workbook object to load Workbook into -' @return {Boolean} Workbook was already open -Function OpenWorkbook(Excel, Path, ByRef Workbook) - On Error Resume Next - - Path = FullPath(Path) - Set Workbook = Excel.Workbooks(GetFilename(Path)) - - If Workbook Is Nothing Or Err.Number <> 0 Then - Err.Clear - - If FileExists(Path) Then - Set Workbook = Excel.Workbooks.Open(Path) - Else - Path = Input(vbNewLine & _ - "Workbook not found at " & Path & vbNewLine & _ - "Would you like to try another location? [path.../cancel] <") - - If UCase(Path) <> "CANCEL" And Path <> "" Then - OpenWorkbook = OpenWorkbook(Excel, Path, Workbook) - End If - End If - OpenWorkbook = False - Else - OpenWorkbook = True - End If -End Function - -'' -' Close Workbook and save changes -' (keep open without saving changes if previously open) -' -' @param {Object} Workbook -' @param {Boolean} KeepWorkbookOpen -Sub CloseWorkbook(ByRef Workbook, KeepWorkbookOpen) - If Not KeepWorkbookOpen And Not Workbook Is Nothing Then - Workbook.Close True - End If - - Set Workbook = Nothing -End Sub - -'' -' Open Excel and return whether Excel was already open -' -' @param {Object} Excel object to load Excel into -' @return {Boolean} Excel was already open -Function OpenExcel(ByRef Excel) - On Error Resume Next - - Set Excel = GetObject(, "Excel.Application") - - If Excel Is Nothing Or Err.Number <> 0 Then - Err.Clear - - Set Excel = CreateObject("Excel.Application") - OpenExcel = False - Else - OpenExcel = True - End If -End Function - -'' -' Close Excel (keep open if previously open) -' -' @param {Object} Excel -' @param {Boolean} KeepExcelOpen -Sub CloseExcel(ByRef Excel, KeepExcelOpen) - If Not KeepExcelOpen And Not Excel Is Nothing Then - Excel.Quit - End If - - Set Excel = Nothing -End Sub - -'' -' Check if VBA is trusted -' -' @param {Object} Workbook -' @param {Boolean} -Function VBAIsTrusted(Workbook) - On Error Resume Next - Dim Count - Count = Workbook.VBProject.VBComponents.Count - - If Err.Number <> 0 Then - Err.Clear - VBAIsTrusted = False - Else - VBAIsTrusted = True - End If -End Function - -'' -' Get module -' -' @param {Object} Workbook -' @param {String} Name -Function GetModule(Workbook, Name) - Dim Module - Set GetModule = Nothing - - For Each Module In Workbook.VBProject.VBComponents - If Module.Name = Name Then - Set GetModule = Module - Exit Function - End If - Next -End Function - -'' -' Import module -' -' @param {Object} Workbook -' @param {String} Folder -' @param {String} Filename -Sub ImportModule(Workbook, Folder, Filename) - Dim Module - If Not Workbook Is Nothing Then - ' Check for existing and remove - Set Module = GetModule(Workbook, RemoveExtension(Filename)) - If Not Module Is Nothing Then - Workbook.VBProject.VBComponents.Remove Module - End If - - ' Import module - Workbook.VBProject.VBComponents.Import FullPath(Folder & Filename) - End If -End Sub - -'' -' Get module and backup (if found) -' -' @param {Object} Workbook -' @param {String} Name -' @param {String} Prefix -Function BackupModule(Workbook, Name, Prefix) - Dim Backup - Dim Existing - Set Backup = GetModule(Workbook, Name) - - If Not Backup Is Nothing Then - ' Remove any previous backups - Set Existing = GetModule(Workbook, Prefix & Name) - If Not Existing Is Nothing Then - Workbook.VBProject.VBComponents.Remove Existing - End If - - Backup.Name = Prefix & Name - End If - - Set BackupModule = Backup -End Function - -'' -' Restore module from backup (if found) -' -' @param {Object} Workbook -' @param {String} Name -' @param {String} Prefix -Sub RestoreModule(Workbook, Name, Prefix) - Dim Backup - Dim Module - Set Backup = GetModule(Workbook, Prefix & Name) - - If Not Backup Is Nothing Then - ' Find upgraded module (and remove if found) - Set Module = GetModule(Workbook, Name) - If Not Module Is Nothing Then - Workbook.VBProject.VBComponents.Remove Module - End If - - ' Restore backup - Backup.Name = Name - End If -End Sub - -'' -' Filesystem helpers -' ------------------------------------ ' - -Function FullPath(Path) - FullPath = FSO.GetAbsolutePathName(Path) -End Function - -Function GetFilename(Path) - Dim Parts - Parts = Split(Path, "\") - - GetFilename = Parts(UBound(Parts)) -End Function - -Function RemoveExtension(Name) - Dim Parts - Parts = Split(Name, ".") - - If UBound(Parts) > LBound(Parts) Then - ReDim Preserve Parts(UBound(Parts) - 1) - End If - - RemoveExtension = Join(Parts, ".") -End Function - -Function FileExists(Path) - FileExists = FSO.FileExists(Path) -End Function - -'' -' General helpers -' ------------------------------------ ' - -Sub Print(Message) - WScript.StdOut.Write Message -End Sub - -Sub PrintLn(Message) - Wscript.Echo Message -End Sub - -Function Input(Prompt) - If Prompt <> "" Then - Print Prompt & " " - End If - - Input = WScript.StdIn.ReadLine -End Function diff --git a/examples/Excel-TDD - Example - Inline.xlsm b/examples/Excel-TDD - Example - Inline.xlsm deleted file mode 100644 index 050f9ef..0000000 Binary files a/examples/Excel-TDD - Example - Inline.xlsm and /dev/null differ diff --git a/examples/Excel-TDD - Example - Runner.xlsm b/examples/Excel-TDD - Example - Runner.xlsm deleted file mode 100644 index 0d936e3..0000000 Binary files a/examples/Excel-TDD - Example - Runner.xlsm and /dev/null differ diff --git a/examples/Excel-TDD - Example - Test Workbook.xlsm b/examples/Excel-TDD - Example - Test Workbook.xlsm deleted file mode 100644 index a9dab3c..0000000 Binary files a/examples/Excel-TDD - Example - Test Workbook.xlsm and /dev/null differ diff --git a/specs/Excel-TDD - Specs.xlsm b/specs/Excel-TDD - Specs.xlsm index 82db7ce..06ec36f 100644 Binary files a/specs/Excel-TDD - Specs.xlsm and b/specs/Excel-TDD - Specs.xlsm differ diff --git a/specs/SpecSuiteSpecs.bas b/specs/SpecSuiteSpecs.bas deleted file mode 100644 index c922521..0000000 --- a/specs/SpecSuiteSpecs.bas +++ /dev/null @@ -1,32 +0,0 @@ -Attribute VB_Name = "SpecSuiteSpecs" -Dim NumBeforeCalls As Integer -Dim MostRecentArgs As Variant - -Public Function Specs() As SpecSuite - Set Specs = New SpecSuite - Specs.Description = "SpecSuite" - - Specs.BeforeEach "Before", "A", 3.14, True - NumBeforeCalls = 0 - - With Specs.It("should call BeforeEach with arguments") - .Expect(NumBeforeCalls).ToEqual 1 - .Expect(MostRecentArgs(0)).ToEqual "A" - .Expect(MostRecentArgs(1)).ToEqual 3.14 - .Expect(MostRecentArgs(2)).ToEqual True - End With - - With Specs.It("should add spec with description and id to spec collection", "Spec-Id") - .Expect(Specs.SpecsCol.Count).ToEqual 2 - .Expect(Specs.SpecsCol(1).Description).ToEqual "should call BeforeEach with arguments" - .Expect(Specs.SpecsCol(2).Description).ToEqual "should add spec with description and id to spec collection" - .Expect(Specs.SpecsCol(2).Id).ToEqual "Spec-Id" - End With - - InlineRunner.RunSuite Specs -End Function - -Public Sub Before(Args As Variant) - NumBeforeCalls = NumBeforeCalls + 1 - MostRecentArgs = Args -End Sub diff --git a/specs/Specs_Fixture.cls b/specs/Specs_Fixture.cls new file mode 100644 index 0000000..2f603e4 --- /dev/null +++ b/specs/Specs_Fixture.cls @@ -0,0 +1,36 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "Specs_Fixture" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = True +Private WithEvents pSuite As SpecSuite +Attribute pSuite.VB_VarHelpID = -1 + +Public BeforeEachCallCount As Long +Public ResultCalls As Collection +Public AfterEachCallCount As Long + +Public Sub ListenTo(Suite As SpecSuite) + Set pSuite = Suite +End Sub + +Private Sub pSuite_BeforeEach() + BeforeEachCallCount = BeforeEachCallCount + 1 +End Sub + +Private Sub pSuite_Result(Spec As SpecDefinition) + Me.ResultCalls.Add Spec +End Sub + +Private Sub pSuite_AfterEach() + AfterEachCallCount = AfterEachCallCount + 1 +End Sub + +Private Sub Class_Initialize() + Set Me.ResultCalls = New Collection +End Sub + diff --git a/specs/SpecDefinitionSpecs.bas b/specs/Specs_SpecDefinition.bas similarity index 70% rename from specs/SpecDefinitionSpecs.bas rename to specs/Specs_SpecDefinition.bas index 6beec91..032938a 100644 --- a/specs/SpecDefinitionSpecs.bas +++ b/specs/Specs_SpecDefinition.bas @@ -1,12 +1,15 @@ -Attribute VB_Name = "SpecDefinitionSpecs" +Attribute VB_Name = "Specs_SpecDefinition" Public Function Specs() As SpecSuite Set Specs = New SpecSuite Specs.Description = "SpecDefinition" + Dim Reporter As New ImmediateReporter + Reporter.ListenTo Specs + Dim TestSuite As New SpecSuite Dim Definition As SpecDefinition Dim Expectation As SpecExpectation - + With Specs.It("should pass if all expectations pass") Set Definition = TestSuite.It("should pass") With Definition @@ -14,10 +17,10 @@ Public Function Specs() As SpecSuite .Expect(2).ToEqual 2 .Expect("pass").ToEqual "pass" End With - - .Expect(Definition.Result).ToEqual SpecResult.Pass + + .Expect(Definition.Result).ToEqual SpecResultType.Pass End With - + With Specs.It("should fail if any expectation fails") Set Definition = TestSuite.It("should fail") With Definition @@ -25,10 +28,10 @@ Public Function Specs() As SpecSuite .Expect(2).ToEqual 2 .Expect("pass").ToEqual "fail" End With - - .Expect(Definition.Result).ToEqual SpecResult.Fail + + .Expect(Definition.Result).ToEqual SpecResultType.Fail End With - + With Specs.It("should contain collection of failed expectations") Set Definition = TestSuite.It("should fail") With Definition @@ -37,20 +40,18 @@ Public Function Specs() As SpecSuite .Expect("pass").ToEqual "fail" .Expect(True).ToEqual False End With - - .Expect(Definition.Result).ToEqual SpecResult.Fail + + .Expect(Definition.Result).ToEqual SpecResultType.Fail .Expect(Definition.FailedExpectations(1).Actual).ToEqual 2 - .Expect(Definition.FailedExpectations(1).Result).ToEqual ExpectResult.Fail + .Expect(Definition.FailedExpectations(1).Passed).ToEqual False .Expect(Definition.FailedExpectations(2).Actual).ToEqual "pass" - .Expect(Definition.FailedExpectations(2).Result).ToEqual ExpectResult.Fail + .Expect(Definition.FailedExpectations(2).Passed).ToEqual False .Expect(Definition.FailedExpectations(3).Actual).ToEqual True - .Expect(Definition.FailedExpectations(3).Result).ToEqual ExpectResult.Fail + .Expect(Definition.FailedExpectations(3).Passed).ToEqual False End With - + With Specs.It("should be pending if there are no expectations") Set Definition = TestSuite.It("pending") - .Expect(Definition.Result).ToEqual SpecResult.Pending + .Expect(Definition.Result).ToEqual SpecResultType.Pending End With - - InlineRunner.RunSuite Specs End Function diff --git a/specs/SpecExpectationSpecs.bas b/specs/Specs_SpecExpectation.bas similarity index 84% rename from specs/SpecExpectationSpecs.bas rename to specs/Specs_SpecExpectation.bas index 1a62799..fa68896 100644 --- a/specs/SpecExpectationSpecs.bas +++ b/specs/Specs_SpecExpectation.bas @@ -1,8 +1,13 @@ -Attribute VB_Name = "SpecExpectationSpecs" +Attribute VB_Name = "Specs_SpecExpectation" Public Function Specs() As SpecSuite + Dim Expectation As SpecExpectation + Set Specs = New SpecSuite Specs.Description = "SpecExpectation" + Dim Reporter As New ImmediateReporter + Reporter.ListenTo Specs + With Specs.It("ToEqual/ToNotEqual") .Expect("A").ToEqual "A" .Expect(2).ToEqual 2 @@ -156,11 +161,31 @@ Public Function Specs() As SpecSuite End With With Specs.It("RunMatcher") - .Expect(100).RunMatcher "SpecExpectationSpecs.ToBeWithin", "to be within", 90, 110 - .Expect(Nothing).RunMatcher "SpecExpectationSpecs.ToBeNothing", "to be nothing" + .Expect(100).RunMatcher "Specs_SpecExpectation.ToBeWithin", "to be within", 90, 110 + .Expect(Nothing).RunMatcher "Specs_SpecExpectation.ToBeNothing", "to be nothing" End With - InlineRunner.RunSuite Specs + With Specs.It("should set Passed") + Set Expectation = New SpecExpectation + Expectation.Actual = 4 + Expectation.ToEqual 4 + + .Expect(Expectation.Passed).ToEqual True + + Expectation.ToEqual 3 + .Expect(Expectation.Passed).ToEqual False + End With + + With Specs.It("should set FailureMessage") + Set Expectation = New SpecExpectation + Expectation.Actual = 4 + + Expectation.ToEqual 4 + .Expect(Expectation.FailureMessage).ToEqual "" + + Expectation.ToEqual 3 + .Expect(Expectation.FailureMessage).ToEqual "Expected 4 to equal 3" + End With End Function Public Function ToBeWithin(Actual As Variant, Args As Variant) As Variant @@ -179,7 +204,7 @@ Public Function ToBeWithin(Actual As Variant, Args As Variant) As Variant End Function Public Function ToBeNothing(Actual As Variant) As Variant - If IsObject(Actual) Then + If VBA.IsObject(Actual) Then If Actual Is Nothing Then ToBeNothing = True Else diff --git a/specs/Specs_SpecSuite.bas b/specs/Specs_SpecSuite.bas new file mode 100644 index 0000000..94dcd0c --- /dev/null +++ b/specs/Specs_SpecSuite.bas @@ -0,0 +1,79 @@ +Attribute VB_Name = "Specs_SpecSuite" +Public Function Specs() As SpecSuite + Dim Suite As SpecSuite + + Set Specs = New SpecSuite + Specs.Description = "SpecSuite" + + Dim Reporter As New ImmediateReporter + Reporter.ListenTo Specs + + Dim Fixture As New Specs_Fixture + Fixture.ListenTo Specs + + With Specs.It("should fire BeforeEach event", "id") + .Expect(Fixture.BeforeEachCallCount).ToEqual 1 + .Expect(1 + 1).ToEqual 2 + End With + + With Specs.It("should fire Result event") + .Expect(Fixture.ResultCalls(1).Description).ToEqual "should fire BeforeEach event" + .Expect(Fixture.ResultCalls(1).Result).ToEqual SpecResultType.Pass + .Expect(Fixture.ResultCalls(1).Expectations.Count).ToEqual 2 + .Expect(Fixture.ResultCalls(1).Id).ToEqual "id" + End With + + With Specs.It("should fire AfterEach event") + .Expect(Fixture.AfterEachCallCount).ToEqual 2 + End With + + With Specs.It("should store specs") + Set Suite = New SpecSuite + With Suite.It("(pass)", "(1)") + .Expect(4).ToEqual 4 + End With + With Suite.It("(fail)", "(2)") + .Expect(4).ToEqual 3 + End With + With Suite.It("(pending)", "(3)") + End With + + .Expect(Suite.Specs.Count).ToEqual 3 + .Expect(Suite.PassedSpecs.Count).ToEqual 1 + .Expect(Suite.FailedSpecs.Count).ToEqual 1 + .Expect(Suite.PendingSpecs.Count).ToEqual 1 + + .Expect(Suite.PassedSpecs(1).Description).ToEqual "(pass)" + .Expect(Suite.FailedSpecs(1).Description).ToEqual "(fail)" + .Expect(Suite.PendingSpecs(1).Description).ToEqual "(pending)" + End With + + With Specs.It("should have overall result") + Set Suite = New SpecSuite + + .Expect(Suite.Result).ToEqual SpecResultType.Pending + + With Suite.It("(pending)", "(1)") + End With + + .Expect(Suite.Result).ToEqual SpecResultType.Pending + + With Suite.It("(pass)", "(2)") + .Expect(4).ToEqual 4 + End With + + .Expect(Suite.Result).ToEqual SpecResultType.Pass + + With Suite.It("(fail)", "(3)") + .Expect(4).ToEqual 3 + End With + + .Expect(Suite.Result).ToEqual SpecResultType.Fail + + With Suite.It("(pass)", "(4)") + .Expect(4).ToEqual 4 + End With + + .Expect(Suite.Result).ToEqual SpecResultType.Fail + End With +End Function diff --git a/src/BlankIWBProxy.cls b/src/BlankIWBProxy.cls deleted file mode 100644 index 31fb006..0000000 --- a/src/BlankIWBProxy.cls +++ /dev/null @@ -1,135 +0,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "BlankIWBProxy" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -'' -' BlankIWBProxy v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD -' -' Blank implementation of IWBProxy -' -' @dependencies -' Microsoft Scripting Runtime -' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -Implements IWBProxy - -Private pPath As String -Private pPassword As String -Private pInstance As Workbook -Private pMapping As Dictionary - -Public Sub DefineMapping(SheetName As String) - -End Sub - -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Common to all IWBProxy implementations -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -Private Sub IWBProxy_DefineMapping(SheetName As String) - Call Me.DefineMapping(SheetName) -End Sub - -Public Property Get Range(MappingKey As String) As Range - Set Range = SpecHelpers.GetRange(Instance, Mapping, MappingKey) -End Property -Private Property Get IWBProxy_Range(MappingKey As String) As Range - Set IWBProxy_Range = Range(MappingKey) -End Property -Public Property Set Range(MappingKey As String, Value As Range) - Call SpecHelpers.SetRange(Instance, Mapping, MappingKey, Value) -End Property -Private Property Set IWBProxy_Range(MappingKey As String, Value As Range) - Set Range(MappingKey) = Value -End Property - -Public Property Get Value(MappingKey As String) As Variant - Value = SpecHelpers.GetValue(Instance, Mapping, MappingKey) -End Property -Private Property Get IWBProxy_Value(MappingKey As String) As Variant - IWBProxy_Value = Value(MappingKey) -End Property -Public Property Let Value(MappingKey As String, NewValue As Variant) - Call SpecHelpers.SetValue(Instance, Mapping, MappingKey, NewValue) -End Property -Private Property Let IWBProxy_Value(MappingKey As String, NewValue As Variant) - Value(MappingKey) = NewValue -End Property - -Public Property Get Instance() As Workbook - Set Instance = pInstance -End Property -Private Property Get IWBProxy_Instance() As Workbook - Set IWBProxy_Instance = Instance -End Property -Public Property Set Instance(Value As Workbook) - Set pInstance = Value -End Property -Private Property Set IWBProxy_Instance(Value As Workbook) - Set Instance = Value -End Property - -Public Property Get Mapping() As Scripting.IDictionary - Set Mapping = IWBProxy_Mapping -End Property -Private Property Get IWBProxy_Mapping() As Scripting.IDictionary - If pMapping Is Nothing Then: Set pMapping = New Dictionary - Set IWBProxy_Mapping = pMapping -End Property -Public Property Set Mapping(Value As Scripting.IDictionary) - Set IWBProxy_Mapping = Value -End Property -Private Property Set IWBProxy_Mapping(Value As Scripting.IDictionary) - Set pMapping = Value -End Property - -Public Property Get Password() As String - Password = pPassword -End Property -Private Property Get IWBProxy_Password() As String - IWBProxy_Password = Password -End Property -Public Property Let Password(Value As String) - pPassword = Value -End Property -Private Property Let IWBProxy_Password(Value As String) - Password = Value -End Property - -Public Property Get Path() As String - Path = pPath -End Property -Private Property Get IWBProxy_Path() As String - IWBProxy_Path = Path -End Property -Public Property Let Path(Value As String) - pPath = Value -End Property -Private Property Let IWBProxy_Path(Value As String) - Path = Value -End Property - -Public Property Get TempPath() As String - TempPath = pTempPath -End Property -Public Property Get IWBProxy_TempPath() As String - IWBProxy_TempPath = TempPath -End Property -Public Property Let TempPath(Value As String) - pTempPath = Value -End Property -Public Property Let IWBProxy_TempPath(Value As String) - TempPath = Value -End Property - -Private Sub Class_Terminate() - Set Me.Instance = Nothing -End Sub diff --git a/src/DisplayRunner.bas b/src/DisplayRunner.bas deleted file mode 100644 index 0ccde63..0000000 --- a/src/DisplayRunner.bas +++ /dev/null @@ -1,267 +0,0 @@ -Attribute VB_Name = "DisplayRunner" -'' -' DisplayRunner v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD -' -' Runner with sheet output -' -' @dependencies -' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -Private Const DefaultSheetName As String = "Spec Runner" -Private Const DefaultFilenameRangeName As String = "Filename" -Private Const DefaultOutputStartRow As Integer = 6 -Private Const DefaultIdCol As Integer = 1 -Private Const DefaultDescCol As Integer = 2 -Private Const DefaultResultCol As Integer = 3 - -Private pFilename As Range -Private pSheet As Worksheet - -Private pOutputStartRow As Integer -Private pIdCol As Integer -Private pDescCol As Integer -Private pResultCol As Integer - -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Properties -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -Public Property Get OutputStartRow() As Integer - If pOutputStartRow <= 0 Then - pOutputStartRow = DefaultOutputStartRow - End If - - OutputStartRow = pOutputStartRow -End Property -Public Property Let OutputStartRow(Value As Integer) - pOutputStartRow = Value -End Property - -Public Property Get IdCol() As Integer - If pIdCol <= 0 Then - pIdCol = DefaultIdCol - End If - - IdCol = pIdCol -End Property -Public Property Let IdCol(Value As Integer) - pIdCol = Value -End Property - -Public Property Get DescCol() As Integer - If pDescCol <= 0 Then - pDescCol = DefaultDescCol - End If - - DescCol = pDescCol -End Property -Public Property Let DescCol(Value As Integer) - pDescCol = Value -End Property - -Public Property Get ResultCol() As Integer - If pResultCol <= 0 Then - pResultCol = DefaultResultCol - End If - - ResultCol = pResultCol -End Property -Public Property Let ResultCol(Value As Integer) - pResultCol = Value -End Property - -Public Property Get Filename() As Range - If pFilename Is Nothing And Not Sheet Is Nothing Then - Set pFilename = Sheet.Range(DefaultFilenameRangeName) - End If - - Set Filename = pFilename -End Property -Public Property Set Filename(Value As Range) - Set pFilename = Value -End Property - -Public Property Get Sheet() As Worksheet - If pSheet Is Nothing Then - If SheetExists(DefaultSheetName) Then - Set pSheet = ThisWorkbook.Sheets(DefaultSheetName) - Else - Err.Raise vbObjectError + 1, "DisplayRunner", "Unable to find runner sheet" - End If - End If - Set Sheet = pSheet -End Property -Public Property Set Sheet(Value As Worksheet) - Set pSheet = Value -End Property - -Public Property Get WBPath() As String - WBPath = Filename.Value -End Property -Public Property Let WBPath(Value As String) - Filename.Value = Value -End Property - - -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Methods -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -'' -' Run the given suite -' -' @param {SpecSuite} Specs -' @param {Boolean} [Append=False] Append results to existing -' --------------------------------------------- ' - -Public Sub RunSuite(Specs As SpecSuite, Optional Append As Boolean = False) - ' Simply add to empty collection and call RunSuites - Dim SuiteCol As New Collection - - SuiteCol.Add Specs - RunSuites SuiteCol, Append -End Sub - -'' -' Run the given collection of spec suites -' -' @param {Collection} of SpecSuite -' @param {Boolean} [Append=False] Append results to existing -' --------------------------------------------- ' - -Public Sub RunSuites(SuiteCol As Collection, Optional Append As Boolean = False) - Dim Suite As SpecSuite - Dim Spec As SpecDefinition - Dim Row As Integer - Dim Indentation As String - - ' 0. Disable screen updating - Dim PrevUpdating As Boolean - PrevUpdating = Application.ScreenUpdating - Application.ScreenUpdating = False - ' On Error GoTo Cleanup - - ' 1. Clear existing output - If Not Append Then - ClearOutput - End If - - ' 2. Loop through Suites and output specs - Row = NewOutputRow - For Each Suite In SuiteCol - If Not Suite Is Nothing Then - If Suite.Description <> "" Then - OutputSuiteDetails Suite, Row - Indentation = " " - Else - Indentation = "" - End If - - For Each Spec In Suite.SpecsCol - OutputSpec Spec, Row, Indentation - Next Spec - End If - Next Suite - -Cleanup: - - ' Finally, restore screen updating - Application.ScreenUpdating = PrevUpdating - -End Sub - -'' -' Browse for the workbook to run specs on -' --------------------------------------------- ' - -Public Sub BrowseForWB() - Dim BrowseWB As String - - BrowseWB = Application.GetOpenFilename( _ - FileFilter:="Excel Workbooks (*.xls; *.xlsx; *.xlsm), *.xls, *.xlsx, *.xlsm", _ - Title:="Select the Excel Workbook to Test", _ - MultiSelect:=False _ - ) - - If BrowseWB <> "" And BrowseWB <> "False" Then - WBPath = BrowseWB - End If -End Sub - - -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Internal -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -Private Sub OutputSpec(Spec As SpecDefinition, ByRef Row As Integer, Optional Indentation As String = "") - Sheet.Cells(Row, IdCol) = Spec.Id - Sheet.Cells(Row, DescCol) = Indentation & Spec.Description - Sheet.Cells(Row, ResultCol) = Spec.ResultName - Row = Row + 1 - - If Spec.FailedExpectations.Count > 0 Then - Dim Exp As SpecExpectation - For Each Exp In Spec.FailedExpectations - Sheet.Cells(Row, DescCol) = Indentation & "X " & Exp.FailureMessage - Row = Row + 1 - Next Exp - End If -End Sub - -Private Sub OutputSuiteDetails(Suite As SpecSuite, ByRef Row As Integer) - Dim HasFailure As Boolean - Dim Result As String - Result = "Pass" - - For Each Spec In Suite.SpecsCol - If Spec.Result = SpecResult.Fail Then - Result = "Fail" - Exit For - End If - Next Spec - - Sheet.Cells(Row, DescCol) = Suite.Description - Sheet.Cells(Row, ResultCol) = Result - Row = Row + 1 -End Sub - -Private Sub ClearOutput() - Dim EndRow As Integer - - Dim PrevUpdating As Boolean - PrevUpdating = Application.ScreenUpdating - Application.ScreenUpdating = False - - EndRow = NewOutputRow - If EndRow >= OutputStartRow Then - Sheet.Range(Cells(OutputStartRow, IdCol), Cells(EndRow, ResultCol)).ClearContents - End If - - Application.ScreenUpdating = PrevUpdating -End Sub - -Private Function NewOutputRow() As Integer - NewOutputRow = OutputStartRow - - Do While Sheet.Cells(NewOutputRow, DescCol) <> "" - NewOutputRow = NewOutputRow + 1 - Loop -End Function - -Private Function SheetExists(SheetName As String) As Boolean - Dim Sheet As Worksheet - - For Each Sheet In ThisWorkbook.Sheets - If Sheet.Name = SheetName Then - SheetExists = True - Exit Function - End If - Next Sheet -End Function - - - diff --git a/src/IScenario.cls b/src/IScenario.cls deleted file mode 100644 index fa80a45..0000000 --- a/src/IScenario.cls +++ /dev/null @@ -1,40 +0,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "IScenario" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = True -'' -' IScenario v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD -' -' Interface for creating and running scenarios on workbooks -' -' @dependencies -' Microsoft Scripting Runtime -' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -'' -' Generate a spec suite to run through a scenario for the given wb -' -' @param {IWBProxy} WB to perform scenario on -' @returns {SpecSuite} -' --------------------------------------------- ' - -Public Function RunScenario(WB As IWBProxy) As SpecSuite -End Function - -'' -' Load scenario from given sheet -' -' @param {String} SheetName to load scenario from -' --------------------------------------------- ' - -Public Sub Load(SheetName As String) -End Sub diff --git a/src/IWBProxy.cls b/src/IWBProxy.cls deleted file mode 100644 index 8eefb7b..0000000 --- a/src/IWBProxy.cls +++ /dev/null @@ -1,97 +0,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "IWBProxy" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = True -'' -' IWBProxy v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD -' -' Interface for generic workbook proxies -' that adds mapping functionality to workbooks -' -' @dependencies -' Microsoft Scripting Runtime -' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -Public Property Get Path() As String -End Property -Public Property Let Path(Value As String) -End Property - -Public Property Get TempPath() As String -End Property -Public Property Let TempPath(Value As String) -End Property - -Public Property Get Password() As String -End Property -Public Property Let Password(Value As String) -End Property - -Public Property Get Mapping() As Dictionary -End Property -Public Property Set Mapping(Value As Dictionary) -End Property - -Public Property Get Instance() As Workbook -End Property -Public Property Set Instance(Value As Workbook) -End Property - -'' -' Get value from workbook for provided mapping key -' -' @param {String} MappingKey -' @returns {Variant} Value from workbook -' --------------------------------------------- ' - -Public Property Get Value(MappingKey As String) As Variant -End Property - -'' -' Set value in workbook for provided mapping key -' -' @param {String} MappingKey -' @param {Variant} NewValue Value to set in workbook -' --------------------------------------------- ' - -Public Property Let Value(MappingKey As String, NewValue As Variant) -End Property - -'' -' Get reference to range from workbook for provided mapping key -' -' @param {String} MappingKey -' @returns {Range} Range from workbook -' --------------------------------------------- ' - -Public Property Get Range(MappingKey As String) As Range -End Property - -'' -' Set underlying range in workbook for provided mapping key -' -' @param {String} MappingKey -' @param {Variant} NewValue Value to set in workbook -' --------------------------------------------- ' - -Public Property Set Range(MappingKey As String, NewValue As Range) -End Property - -'' -' Define mapping -' -' @param {String} SheetName to load mapping from -' --------------------------------------------- ' - -Public Sub DefineMapping(SheetName As String) -End Sub - diff --git a/src/ImmediateReporter.cls b/src/ImmediateReporter.cls new file mode 100644 index 0000000..7dbe62f --- /dev/null +++ b/src/ImmediateReporter.cls @@ -0,0 +1,110 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "ImmediateReporter" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = True +'' +' ImmediateReporter v2.0.0-alpha +' (c) Tim Hall - https://github.com/VBA-tools/Excel-TDD +' +' Report results to Immediate Window +' +' @class ImmediateReporter +' @author tim.hall.engr@gmail.com +' @license MIT (http://www.opensource.org/licenses/mit-license.php) +' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Private WithEvents pSpecs As SpecSuite +Attribute pSpecs.VB_VarHelpID = -1 +Private Finished As Boolean + +' ============================================= ' +' Public Methods +' ============================================= ' + +'' +' Listen to given SpecSuite +' +' @method ListenTo +' @param {SpecSuite} Specs +'' +Public Sub ListenTo(Specs As SpecSuite) + If Not pSpecs Is Nothing Then + Done + End If + + Debug.Print "===" & IIf(Specs.Description <> "", " " & Specs.Description & " ===", "") + Set pSpecs = Specs + Finished = False +End Sub + +'' +' Finish report for SpecSuite +' +' @method Done +'' +Public Function Done() + Finished = True + + Debug.Print "= " & Summary & " = " & Now & " =" & vbNewLine +End Function + +' ============================================= ' +' Private Functions +' ============================================= ' + +Private Function ResultTypeToString(ResultType As SpecResultType) As String + Select Case ResultType + Case SpecResultType.Pass + ResultTypeToString = "+" + Case SpecResultType.Fail + ResultTypeToString = "X" + Case SpecResultType.Pending + ResultTypeToString = "." + End Select +End Function + +Private Function Summary() As String + Dim Total As Long + Dim Passed As Long + Dim Failed As Long + Dim Pending As Long + Total = pSpecs.Specs.Count + Passed = pSpecs.PassedSpecs.Count + Failed = pSpecs.FailedSpecs.Count + Pending = pSpecs.PendingSpecs.Count + + Dim SummaryMessage As String + If Failed > 0 Then + SummaryMessage = "FAIL (" & Failed & " of " & Total & " failed" + Else + SummaryMessage = "PASS (" & Passed & " of " & Total & " passed" + End If + If Pending > 0 Then + SummaryMessage = SummaryMessage & ", " & Pending & " pending)" + Else + SummaryMessage = SummaryMessage & ")" + End If + + Summary = SummaryMessage +End Function + +Private Sub pSpecs_Result(Spec As SpecDefinition) + Debug.Print ResultTypeToString(Spec.Result) & " " & Spec.Description & IIf(Spec.Id <> "", " [" & Spec.Id & "]", "") + + If Spec.Result = SpecResultType.Fail Then + Dim Expectation As SpecExpectation + For Each Expectation In Spec.FailedExpectations + Debug.Print " " & Expectation.FailureMessage + Next Expectation + End If +End Sub + +Private Sub Class_Terminate() + If Not Finished Then + Done + End If +End Sub diff --git a/src/InlineRunner.bas b/src/InlineRunner.bas deleted file mode 100644 index 98ba6bf..0000000 --- a/src/InlineRunner.bas +++ /dev/null @@ -1,170 +0,0 @@ -Attribute VB_Name = "InlineRunner" -'' -' InlineRunner v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD -' -' Runner for outputting results of specs to Immediate window -' -' @dependencies -' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -'' -' Run the given suite -' -' @param {SpecSuite} Specs -' @param {Boolean} [ShowFailureDetails=True] Show failed expectations -' @param {Boolean} [ShowPassed=False] Show passed specs -' @param {Boolean} [ShowSuiteDetails=False] Show details for suite -' --------------------------------------------- ' - -Public Sub RunSuite(Specs As SpecSuite, Optional ShowFailureDetails As Boolean = True, Optional ShowPassed As Boolean = False, Optional ShowSuiteDetails As Boolean = False) - Dim SuiteCol As New Collection - - SuiteCol.Add Specs - RunSuites SuiteCol, ShowFailureDetails, ShowPassed, ShowSuiteDetails -End Sub - -'' -' Run the given collection of spec suites -' -' @param {Collection} of SpecSuite -' @param {Boolean} [ShowFailureDetails=True] Show failed expectations -' @param {Boolean} [ShowPassed=False] Show passed specs -' @param {Boolean} [ShowSuiteDetails=True] Show details for suite -' --------------------------------------------- ' - -Public Sub RunSuites(SuiteCol As Collection, Optional ShowFailureDetails As Boolean = True, Optional ShowPassed As Boolean = False, Optional ShowSuiteDetails As Boolean = True) - Dim Suite As SpecSuite - Dim Spec As SpecDefinition - Dim TotalCount As Integer - Dim FailedSpecs As Integer - Dim PendingSpecs As Integer - Dim ShowingResults As Boolean - Dim Indentation As String - Dim i As Integer - - For Each Suite In SuiteCol - If Not Suite Is Nothing Then - TotalCount = TotalCount + Suite.SpecsCol.Count - - For Each Spec In Suite.SpecsCol - If Spec.Result = SpecResult.Fail Then - FailedSpecs = FailedSpecs + 1 - ElseIf Spec.Result = SpecResult.Pending Then - PendingSpecs = PendingSpecs + 1 - End If - Next Spec - End If - Next Suite - - Debug.Print vbNewLine & "= " & SummaryMessage(TotalCount, FailedSpecs, PendingSpecs) & " = " & Now & " =========================" - For Each Suite In SuiteCol - If Not Suite Is Nothing Then - If ShowSuiteDetails Then - Debug.Print SuiteMessage(Suite) - Indentation = " " - ShowingResults = True - Else - Indentation = "" - End If - - For Each Spec In Suite.SpecsCol - If Spec.Result = SpecResult.Fail Then - Debug.Print Indentation & FailureMessage(Spec, ShowFailureDetails, Indentation) - ShowingResults = True - ElseIf Spec.Result = SpecResult.Pending Then - Debug.Print Indentation & PendingMessage(Spec) - ShowingResults = True - ElseIf ShowPassed Then - Debug.Print Indentation & PassingMessage(Spec) - ShowingResults = True - End If - Next Spec - End If - Next Suite - - If ShowingResults Then - Debug.Print "===" - End If -End Sub - -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Internal Methods -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -Private Function SummaryMessage(TotalCount As Integer, FailedSpecs As Integer, PendingSpecs As Integer) As String - If FailedSpecs = 0 Then - SummaryMessage = "PASS (" & TotalCount - PendingSpecs & " of " & TotalCount & " passed" - Else - SummaryMessage = "FAIL (" & FailedSpecs & " of " & TotalCount & " failed" - End If - - If PendingSpecs = 0 Then - SummaryMessage = SummaryMessage & ")" - Else - SummaryMessage = SummaryMessage & ", " & PendingSpecs & " pending)" - End If -End Function - -Private Function FailureMessage(Spec As SpecDefinition, ShowFailureDetails As Boolean, Indentation As String) As String - Dim FailedExpectation As SpecExpectation - Dim i As Integer - - FailureMessage = ResultMessage(Spec, "X") - - If ShowFailureDetails Then - FailureMessage = FailureMessage & vbNewLine - - For Each FailedExpectation In Spec.FailedExpectations - FailureMessage = FailureMessage & Indentation & " " & FailedExpectation.FailureMessage - - If i + 1 <> Spec.FailedExpectations.Count Then: FailureMessage = FailureMessage & vbNewLine - i = i + 1 - Next FailedExpectation - End If -End Function - -Private Function PendingMessage(Spec As SpecDefinition) As String - PendingMessage = ResultMessage(Spec, ".") -End Function - -Private Function PassingMessage(Spec As SpecDefinition) As String - PassingMessage = ResultMessage(Spec, "+") -End Function - -Private Function ResultMessage(Spec As SpecDefinition, Symbol As String) As String - ResultMessage = Symbol & " " - - If Spec.Id <> "" Then - ResultMessage = ResultMessage & Spec.Id & ": " - End If - - ResultMessage = ResultMessage & Spec.Description -End Function - -Private Function SuiteMessage(Suite As SpecSuite) As String - Dim HasFailures As Boolean - Dim Spec As SpecDefinition - - For Each Spec In Suite.SpecsCol - If Spec.Result = SpecResult.Fail Then - HasFailures = True - Exit For - End If - Next Spec - - If HasFailures Then - SuiteMessage = "X " - Else - SuiteMessage = "+ " - End If - - If Suite.Description <> "" Then - SuiteMessage = SuiteMessage & Suite.Description - Else - SuiteMessage = SuiteMessage & Suite.SpecsCol.Count & " specs" - End If -End Function diff --git a/src/Scenario.cls b/src/Scenario.cls deleted file mode 100644 index b4d6158..0000000 --- a/src/Scenario.cls +++ /dev/null @@ -1,106 +0,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "Scenario" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = True -'' -' Scenario v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD -' -' Generic implementation of scenario -' -' @dependencies -' Microsoft Scripting Runtime -' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -Implements IScenario - -Private Const ScenarioInputStartRow As Integer = 4 -Private Const ScenarioInputStartCol As Integer = 1 -Private Const ScenarioExpectedStartRow As Integer = 4 -Private Const ScenarioExpectedStartCol As Integer = 3 - -Private Description As String -Private InputValues As Dictionary -Private ExpectedValues As Dictionary - -'' -' Generate a spec suite to run through a scenario for the given wb -' -' @param {IWBProxy} WB to perform scenario on -' @param {String} Name of scenario -' @returns {SpecSuite} -' --------------------------------------------- ' - -Private Function IScenario_RunScenario(WB As IWBProxy) As SpecSuite - - Dim Specs As New SpecSuite - Dim KeyValue As Variant - - If Description = "" Then - Description = "should pass scenario" - End If - - SpecHelpers.OpenIWBProxy WB - - With Specs.It(Description) - ' Load input values - For Each KeyValue In InputValues.Keys - WB.Value(CStr(KeyValue)) = InputValues.Item(CStr(KeyValue)) - Next KeyValue - - ' Run expectations - For Each KeyValue In ExpectedValues.Keys - .Expect(WB.Value(CStr(KeyValue))).ToEqual ExpectedValues.Item(CStr(KeyValue)) - Next KeyValue - End With - - SpecHelpers.CloseIWBProxy WB - Set IScenario_RunScenario = Specs -End Function - -'' -' Load the scenario from a sheet -' -' @param {String} SheetName -' --------------------------------------------- ' - -Private Sub IScenario_Load(SheetName As String) - - Dim ScenarioSheet As Worksheet - Dim Row As Integer - Set InputValues = New Dictionary - Set ExpectedValues = New Dictionary - - If SpecHelpers.SheetExists(SheetName, ThisWorkbook) Then - Set ScenarioSheet = ThisWorkbook.Sheets(SheetName) - - Description = ScenarioSheet.Cells(1, ScenarioExpectedStartCol) - - Row = ScenarioInputStartRow - Do While ScenarioSheet.Cells(Row, ScenarioInputStartCol) <> "" - InputValues.Add _ - CStr(ScenarioSheet.Cells(Row, ScenarioInputStartCol)), _ - ScenarioSheet.Cells(Row, ScenarioInputStartCol + 1).Value - - Row = Row + 1 - Loop - - Row = ScenarioExpectedStartRow - Do While ScenarioSheet.Cells(Row, ScenarioExpectedStartCol) <> "" - ExpectedValues.Add _ - CStr(ScenarioSheet.Cells(Row, ScenarioExpectedStartCol)), _ - ScenarioSheet.Cells(Row, ScenarioExpectedStartCol + 1).Value - - Row = Row + 1 - Loop - - End If - -End Sub diff --git a/src/SpecDefinition.cls b/src/SpecDefinition.cls index e7fb155..f446508 100644 --- a/src/SpecDefinition.cls +++ b/src/SpecDefinition.cls @@ -8,122 +8,88 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' SpecDefinition v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD +' SpecDefinition v2.0.0-beta +' (c) Tim Hall - https://github.com/VBA-tools/Excel-TDD ' -' Provides helpers and acts as workbook proxy +' Collection of expectations for verifying spec ' -' @dependencies +' @class SpecDefinition ' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' +' @license MIT (http://www.opensource.org/licenses/mit-license.php) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Option Explicit -Private pExpectations As Collection -Private pFailedExpectations As Collection - -Public Enum SpecResult - Pass - Fail - Pending -End Enum - - -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Properties -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +' --------------------------------------------- ' +' Events and Properties +' --------------------------------------------- ' Public Description As String Public Id As String +Public Expectations As VBA.Collection + +Public Suite As SpecSuite -Public Property Get Expectations() As Collection - If pExpectations Is Nothing Then - Set pExpectations = New Collection +Public Property Get Result() As SpecResultType + If Me.Expectations.Count = 0 Then + Result = SpecResultType.Pending + Else + Result = SpecResultType.Pass + + Dim Expectation As SpecExpectation + For Each Expectation In Me.Expectations + If Not Expectation.Passed Then + Result = SpecResultType.Fail + Exit For + End If + Next Expectation End If - Set Expectations = pExpectations -End Property -Private Property Let Expectations(Value As Collection) - Set pExpectations = Value End Property Public Property Get FailedExpectations() As Collection - If pFailedExpectations Is Nothing Then - Set pFailedExpectations = New Collection - End If - Set FailedExpectations = pFailedExpectations -End Property -Private Property Let FailedExpectations(Value As Collection) - Set pFailedExpectations = Value + Dim Filtered As New Collection + Dim Expectation As SpecExpectation + For Each Expectation In Me.Expectations + If Not Expectation.Passed Then + Filtered.Add Expectation + End If + Next Expectation + + Set FailedExpectations = Filtered End Property - -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +' ============================================= ' ' Public Methods -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +' ============================================= ' '' -' Create a new expectation to test the defined value +' Create a new expectation to test the given actual value ' -' @param {Variant} value Value to be tested by expectation -' @returns {Expectation} -' --------------------------------------------- ' - -Public Function Expect(Optional Value As Variant) As SpecExpectation - Dim Exp As New SpecExpectation +' @method Expect +' @param {Variant} Actual value to test +' @return {SpecExpectation} +'' +Public Function Expect(Optional Actual As Variant) As SpecExpectation + Dim Expectation As New SpecExpectation - If VarType(Value) = vbObject Then - Set Exp.Actual = Value + If VBA.VarType(Actual) = VBA.vbObject Then + Set Expectation.Actual = Actual Else - Exp.Actual = Value + Expectation.Actual = Actual End If - Me.Expectations.Add Exp + Me.Expectations.Add Expectation - Set Expect = Exp + Set Expect = Expectation End Function -'' -' Run each expectation, store failed expectations, and return result -' -' @returns {SpecResult} Pass/Fail/Pending -' --------------------------------------------- ' +' ============================================= ' +' Private Functions +' ============================================= ' -Public Function Result() As SpecResult - Dim Exp As SpecExpectation - - ' Reset failed expectations - FailedExpectations = New Collection - - ' If no expectations have been defined, return pending - If Me.Expectations.Count < 1 Then - Result = Pending - Else - ' Loop through all expectations - For Each Exp In Me.Expectations - ' If expectation fails, store it - If Exp.Result = Fail Then - FailedExpectations.Add Exp - End If - Next Exp - - ' If no expectations failed, spec passes - If Me.FailedExpectations.Count > 0 Then - Result = Fail - Else - Result = Pass - End If - End If -End Function +Private Sub Class_Initialize() + Set Me.Expectations = New VBA.Collection +End Sub -'' -' Helper to get result name (i.e. "Pass", "Fail", "Pending") -' -' @returns {String} -' --------------------------------------------- ' +Private Sub Class_Terminate() + Me.Suite.SpecDone Me +End Sub -Public Function ResultName() As String - Select Case Me.Result - Case Pass: ResultName = "Pass" - Case Fail: ResultName = "Fail" - Case Pending: ResultName = "Pending" - End Select -End Function diff --git a/src/SpecExpectation.cls b/src/SpecExpectation.cls index 3f58548..ed15002 100644 --- a/src/SpecExpectation.cls +++ b/src/SpecExpectation.cls @@ -8,51 +8,55 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' SpecExpectation v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD +' SpecExpectation v2.0.0-beta +' (c) Tim Hall - https://github.com/VBA-tools/Excel-TDD ' ' Provides various tests that can be performed for a provided value ' -' @dependencies +' @class SpecExpectation ' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' +' @license MIT (http://www.opensource.org/licenses/mit-license.php) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Option Explicit -Public Enum ExpectResult - Pass - Fail -End Enum +' --------------------------------------------- ' +' Properties +' --------------------------------------------- ' Public Actual As Variant Public Expected As Variant -Public Result As ExpectResult +Public Passed As Boolean Public FailureMessage As String - -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +' ============================================= ' ' Public Methods -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +' ============================================= ' '' -' Check if the actual value is equal / not equal to the expected value +' Check if the actual value is equal to the expected value ' -' @param {Variant} Expected -' --------------------------------------------- ' +' @method ToEqual +' @param {Variant} Expected value +'' Public Sub ToEqual(Expected As Variant) Check IsEqual(Me.Actual, Expected), "to equal", Expected:=Expected End Sub + +'' +' @method ToNotEqual +' @param {Variant} Expected value +'' Public Sub ToNotEqual(Expected As Variant) Check IsEqual(Me.Actual, Expected), "to not equal", Expected:=Expected, Inverse:=True End Sub Private Function IsEqual(Actual As Variant, Expected As Variant) As Variant - If IsError(Actual) Or IsError(Expected) Then + If VBA.IsError(Actual) Or VBA.IsError(Expected) Then IsEqual = False - ElseIf IsObject(Actual) Or IsObject(Expected) Then + ElseIf VBA.IsObject(Actual) Or VBA.IsObject(Expected) Then IsEqual = "Unsupported: Can't compare objects" - ElseIf VarType(Actual) = vbDouble And VarType(Expected) = vbDouble Then - ' It is inherently difficult/almost impossible to check equality of Double + ElseIf VBA.VarType(Actual) = vbDouble And VBA.VarType(Expected) = vbDouble Then + ' It is inherently difficult/almost impossible to Check equality of Double ' http://support.microsoft.com/kb/78113 ' ' Compare up to 15 significant figures @@ -64,36 +68,49 @@ Private Function IsEqual(Actual As Variant, Expected As Variant) As Variant End Function '' -' Check if the actual value is undefined / not undefined +' Check if the actual value is undefined ' (Nothing, Empty, Null, or Missing) -' --------------------------------------------- ' -Public Sub ToBeDefined() - Debug.Print "Excel-TDD: DEPRECATED, ToBeDefined() has been deprecated in favor of ToNotBeUndefined and will be removed in Excel-TDD v2.0.0" - Check IsUndefined(Me.Actual), "to be defined", Inverse:=True -End Sub +' +' @method ToBeUndefined +'' Public Sub ToBeUndefined() Check IsUndefined(Me.Actual), "to be undefined" End Sub + +'' +' Check if the actual value is not undefined +' (not Nothing, Empty, Null, or Missing) +' +' @method ToNotBeUndefined +'' Public Sub ToNotBeUndefined() Check IsUndefined(Me.Actual), "to not be undefined", Inverse:=True End Sub Private Function IsUndefined(Actual As Variant) As Variant - IsUndefined = IsNothing(Actual) Or IsEmpty(Actual) Or IsNull(Actual) Or IsMissing(Actual) + IsUndefined = IsNothing(Actual) Or VBA.IsEmpty(Actual) Or VBA.IsNull(Actual) Or VBA.IsMissing(Actual) End Function '' -' Check if the actual value is nothing / not nothing -' --------------------------------------------- ' +' Check if the actual value is Nothing +' +' @method ToBeNothing +'' Public Sub ToBeNothing() Check IsNothing(Me.Actual), "to be nothing" End Sub + +'' +' Check if the actual value is not Nothing +' +' @method ToNotBeNothing +'' Public Sub ToNotBeNothing() Check IsNothing(Me.Actual), "to not be nothing", Inverse:=True End Sub Private Function IsNothing(Actual As Variant) As Variant - If IsObject(Actual) Then + If VBA.IsObject(Actual) Then If Actual Is Nothing Then IsNothing = True Else @@ -105,40 +122,65 @@ Private Function IsNothing(Actual As Variant) As Variant End Function '' -' Check if the actual value is empty / not empty -' --------------------------------------------- ' +' Check if the actual value is empty +' +' @method ToBeEmpty +'' Public Sub ToBeEmpty() - Check IsEmpty(Me.Actual), "to be empty" + Check VBA.IsEmpty(Me.Actual), "to be empty" End Sub + +'' +' Check if the actual value is not empty +' +' @method ToNotBeEmpty +'' Public Sub ToNotBeEmpty() - Check IsEmpty(Me.Actual), "to not be empty", Inverse:=True + Check VBA.IsEmpty(Me.Actual), "to not be empty", Inverse:=True End Sub '' -' Check if the actual value is null / not null -' --------------------------------------------- ' +' Check if the actual value is null +' +' @method ToBeNull +'' Public Sub ToBeNull() - Check IsNull(Me.Actual), "to be null" + Check VBA.IsNull(Me.Actual), "to be null" End Sub + +'' +' Check if the actual value is not null +' +' @method ToNotBeNull +'' Public Sub ToNotBeNull() - Check IsNull(Me.Actual), "to not be null", Inverse:=True + Check VBA.IsNull(Me.Actual), "to not be null", Inverse:=True End Sub '' -' Check if the actual value is missing / not missing -' --------------------------------------------- ' +' Check if the actual value is missing +' +' @method ToBeMissing +'' Public Sub ToBeMissing() - Check IsMissing(Me.Actual), "to be missing" + Check VBA.IsMissing(Me.Actual), "to be missing" End Sub + +'' +' Check if the actual value is not missing +' +' @method ToNotBeMissing +'' Public Sub ToNotBeMissing() - Check IsMissing(Me.Actual), "to not be missing", Inverse:=True + Check VBA.IsMissing(Me.Actual), "to not be missing", Inverse:=True End Sub '' ' Check if the actual value is less than the expected value ' -' @param {Variant} Expected -' --------------------------------------------- ' +' @method ToBeLessThan / ToBeLT +' @param {Variant} Expected value +'' Public Sub ToBeLessThan(Expected As Variant) Check IsLT(Me.Actual, Expected), "to be less than", Expected:=Expected End Sub @@ -147,7 +189,7 @@ Public Sub ToBeLT(Expected As Variant) End Sub Private Function IsLT(Actual As Variant, Expected As Variant) As Variant - If IsError(Actual) Or IsError(Expected) Or Actual >= Expected Then + If VBA.IsError(Actual) Or VBA.IsError(Expected) Or Actual >= Expected Then IsLT = False Else IsLT = True @@ -157,8 +199,9 @@ End Function '' ' Check if the actual value is less than or equal to the expected value ' -' @param {Variant} Expected -' --------------------------------------------- ' +' @method ToBeLessThanOrEqualTo / ToBeLTE +' @param {Variant} Expected value +'' Public Sub ToBeLessThanOrEqualTo(Expected As Variant) Check IsLTE(Me.Actual, Expected), "to be less than or equal to", Expected:=Expected End Sub @@ -167,7 +210,7 @@ Public Sub ToBeLTE(Expected As Variant) End Sub Private Function IsLTE(Actual As Variant, Expected As Variant) As Variant - If IsError(Actual) Or IsError(Expected) Or Actual > Expected Then + If VBA.IsError(Actual) Or VBA.IsError(Expected) Or Actual > Expected Then IsLTE = False Else IsLTE = True @@ -177,8 +220,9 @@ End Function '' ' Check if the actual value is greater than the expected value ' -' @param {Variant} Expected -' --------------------------------------------- ' +' @method ToBeGreaterThan / ToBeGT +' @param {Variant} Expected value +'' Public Sub ToBeGreaterThan(Expected As Variant) Check IsGT(Me.Actual, Expected), "to be greater than", Expected:=Expected End Sub @@ -187,7 +231,7 @@ Public Sub ToBeGT(Expected As Variant) End Sub Private Function IsGT(Actual As Variant, Expected As Variant) As Variant - If IsError(Actual) Or IsError(Expected) Or Actual <= Expected Then + If VBA.IsError(Actual) Or VBA.IsError(Expected) Or Actual <= Expected Then IsGT = False Else IsGT = True @@ -197,8 +241,9 @@ End Function '' ' Check if the actual value is greater than or equal to the expected value ' +' @method ToBeGreaterThanOrEqualTo / ToBeGTE ' @param {Variant} Expected -' --------------------------------------------- ' +'' Public Sub ToBeGreaterThanOrEqualTo(Expected As Variant) Check IsGTE(Me.Actual, Expected), "to be greater than or equal to", Expected:=Expected End Sub @@ -207,7 +252,7 @@ Public Sub ToBeGTE(Expected As Variant) End Sub Private Function IsGTE(Actual As Variant, Expected As Variant) As Variant - If IsError(Actual) Or IsError(Expected) Or Actual < Expected Then + If VBA.IsError(Actual) Or VBA.IsError(Expected) Or Actual < Expected Then IsGTE = False Else IsGTE = True @@ -217,12 +262,21 @@ End Function '' ' Check if the actual value is close to the expected value ' -' @param {Variant} Expected +' @method ToBeCloseTo +' @param {Variant} Expected value ' @param {Integer} SignificantFigures (1-15) -' --------------------------------------------- ' +'' Public Sub ToBeCloseTo(Expected As Variant, SignificantFigures As Integer) Check IsCloseTo(Me.Actual, Expected, SignificantFigures), "to be close to", Expected:=Expected End Sub + +'' +' Check if the actual value is not close to the expected value +' +' @method ToNotBeCloseTo +' @param {Variant} Expected value +' @param {Integer} SignificantFigures (1-15 +'' Public Sub ToNotBeCloseTo(Expected As Variant, SignificantFigures As Integer) Check IsCloseTo(Me.Actual, Expected, SignificantFigures), "to be close to", Expected:=Expected, Inverse:=True End Sub @@ -233,7 +287,7 @@ Private Function IsCloseTo(Actual As Variant, Expected As Variant, SignificantFi If SignificantFigures < 1 Or SignificantFigures > 15 Then IsCloseTo = "ToBeCloseTo/ToNotBeClose to can only compare from 1 to 15 significant figures""" - ElseIf Not IsError(Actual) And Not IsError(Expected) Then + ElseIf Not VBA.IsError(Actual) And Not VBA.IsError(Expected) Then ' Convert values to scientific notation strings and then compare strings If Actual > 1 Then ActualAsString = VBA.Format$(Actual, VBA.Left$("0.00000000000000", SignificantFigures + 1) & "e+0") @@ -252,39 +306,27 @@ Private Function IsCloseTo(Actual As Variant, Expected As Variant, SignificantFi End Function '' -' Check if the actual value contains the expected value -' Deprecated: Check if the actual value contains the expected value +' Check if the actual value array contains the expected value ' -' @param {Variant} Expected -' @param {Boolean} [MatchCase=True] *deprecated -' --------------------------------------------- ' -Public Sub ToContain(Expected As Variant, Optional MatchCase As Boolean = True) - If VarType(Me.Actual) = vbString Then - Debug.Print "Excel-TDD: DEPRECATED ToContain has been changed to ToMatch in Excel-TDD v2.0.0" - If MatchCase Then - Check Matches(Me.Actual, Expected), "to match", Expected:=Expected - Else - Check Matches(VBA.UCase$(Me.Actual), VBA.UCase$(Expected)), "to match", Expected:=Expected - End If - Else - Check Contains(Me.Actual, Expected), "to contain", Expected:=Expected - End If +' @method ToContain +' @param {Variant} Expected value +'' +Public Sub ToContain(Expected As Variant) + Check Contains(Me.Actual, Expected), "to contain", Expected:=Expected End Sub -Public Sub ToNotContain(Expected As Variant, Optional MatchCase As Boolean = True) - If VarType(Me.Actual) = vbString Then - Debug.Print "Excel-TDD: DEPRECATED ToNotContain has been changed to ToMatch in Excel-TDD v2.0.0" - If MatchCase Then - Check Matches(Me.Actual, Expected), "to not match", Expected:=Expected, Inverse:=True - Else - Check Matches(VBA.UCase$(Me.Actual), VBA.UCase$(Expected)), "to not match", Expected:=Expected, Inverse:=True - End If - Else - Check Contains(Me.Actual, Expected), "to not contain", Expected:=Expected, Inverse:=True - End If + +'' +' Check if the actual value array does not contain the expected value +' +' @method ToNotContain +' @param {Variant} Expected value +'' +Public Sub ToNotContain(Expected As Variant) + Check Contains(Me.Actual, Expected), "to not contain", Expected:=Expected, Inverse:=True End Sub Private Function Contains(Actual As Variant, Expected As Variant) As Variant - If Not IsArray(Actual) Then + If Not IsArrayOrCollection(Actual) Then Contains = "Error: Actual needs to be an Array or Collection for ToContain/ToNotContain" Else Dim i As Integer @@ -307,20 +349,29 @@ Private Function Contains(Actual As Variant, Expected As Variant) As Variant End Function '' -' Check if the actual value matches the expected value +' Check if the actual value string has a match for the expected value substring ' (Only checks if the actual contains the expected string currently) ' -' @param {Variant} Expected -' --------------------------------------------- ' +' @method ToMatch +' @param {Variant} Expected value +'' Public Sub ToMatch(Expected As Variant) Check Matches(Me.Actual, Expected), "to match", Expected:=Expected End Sub + +'' +' Check if the actual value string does not have a match for the expected value substring +' (Only checks if the actual does not contain the expected string currently) +' +' @method ToNotMatch +' @param {Variant} Expected value +'' Public Sub ToNotMatch(Expected As Variant) Check Matches(Me.Actual, Expected), "to not match", Expected:=Expected, Inverse:=True End Sub Private Function Matches(Actual As Variant, Expected As Variant) As Variant - If InStr(Actual, Expected) > 0 Then + If VBA.InStr(Actual, Expected) > 0 Then Matches = True Else Matches = False @@ -349,10 +400,11 @@ End Function ' End If ' End Function ' +' @method RunMatcher ' @param {String} Name of function for matcher ' @param {String} Message ' @param {...} Arguments for custom matcher -' --------------------------------------------- ' +'' Public Sub RunMatcher(Name As String, Message As String, ParamArray Arguments()) Dim Expected As String Dim i As Integer @@ -380,20 +432,20 @@ Public Sub RunMatcher(Name As String, Message As String, ParamArray Arguments()) End If End Sub -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Internal Methods -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +' ============================================= ' +' Private Methods +' ============================================= ' Private Sub Check(Result As Variant, Message As String, Optional Expected As Variant, Optional Inverse As Boolean = False) - If Not IsMissing(Expected) Then - If IsObject(Expected) Then + If Not VBA.IsMissing(Expected) Then + If VBA.IsObject(Expected) Then Set Me.Expected = Expected Else Me.Expected = Expected End If End If - If VarType(Result) = vbString Then + If VBA.VarType(Result) = VBA.vbString Then Fails CStr(Result) Else If Inverse Then @@ -409,55 +461,59 @@ Private Sub Check(Result As Variant, Message As String, Optional Expected As Var End Sub Private Sub Passes() - Me.Result = ExpectResult.Pass + Me.Passed = True End Sub Private Sub Fails(Message As String) - Me.Result = ExpectResult.Fail + Me.Passed = False Me.FailureMessage = Message End Sub Private Function CreateFailureMessage(Message As String, Optional Expected As Variant) As String CreateFailureMessage = "Expected " & GetStringForValue(Me.Actual) & " " & Message - If Not IsMissing(Expected) Then + If Not VBA.IsMissing(Expected) Then CreateFailureMessage = CreateFailureMessage & " " & GetStringForValue(Expected) End If End Function Private Function GetStringForValue(Value As Variant) As String - If IsObject(Value) Then + If VBA.IsMissing(Value) Then + GetStringForValue = "(Missing)" + Exit Function + End If + + Select Case VBA.VarType(Value) + Case VBA.vbObject If Value Is Nothing Then GetStringForValue = "(Nothing)" Else GetStringForValue = "(Object)" End If - ElseIf IsArray(Value) Then + Case VBA.vbArray To VBA.vbArray + VBA.vbByte GetStringForValue = "(Array)" - ElseIf IsEmpty(Value) Then + Case VBA.vbEmpty GetStringForValue = "(Empty)" - ElseIf IsNull(Value) Then + Case VBA.vbNull GetStringForValue = "(Null)" - ElseIf IsMissing(Value) Then - GetStringForValue = "(Missing)" - Else + Case VBA.vbString + GetStringForValue = """" & Value & """" + Case Else GetStringForValue = CStr(Value) - End If + End Select If GetStringForValue = "" Then GetStringForValue = "(Undefined)" End If End Function -Private Function IsArray(Value As Variant) As Boolean - If Not IsEmpty(Value) Then - If IsObject(Value) Then - If TypeOf Value Is Collection Then - IsArray = True - End If - ElseIf VarType(Value) = vbArray Or VarType(Value) = 8204 Then - ' VarType = 8204 seems to arise from Array(...) constructor - IsArray = True +Private Function IsArrayOrCollection(Value As Variant) As Boolean + Select Case VBA.VarType(Value) + Case VBA.vbArray To VBA.vbArray + VBA.vbByte + IsArrayOrCollection = True + Case VBA.vbObject + If TypeOf Value Is Collection Then + IsArrayOrCollection = True End If - End If + End Select End Function diff --git a/src/SpecHelpers.bas b/src/SpecHelpers.bas deleted file mode 100644 index 4208f12..0000000 --- a/src/SpecHelpers.bas +++ /dev/null @@ -1,467 +0,0 @@ -Attribute VB_Name = "SpecHelpers" -'' -' SpecHelpers v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD -' -' General utilities for specs -' -' @dependencies -' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -'' -' Check if named range exists and return sheet index if it does -' -' @param {String} RangeName -' @param {String} [WB] Workbook to check or active workbook -' @returns {Integer} Index of sheet that named range is found on or -1 -' --------------------------------------------- ' - -Public Function NamedRangeExists(RangeName As String, Optional WB As Workbook) As Integer - Dim rngTest As Range, i As Long - - If WB Is Nothing Then: Set WB = ActiveWorkbook - With WB - On Error Resume Next - ' Loop through all sheets in workbook. In VBA, you MUST specify - ' the worksheet name which the named range is found on. Using - ' Named Ranges in worksheet functions DO work across sheets - ' without explicit reference. - For i = 1 To .Sheets.Count Step 1 - ' Try to set our variable as the named range. - Set rngTest = .Sheets(i).Range(RangeName) - - ' If there is no error then the name exists. - If Err = 0 Then - ' Set the function to TRUE & exit - NamedRangeExists = i - Exit Function - Else - ' Clear the error and keep trying - Err.Clear - End If - Next i - End With - - ' No range found, return -1 - NamedRangeExists = -1 -End Function - -'' -' Check if sheet exists in current workbook -' -' @param {String} sheetName -' @param {Workbook} [WB] Workbook to check or active workbook -' @returns {Boolean} -' --------------------------------------------- ' - -Public Function SheetExists(SheetName As String, Optional WB As Workbook) As Boolean - Dim Sheet As Worksheet - - If WB Is Nothing Then: Set WB = ActiveWorkbook - If Not WB Is Nothing Then - For Each Sheet In WB.Sheets - If Sheet.Name = SheetName Then - SheetExists = True - Exit Function - End If - Next Sheet - End If -End Function - -'' -' Check if sheet is visible in current workbook -' -' @param {String} sheetName -' @param {Workbook} [WB] Workbook to check or active workbook -' @returns {Boolean} -' --------------------------------------------- ' - -Public Function SheetIsVisible(SheetName As String, Optional WB As Workbook) As Boolean - - If WB Is Nothing Then: Set WB = ActiveWorkbook - If SheetExists(SheetName, WB) Then - Dim Sheet As Worksheet - Set Sheet = WB.Sheets(SheetName) - - Select Case WB.Sheets(SheetName).Visible - Case XlSheetVisibility.xlSheetVisible: SheetIsVisible = True - End Select - End If -End Function - -'' -' Check if workbook is protected -' -' @param {Workbook} [WB] Workbook to check or active workbook -' @returns {Boolean} -' --------------------------------------------- ' - -Public Function WBIsProtected(Optional WB As Workbook) As Boolean - - If WB Is Nothing Then: Set WB = ActiveWorkbook - If WB.ProtectWindows Then WBIsProtected = True - If WB.ProtectStructure Then WBIsProtected = True -End Function - -'' -' Check if sheet is protected -' -' @param {String} sheetName -' @param {Workbook} [WB] Workbook to check or active workbook -' @returns {Boolean} -' --------------------------------------------- ' - -Public Function SheetIsProtected(SheetName As String, Optional WB As Workbook) As Boolean - - If WB Is Nothing Then: Set WB = ActiveWorkbook - If WB.Sheets(SheetName).ProtectContents Then SheetIsProtected = True - If WB.Sheets(SheetName).ProtectDrawingObjects Then SheetIsProtected = True - If WB.Sheets(SheetName).ProtectScenarios Then SheetIsProtected = True -End Function - -'' -' Check if file exists -' -' @param {String} filePath -' @returns {Boolean} -' --------------------------------------------- ' - -Public Function FileExists(filePath As String) As Boolean - On Error GoTo ErrorHandling - If Not Dir(filePath, vbDirectory) = vbNullString Then FileExists = True - -ErrorHandling: - On Error GoTo 0 -End Function - -'' -' Create SheetCell helper -' -' @param {String} sheetName -' @param {Integer} row -' @param {Integer} col -' @returns {Dictionary} -' --------------------------------------------- ' - -Public Function SheetCell(SheetName As String, Row As Integer, Col As Integer) As Dictionary - Set SheetCell = New Dictionary - SheetCell.Add "SheetName", SheetName - SheetCell.Add "Row", Row - SheetCell.Add "Col", Col -End Function - -'' -' Combine collections -' -' @param {Collection} collection1 -' @param {Collection} collection2 -' @returns {Collection} -' --------------------------------------------- ' - -Public Function CombineCollections(collection1 As Collection, collection2 As Collection) As Collection - Dim combined As New Collection - Dim Value As Variant - - For Each Value In collection1 - combined.Add Value - Next Value - For Each Value In collection2 - combined.Add Value - Next Value - - Set CombineCollections = combined -End Function - -'' -' Get last row for sheet -' -' @param {Worksheet} sheet -' @returns {Integer} -' --------------------------------------------- ' - -Public Function LastRow(Sheet As Worksheet) As Integer - Dim NumRows As Integer - NumRows = Sheet.UsedRange.Rows.Count - LastRow = Sheet.UsedRange.Rows(NumRows).Row -End Function - -'' -' Check if workbook is open -' -' @param {String} Path -' @returns {Boolean} -' --------------------------------------------- ' - -Public Function WorkbookIsOpen(Path As String) As Boolean - On Error Resume Next - Dim WB As Workbook - Set WB = Application.Workbooks(Filename) - On Error GoTo 0 - - ' If failed to load already open workbook, open it - If Err.Number = 0 Then - WorkbookIsOpen = True - End If - - Set WB = Nothing - Err.Clear -End Function - -'' -' Toggle screen updating and return previous updating value -' -' @param {Boolean} [Updating=False] -' @param {Boolean} [ToggleEvents=True] -' -' Example: -' Dim PrevUpdating As Boolean -' PrevUpdating = SpecHelpers.ToggleUpdating() -' -' ... Do screen-intensive stuff -' -' ' Restore previous updating status after hard work -' ToggleUpdating PrevUpdating -' -' --------------------------------------- ' -Public Function ToggleUpdating(Optional Updating As Boolean = False, Optional ToggleEvents As Boolean = True) As Boolean - ToggleUpdating = Application.ScreenUpdating - - Application.ScreenUpdating = Updating - If Updating Or Events Then - Application.EnableEvents = Updating - End If -End Function - -'' -' Run scenario using given scenario, sheet name, and IWBProxy -' -' @param {IScenario} Scenario -' @param {IWBProxy} WB to use for scenario -' @param {String} SheetName to load scenario from -' --------------------------------------------- ' - -Public Function RunScenario(Scenario As IScenario, WB As IWBProxy, SheetName As String) As SpecSuite - If SpecHelpers.SheetExists(SheetName, ThisWorkbook) Then - Scenario.Load SheetName - Set RunScenario = Scenario.RunScenario(WB) - Else - MsgBox "Warning" & vbNewLine & "No sheet was found for the following scenario: " & SheetName, Title:="Scenario sheet not found" - End If -End Function - -'' -' Run scenarios using given scenario, sheet name, and IWBProxy -' -' @param {IScenario} Scenario -' @param {IWBProxy} WB to use for scenario -' @param {String} ... Pass scenario sheet names as additional arguments -' -' Example: -' RunScenarios(Scenario, WB, "Scenario 1", "Scenario 2", "Scenario 3") -' --------------------------------------------- ' - -Public Function RunScenarios(Scenario As IScenario, WB As IWBProxy, ParamArray SheetNames() As Variant) As Collection - Dim i As Integer - Dim SheetName As String - Dim Spec As SpecSuite - Set RunScenarios = New Collection - - For i = LBound(SheetNames) To UBound(SheetNames) - SheetName = SheetNames(i) - Set Spec = SpecHelpers.RunScenario(Scenario, WB, SheetName) - - If Not Spec Is Nothing Then - RunScenarios.Add Spec - End If - Next i -End Function - -'' -' Run scenarios using given scenario and IWBProxy by matcher -' -' @param {IScenario} Scenario -' @param {IWBProxy} WB to use for scenario -' @param {String} Matcher to compare all sheet names to -' @param {Boolean} [MatchCase=False] -' -' Example: -' RunScenarios(Scenario, WB, "Scenario") -' Sheet Names: Spec Runner, Mapping, Scenario 1, and Advanced Scenario -' -> Runs scenarios for Scenario 1 and Advanced Scenario -' --------------------------------------------- ' - -Public Function RunScenariosByMatcher(Scenario As IScenario, WB As IWBProxy, Matcher As String, _ - Optional MatchCase As Boolean = False, Optional IgnoreBlank As Boolean = True) As Collection - - Set RunScenariosByMatcher = New Collection - - Dim Sheet As Worksheet - For Each Sheet In ThisWorkbook.Sheets - If Sheet.Name = "Blank Scenario" Then - If Not IgnoreBlank Then - RunScenariosByMatcher.Add SpecHelpers.RunScenario(Scenario, WB, Sheet.Name) - End If - ElseIf MatchCase Then - If InStr(Sheet.Name, Matcher) Then - RunScenariosByMatcher.Add SpecHelpers.RunScenario(Scenario, WB, Sheet.Name) - End If - Else - If InStr(UCase(Sheet.Name), UCase(Matcher)) Then - RunScenariosByMatcher.Add SpecHelpers.RunScenario(Scenario, WB, Sheet.Name) - End If - End If - Next Sheet -End Function - -'' -' Get value from workbook for provided mapping and key -' -' @param {Workbook} WB -' @param {Dictionary} Mapping -' @param {String} Key -' @returns {Variant} Value from workbook -' --------------------------------------------- ' - -Public Function GetValue(WB As Workbook, Mapping As Dictionary, Key As String) As Variant - Dim RangeRef As Range - - Set RangeRef = GetRange(WB, Mapping, Key) - If Not RangeRef Is Nothing Then - GetValue = RangeRef.Value - End If -End Function - -'' -' Set value in workbook for provided mapping and key -' -' @param {Workbook} WB -' @param {Dictionary} Mapping -' @param {String} Key -' @param {Variant} Value -' --------------------------------------------- ' - -Public Function SetValue(WB As Workbook, Mapping As Dictionary, Key As String, Value As Variant) - Dim RangeRef As Range - - Set RangeRef = GetRange(WB, Mapping, Key) - If Not RangeRef Is Nothing Then - RangeRef.Value = Value - End If -End Function - -'' -' Get reference to range from workbook for provided mapping and key -' -' @param {Workbook} WB -' @param {Dictionary} Mapping -' @param {String} Key -' @returns {Range} Range from workbook -' --------------------------------------------- ' - -Public Function GetRange(WB As Workbook, Mapping As Dictionary, Key As String) As Range - Dim MappingValue As Dictionary - Dim NamedRangeSheetIndex As Integer - - If Mapping.Exists(Key) Then - ' If mapping contains entry for key, use it to find range - Set MappingValue = Mapping.Item(Key) - Set GetRange = WB.Sheets(MappingValue("SheetName")) _ - .Cells(MappingValue("Row"), MappingValue("Col")) - Else - ' Check for named range matching mapping key - NamedRangeSheetIndex = SpecHelpers.NamedRangeExists(Key, WB) - If NamedRangeSheetIndex > 0 Then - Set GetRange = WB.Sheets(NamedRangeSheetIndex).Range(Key) - End If - End If -End Function - -'' -' Set range in workbook for provided mapping and key -' -' @param {Workbook} WB -' @param {Dictionary} Mapping -' @param {String} Key -' @param {Variant} Value -' --------------------------------------------- ' - -Public Function SetRange(WB As Workbook, Mapping As Dictionary, Key As String, Value As Range) - Dim RangeRef As Range - - Set RangeRef = GetRange(WB, Mapping, Key) - If Not IsEmpty(RangeRef) Then - Set RangeRef = Value - End If -End Function - -'' -' Open the workbook specified in the workbook proxy -' (Opens a temporary copy if the workbook is currently open) -' -' @param {Variant} WBOrInArray IWBProxy directly or in array -' --------------------------------------------- ' - -Public Sub OpenIWBProxy(WBOrInArray As Variant) - Dim WB As IWBProxy - - If TypeOf WBOrInArray Is IWBProxy Then - Set WB = WBOrInArray - Else - Set WB = WBOrInArray(0) - End If - - ' TODO temporary copy - Dim PrevUpdating As Boolean - PrevUpdating = SpecHelpers.ToggleUpdating - - If WB.Path <> "" Then - Set WB.Instance = Workbooks.Open(WB.Path, UpdateLinks:=False, Password:=WB.Password) - Else - Err.Raise vbObjectError + 1, "Specs", "Error: No workbook path defined" - End If - - SpecHelpers.ToggleUpdating PrevUpdating -End Sub - -'' -' Close the workbook specified in the workbook proxy -' -' @param {Variant} WBOrInArray IWBProxy directly or in array -' --------------------------------------------- ' - -Public Sub CloseIWBProxy(WBOrInArray As Variant) - Dim WB As IWBProxy - - If TypeOf WBOrInArray Is IWBProxy Then - Set WB = WBOrInArray - Else - Set WB = WBOrInArray(0) - End If - - If Not WB.Instance Is Nothing Then - WB.Instance.Close False - Set WB.Instance = Nothing - End If -End Sub - -'' -' Close and reopen the workbook specified in the workbook proxy -' -' @param {Variant} WBOrInArray IWBProxy directly or in array -' --------------------------------------------- ' - -Public Sub ReloadIWBProxy(WBOrInArray As Variant) - Dim WB As IWBProxy - - If TypeOf WBOrInArray Is IWBProxy Then - Set WB = WBOrInArray - Else - Set WB = WBOrInArray(0) - End If - - SpecHelpers.CloseIWBProxy WB - SpecHelpers.OpenIWBProxy WB -End Sub diff --git a/src/SpecSuite.cls b/src/SpecSuite.cls index fb580a1..b89387c 100644 --- a/src/SpecSuite.cls +++ b/src/SpecSuite.cls @@ -8,105 +8,155 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' SpecSuite v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD +' SpecSuite v2.0.0-alpha +' (c) Tim Hall - https://github.com/VBA-tools/Excel-TDD ' -' A collection of specs with the workbook that they act on +' A collection of specs and results ' -' @dependencies +' @class SpecSuite ' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' +' @license MIT (http://www.opensource.org/licenses/mit-license.php) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Option Explicit + +' --------------------------------------------- ' +' Types, Events, and Properties +' --------------------------------------------- ' -Private pSpecsCol As Collection +Public Enum SpecResultType + Pass + Fail + Pending +End Enum -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Properties -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Public Event BeforeEach() +Public Event Result(Definition As SpecDefinition) +Public Event AfterEach() +'' +' (Optional) description of suite for display in runners +' +' @property Description +' @type String +'' Public Description As String -Public BeforeEachCallback As String -Public BeforeEachCallbackArgs As Variant +'' +' @property Specs +' @type Collection +'' +Public Specs As VBA.Collection + +'' +' @property Result +' @type SpecResultType +'' +Public Property Get Result() As SpecResultType + Result = SpecResultType.Pending -Public Property Get SpecsCol() As Collection - If pSpecsCol Is Nothing Then: Set pSpecsCol = New Collection - Set SpecsCol = pSpecsCol + Dim Spec As SpecDefinition + For Each Spec In Me.Specs + If Spec.Result = SpecResultType.Pass Then + Result = SpecResultType.Pass + ElseIf Spec.Result = SpecResultType.Fail Then + Result = SpecResultType.Fail + Exit For + End If + Next Spec End Property -Public Property Let SpecsCol(Value As Collection) - Set pSpecsCol = Value + +'' +' @property PassedSpecs +' @type Collection +'' +Public Property Get PassedSpecs() As Collection + Dim Spec As SpecDefinition + Dim Filtered As New Collection + For Each Spec In Me.Specs + If Spec.Result = SpecResultType.Pass Then + Filtered.Add Spec + End If + Next Spec + + Set PassedSpecs = Filtered End Property +'' +' @property FailedSpecs +' @type Collection +'' +Public Property Get FailedSpecs() As Collection + Dim Spec As SpecDefinition + Dim Filtered As New Collection + For Each Spec In Me.Specs + If Spec.Result = SpecResultType.Fail Then + Filtered.Add Spec + End If + Next Spec + + Set FailedSpecs = Filtered +End Property -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +'' +' @property PendingSpecs +' @type Collection +'' +Public Property Get PendingSpecs() As Collection + Dim Spec As SpecDefinition + Dim Filtered As New Collection + For Each Spec In Me.Specs + If Spec.Result = SpecResultType.Pending Then + Filtered.Add Spec + End If + Next Spec + + Set PendingSpecs = Filtered +End Property +'' +' + +' ============================================= ' ' Public Methods -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +' ============================================= ' '' ' Create a new spec definition with description ' +' @method It ' @param {String} Description -' @param {String} [SpecId] Useful for identifying specific specs -' @returns {SpecDefinition} Initialized Spec Definition -' --------------------------------------------- ' - -Public Function It(Description As String, Optional SpecId As String = "") As SpecDefinition +' @param {String} [Id = ""] Useful for identifying specific specs +' @returns {SpecDefinition} +'' +Public Function It(Description As String, Optional Id As String = "") As SpecDefinition Dim Spec As New SpecDefinition - ' Call BeforeEach if defined - ExecuteBeforeEach + RaiseEvent BeforeEach - ' Initialize spec + ' Prepare Spec Spec.Description = Description - Spec.Id = SpecId - Me.SpecsCol.Add Spec + Spec.Id = Id + Set Spec.Suite = Me + Set It = Spec End Function '' -' Setup a callback to run before each spec -' -' @param {String} Callback -' @param {...} CallbackArgs any additional arguments to pass as array to callback each time +' Called at completion of SpecDefinition ' -' Example: -' BeforeEach "Cleanup", 100, 200 -' -' ' Cleanup is called before each spec with Args = [100, 200] -' Sub Cleanup(Args As Variant) -' ThisWorkbook.Sheets("Main").Cells(1, 1) = Args(0) ' (100) -' ThisWorkbook.Sheets("Main").Cells(2, 1) = Args(1) ' (200) -' End Sub -' --------------------------------------------- ' - -Public Sub BeforeEach(Callback As String, ParamArray CallbackArgs() As Variant) - Me.BeforeEachCallback = Callback - Me.BeforeEachCallbackArgs = CallbackArgs +' @internal +' @method SpecDone +' @param {SpecDefinition} Spec +'' +Public Sub SpecDone(Spec As SpecDefinition) + Me.Specs.Add Spec + RaiseEvent Result(Spec) + RaiseEvent AfterEach End Sub +' ============================================= ' +' Private Functions +' ============================================= ' -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Internal Methods -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -Private Sub ExecuteBeforeEach() - If Me.BeforeEachCallback <> "" Then - Dim HasArguments As Boolean - If VarType(Me.BeforeEachCallbackArgs) = vbObject Then - If Not Me.BeforeEachCallbackArgs Is Nothing Then - HasArguments = True - End If - ElseIf IsArray(Me.BeforeEachCallbackArgs) Then - If UBound(Me.BeforeEachCallbackArgs) >= 0 Then - HasArguments = True - End If - End If - - If HasArguments Then - Application.Run Me.BeforeEachCallback, Me.BeforeEachCallbackArgs - Else - Application.Run Me.BeforeEachCallback - End If - End If +Private Sub Class_Initialize() + Set Me.Specs = New VBA.Collection End Sub diff --git a/src/WBProxy.cls b/src/WBProxy.cls deleted file mode 100644 index 704cd2e..0000000 --- a/src/WBProxy.cls +++ /dev/null @@ -1,170 +0,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "WBProxy" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = True -'' -' WBProxy v1.4.0 -' (c) Tim Hall - https://github.com/timhall/Excel-TDD -' -' Generic implementation of workbook proxy -' -' @dependencies -' Microsoft Scripting Runtime -' @author tim.hall.engr@gmail.com -' @license: MIT (http://www.opensource.org/licenses/mit-license.php) -' -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -Implements IWBProxy - -Private Const MappingSheetCellsStartRow As Integer = 4 -Private Const MappingSheetCellsStartCol As Integer = 1 -Private Const MappingValuesStartRow As Integer = 4 -Private Const MappingValuesStartCol As Integer = 5 - -Private pPath As String -Private pPassword As String -Private pInstance As Workbook -Private pMapping As Dictionary - -Public Sub DefineMapping(SheetName As String) - Dim MappingSheet As Worksheet - Dim Row As Integer - Set pMapping = New Dictionary - - If SpecHelpers.SheetExists(SheetName) Then - Set MappingSheet = ThisWorkbook.Sheets(SheetName) - - Row = MappingSheetCellsStartRow - Do While MappingSheet.Cells(Row, MappingSheetCellsStartCol) <> "" - Call pMapping.Add( _ - Trim(CStr(MappingSheet.Cells(Row, MappingSheetCellsStartCol))), _ - SheetCell( _ - MappingSheet.Cells(Row, MappingSheetCellsStartCol + 1), _ - MappingSheet.Cells(Row, MappingSheetCellsStartCol + 2), _ - MappingSheet.Cells(Row, MappingSheetCellsStartCol + 3) _ - ) _ - ) - - Row = Row + 1 - Loop - - Row = MappingValuesStartRow - Do While MappingSheet.Cells(Row, MappingValuesStartCol) <> "" - Call pMapping.Add( _ - Trim(CStr(MappingSheet.Cells(Row, MappingValuesStartCol))), _ - MappingSheet.Cells(Row, MappingValuesStartCol + 1) _ - ) - - Row = Row + 1 - Loop - End If -End Sub - -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' Common to all IWBProxy implementations -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -Private Sub IWBProxy_DefineMapping(SheetName As String) - Call Me.DefineMapping(SheetName) -End Sub - -Public Property Get Range(MappingKey As String) As Range - Set Range = SpecHelpers.GetRange(Instance, Mapping, MappingKey) -End Property -Private Property Get IWBProxy_Range(MappingKey As String) As Range - Set IWBProxy_Range = Range(MappingKey) -End Property -Public Property Set Range(MappingKey As String, Value As Range) - Call SpecHelpers.SetRange(Instance, Mapping, MappingKey, Value) -End Property -Private Property Set IWBProxy_Range(MappingKey As String, Value As Range) - Set Range(MappingKey) = Value -End Property - -Public Property Get Value(MappingKey As String) As Variant - Value = SpecHelpers.GetValue(Instance, Mapping, MappingKey) -End Property -Private Property Get IWBProxy_Value(MappingKey As String) As Variant - IWBProxy_Value = Value(MappingKey) -End Property -Public Property Let Value(MappingKey As String, NewValue As Variant) - Call SpecHelpers.SetValue(Instance, Mapping, MappingKey, NewValue) -End Property -Private Property Let IWBProxy_Value(MappingKey As String, NewValue As Variant) - Value(MappingKey) = NewValue -End Property - -Public Property Get Instance() As Workbook - Set Instance = pInstance -End Property -Private Property Get IWBProxy_Instance() As Workbook - Set IWBProxy_Instance = Instance -End Property -Public Property Set Instance(Value As Workbook) - Set pInstance = Value -End Property -Private Property Set IWBProxy_Instance(Value As Workbook) - Set Instance = Value -End Property - -Public Property Get Mapping() As Dictionary - Set Mapping = IWBProxy_Mapping -End Property -Private Property Get IWBProxy_Mapping() As Dictionary - If pMapping Is Nothing Then: Set pMapping = New Dictionary - Set IWBProxy_Mapping = pMapping -End Property -Public Property Set Mapping(Value As Dictionary) - Set IWBProxy_Mapping = Value -End Property -Private Property Set IWBProxy_Mapping(Value As Dictionary) - Set pMapping = Value -End Property - -Public Property Get Password() As String - Password = pPassword -End Property -Private Property Get IWBProxy_Password() As String - IWBProxy_Password = Password -End Property -Public Property Let Password(Value As String) - pPassword = Value -End Property -Private Property Let IWBProxy_Password(Value As String) - Password = Value -End Property - -Public Property Get Path() As String - Path = pPath -End Property -Private Property Get IWBProxy_Path() As String - IWBProxy_Path = Path -End Property -Public Property Let Path(Value As String) - pPath = Value -End Property -Private Property Let IWBProxy_Path(Value As String) - Path = Value -End Property - -Public Property Get TempPath() As String - TempPath = pTempPath -End Property -Public Property Get IWBProxy_TempPath() As String - IWBProxy_TempPath = TempPath -End Property -Public Property Let TempPath(Value As String) - pTempPath = Value -End Property -Public Property Let IWBProxy_TempPath(Value As String) - TempPath = Value -End Property - -Private Sub Class_Terminate() - Set Me.Instance = Nothing -End Sub diff --git a/src/WorkbookReporter.cls b/src/WorkbookReporter.cls new file mode 100644 index 0000000..1f2b5fc --- /dev/null +++ b/src/WorkbookReporter.cls @@ -0,0 +1,222 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "WorkbookReporter" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = True +'' +' DisplayReporter v2.0.0-alpha +' (c) Tim Hall - https://github.com/VBA-tools/Excel-TDD +' +' Report results to Worksheet +' +' @class DisplayReporter +' @author tim.hall.engr@gmail.com +' @license MIT (http://www.opensource.org/licenses/mit-license.php) +' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Private Const ProgressWidth As Long = 128 +Private pSheet As Worksheet +Private pCount As Long +Private pTotal As Long +Private pSuites As Collection + +' ============================================= ' +' Public Methods +' ============================================= ' + +'' +' Connect the display runner to a Worksheet to output results +' +' The given Worksheet should have names for: +' - "Progress" (Shape with width) +' - "ProgressBorder" (Shape) +' - "Result" (Cell) - Cell to output overall result +' - "Output" (Cell) - First cell to output results +' +' @method ConnectTo +' @param {Worksheet} Sheet +'' +Public Sub ConnectTo(Sheet As Worksheet) + Set pSheet = Sheet +End Sub + +'' +' Call this at the beginning of a test run to reset the worksheet +' (pass overall number of test suites that will be run to display progress) +' +' @method Start +' @param {Long} [NumSuites = 0] +'' +Public Sub Start(Optional NumSuites As Long = 0) + pCount = 0 + pTotal = NumSuites + + ClearResults + ShowProgress + DisplayResult "Running" +End Sub + +'' +' Output the given suite +' +' @method Output +' @param {SpecSuite} Suite +'' +Public Sub Output(Suite As SpecSuite) + pCount = pCount + 1 + pSuites.Add Suite + + ShowProgress + DisplayResults +End Sub + +'' +' After outputing all suites, display overall result +' +' @method Done +'' +Public Sub Done() + Dim Failed As Boolean + Dim Suite As SpecSuite + For Each Suite In pSuites + If Suite.Result = SpecResultType.Fail Then + Failed = True + Exit For + End If + Next Suite + + DisplayResult IIf(Failed, "FAIL", "PASS") +End Sub + +' ============================================= ' +' Private Functions +' ============================================= ' + +Private Sub ShowProgress() + If pTotal <= 0 Then + HideProgress + Exit Sub + End If + + Dim Percent As Double + Percent = pCount / pTotal + + If Percent > 1 Then + Debug.Print "WARNING: DisplayRunner has output more suites than specified in Start" + Percent = 1 + End If + + pSheet.Shapes("Progress").Width = ProgressWidth * Percent + pSheet.Shapes("Progress").Visible = True + pSheet.Shapes("ProgressBorder").Visible = True +End Sub + +Private Sub HideProgress() + pSheet.Shapes("Progress").Visible = False + pSheet.Shapes("ProgressBorder").Visible = False +End Sub + +Private Sub DisplayResult(Value As String) + With pSheet.Range("Result") + .Font.Size = IIf(Value = "Running", 12, 14) + .Value = Value + End With +End Sub + +Private Sub ClearResults() + Dim StartRow As Long + Dim StartColumn As Long + StartRow = pSheet.Range("Output").Row + StartColumn = pSheet.Range("Output").Column + + Dim LastRow As Long + LastRow = StartRow + Do While pSheet.Cells(LastRow + 1, StartColumn).Value <> "" + LastRow = LastRow + 1 + Loop + + With pSheet.Range(pSheet.Cells(StartRow, StartColumn), pSheet.Cells(LastRow, StartColumn + 1)) + .Value = "" + .Font.Bold = False + .Borders(xlInsideHorizontal).LineStyle = xlNone + End With +End Sub + +Private Sub DisplayResults() + Dim Rows As New Collection + Dim Dividers As New Collection + Dim Headings As New Collection + + Dim Suite As SpecSuite + Dim Spec As SpecDefinition + Dim Expectation As SpecExpectation + For Each Suite In pSuites + If Rows.Count > 0 Then + Dividers.Add Rows.Count + End If + + If Suite.Description <> "" Then + Headings.Add Rows.Count + Rows.Add Array(Suite.Description, ResultTypeToString(Suite.Result)) + End If + + For Each Spec In Suite.Specs + Rows.Add Array(Spec.Description, ResultTypeToString(Spec.Result)) + + For Each Expectation In Spec.FailedExpectations + Rows.Add Array(" " & Expectation.FailureMessage, "") + Next Expectation + Next Spec + Next Suite + + Dim OutputValues() As String + Dim Row As Variant + Dim i As Long + ReDim OutputValues(Rows.Count - 1, 1) + i = 0 + For Each Row In Rows + OutputValues(i, 0) = Row(0) + OutputValues(i, 1) = Row(1) + i = i + 1 + Next Row + + Dim StartRow As Long + Dim StartColumn As Long + StartRow = pSheet.Range("Output").Row + StartColumn = pSheet.Range("Output").Column + + pSheet.Range(pSheet.Cells(StartRow, StartColumn), pSheet.Cells(StartRow + Rows.Count - 1, StartColumn + 1)).Value = OutputValues + + Dim Divider As Variant + For Each Divider In Dividers + With pSheet.Range(pSheet.Cells(StartRow + Divider, StartColumn), pSheet.Cells(StartRow + Divider, StartColumn + 1)).Borders(xlEdgeTop) + .LineStyle = xlContinuous + .ThemeColor = 1 + .TintAndShade = -0.249946592608417 + .Weight = xlThin + End With + Next Divider + + Dim Heading As Variant + For Each Heading In Headings + pSheet.Cells(StartRow + Heading, StartColumn).Font.Bold = True + Next Heading +End Sub + +Private Function ResultTypeToString(ResultType As SpecResultType) As String + Select Case ResultType + Case SpecResultType.Pass + ResultTypeToString = "Pass" + Case SpecResultType.Fail + ResultTypeToString = "Fail" + Case SpecResultType.Pending + ResultTypeToString = "Pending" + End Select +End Function + +Private Sub Class_Initialize() + Set pSuites = New Collection +End Sub