diff --git a/README.md b/README.md index 9a1ee6c..71d361e 100644 --- a/README.md +++ b/README.md @@ -1,41 +1,38 @@ -VBA-TDD -======= +# vba-test -Bring the reliability of other programming realms to VBA with Test-Driven Development (TDD) for VBA on Windows and Mac. +Add testing to VBA on Windows and Mac. -Quick example: +## Example ```vb -Function Specs() As SpecSuite - Set Specs = New SpecSuite - Specs.Description = "Add" - - ' Report results to the Immediate Window - ' (ctrl + g or View > Immediate Window) - Dim Reporter As New ImmediateReporter - Reporter.ListenTo Specs - - ' Describe the desired behavior - With Specs.It("should add two numbers") - ' Test the desired behavior - .Expect(Add(2, 2)).ToEqual 4 - .Expect(Add(3, -1)).ToEqual 2 - .Expect(Add(-1, -2)).ToEqual -3 - End With - - With Specs.It("should add any number of numbers") - .Expect(Add(1, 2, 3)).ToEqual 6 - .Expect(Add(1, 2, 3, 4)).ToEqual 10 - End With -End Function +Function AddTests() As TestSuite + Set AddTests = New TestSuite + AddTests.Description = "Add" + + ' Report results to the Immediate Window + ' (ctrl + g or View > Immediate Window) + Dim Reporter As New ImmediateReporter + Reporter.ListenTo AddTests + + With AddTests.Test("should add two numbers") + .IsEqual Add(2, 2), 4 + .IsEqual Add(3, -1), 2 + .IsEqual Add(-1, -2), -3 + End With + + With AddTests.Test("should add any number of numbers") + .IsEqual Add(1, 2, 3), 6 + .IsEqual Add(1, 2, 3, 4), 10 + End With +End Sub Public Function Add(ParamArray Values() As Variant) As Double - Dim i As Integer - Add = 0 - - For i = LBound(Values) To UBound(Values) - Add = Add + Values(i) - Next i + Dim i As Integer + Add = 0 + + For i = LBound(Values) To UBound(Values) + Add = Add + Values(i) + Next i End Function ' Immediate Window: @@ -48,131 +45,164 @@ End Function For details of the process of reaching this example, see the [TDD Example](https://github.com/VBA-tools/VBA-TDD/wiki/TDD-Example) -### Advanced Example +## Advanced Example -For an advanced example of what is possible with VBA-TDD, check out the [specs for VBA-Web](https://github.com/VBA-tools/VBA-Web/tree/master/specs) +For an advanced example of what is possible with vba-test, check out the [tests for VBA-Web](https://github.com/VBA-tools/VBA-Web/tree/master/specs) -### Getting Started +## Getting Started -1. Download the [latest release (v2.0.0-beta)](https://github.com/VBA-tools/VBA-TDD/releases) -2. Add `src/SpecSuite.cls`, `src/SpecDefinition.cls`, `src/SpecExpectation.cls`, add `src/ImmediateReporter.cls` to your project -3. If you're starting from scratch with Excel, you can use `VBA-TDD - Blank.xlsm` +1. Download the [latest release (v2.0.0-beta.2)](https://github.com/vba-tools/vba-test/releases) +2. Add `src/TestSuite.cls`, `src/TestCase.cls`, add `src/ImmediateReporter.cls` to your project +3. If you're starting from scratch with Excel, you can use `vba-test-blank.xlsm` -### It and Expect +## TestSuite -`It` is how you describe desired behavior and once a collection of specs is written, it should read like a list of requirements. +A test suite groups tests together, runs test hooks for actions that should be run before and after tests, and is responsible for passing test results to reporters. ```vb -With Specs.It("should allow user to continue if they are authorized and up-to-date") - ' ... -End With - -With Specs.It("should show an X when the user rolls a strike") - ' ... +' Create a new test suite +Dim Suite As New TestSuite +Suite.Description = "Module Name" + +' Create a new test +Dim Test As TestCase +Set Test = Suite.Test("Test Name") +Test.IsEqual ' ... + +' or create and use test using With +With Suite.Test("Test Name") + .IsEqual '... End With ``` -`Expect` is how you test desired behavior +__TestSuite API__ + +- `Description` +- `Test(Name) As TestCase` +- _Event_ `BeforeEach(Test)` +- _Event_ `Result(Test)` +- _Event_ `AfterEach(Test)` + +## TestCase + +A test case uses assertions to test a specific part of your application. ```vb -With Specs.It("should check values") - .Expect(2 + 2).ToEqual 4 - .Expect(2 + 2).ToNotEqual 5 - .Expect(2 + 2).ToBeLessThan 7 - .Expect(2 + 2).ToBeLT 6 - .Expect(2 + 2).ToBeLessThanOrEqualTo 5 - .Expect(2 + 2).ToBeLTE 4 - .Expect(2 + 2).ToBeGreaterThan 1 - .Expect(2 + 2).ToBeGT 2 - .Expect(2 + 2).ToBeGreaterThanOrEqualTo 3 - .Expect(2 + 2).ToBeGTE 4 - .Expect(2 + 2).ToBeCloseTo 3.9, 0 +With Suite.Test("specific part of your application") + .IsEqual A, B, "(optional message, e.g. result should be 12)" + .NotEqual B, C + + .IsOk C > B + .NotOk B > C + + .IsUndefined ' Checks Nothing, Empty, Missing, or Null + .NotUndefined + + .Includes Array(1, 2, 3), 2 + .NotIncludes Array(1, 2, 3), 4 + .IsApproximate 1.001, 1.002, 2 + .NotApproximate 1.001, 1.009, 3 + + .Pass + .Fail "e.g. should not have gotten here" + .Plan 4 ' Should only be 4 assertions, more or less fails + .Skip ' skip this test End With -With Specs.It("should check Nothing, Empty, Missing, and Null") - .Expect(Nothing).ToBeNothing - .Expect(Empty).ToBeEmpty - .Expect().ToBeMissing - .Expect(Null).ToBeNull - - ' `ToBeUndefined` checks if it's Nothing or Empty or Missing or Null - - .Expect(Nothing).ToBeUndefined - .Expect(Empty).ToBeUndefined - .Expect().ToBeUndefined - .Expect(Null).ToBeUndefined - - ' Classes are undefined until they are instantiated - Dim Sheet As Worksheet - .Expect(Sheet).ToBeNothing - - .Expect("Howdy!").ToNotBeUndefined - .Expect(4).ToNotBeUndefined - - Set Sheet = ThisWorkbook.Sheets(1) - .Expect(Sheet).ToNotBeUndefined +With Suite.Test("complex things") + .IsEqual _ + ThisWorkbook.Sheets("Hidden").Visible, _ + XlSheetVisibility.xlSheetVisible + .IsEqual _ + ThisWorkbook.Sheets("Main").Cells(1, 1).Interior.Color, _ + RGB(255, 0, 0) End With +``` + +In addition to these basic assertions, custom assertions can be made by passing the `TestCase` to an assertion function + +```vb +Sub ToBeWithin(Test As TestCase, Value As Variant, Min As Variant, Max As Variant) + Dim Message As String + Message = "Expected " & Value & " to be within " & Min & " and " & Max + + Test.IsOk Value >= Min, Message + Test.IsOk Value <= Max, Message +End Sub -With Specs.It("should test complex things") - .Expect(ThisWorkbook.Sheets("Hidden").Visible).ToNotEqual XlSheetVisibility.xlSheetVisible - .Expect(ThisWorkbook.Sheets("Main").Cells(1, 1).Interior.Color).ToEqual RGB(255, 0, 0) +With Suite.Test("...") + ToBeWithin(.Self, Value, 0, 100) End With ``` -### ImmediateReporter +__TestCase API__ + +- `Test.Name` +- `Test.Self` - Reference to test case (useful inside of `With`) +- `Test.Context` - `Dictionary` holding test context (useful for `BeforeEach`/`AfterEach`) +- `Test.IsEqual(A, B, [Message])` +- `Test.NotEqual(A, B, [Message])` +- `Test.IsOk(Value, [Message])` +- `Test.NotOk(Value, [Message])` +- `Test.IsUndefined(Value, [Message])` +- `Test.NotUndefined(Value, [Message])` +- `Test.Includes(Values, Value, [Message])` - Check if value is included in array or `Collection` +- `Test.NotIncludes(Values, Value, [Message])` +- `Test.IsApproximate(A, B, SignificantFigures, [Message])` - Check if two values are close to each other (useful for `Double` values) +- `Test.NotApproximate(A, B, SignificantFigures, [Message])` +- `Test.Pass()` - Explicitly pass the test +- `Test.Fail([Message])` - Explicitly fail the test +- `Test.Plan(Count)` - For tests with loops and branches, it is important to catch if any assertions are skipped or extra +- `Test.Skip()` - Notify suite to skip this test + +Generally, more advanced assertions should be added with custom assertions functions (detailed above), but there are common assertions that will be added (e.g. `IsApproximate` = close within significant fixtures, `Includes` = array/collection includes value, ) -With your specs defined, the easiest way to display the test results is with `ImmediateReporter`. This outputs results to the Immediate Window (`ctrl+g` or View > Immediate Window) and is useful for running your tests without leaving the VBA editor. +## ImmediateReporter + +With your tests defined, the easiest way to display the test results is with `ImmediateReporter`. This outputs results to the Immediate Window (`ctrl+g` or View > Immediate Window) and is useful for running your tests without leaving the VBA editor. ```vb -Public Function Specs As SpecSuite - Set Specs = New SpecSuite - Specs.Description = "..." +Public Function Suite As TestSuite + Set Suite = New TestSuite + Suite.Description = "..." - ' Create reporter and attach it to these specs - Dim Reporter As New ImmediateReporter - Reporter.ListenTo Specs + ' Create reporter and attach it to these specs + Dim Reporter As New ImmediateReporter + Reporter.ListenTo Suite - ' -> Reporter will now output results as they are generated + ' -> Reporter will now output results as they are generated End Function ``` -### RunMatcher +## Context / Lifecycle Hooks -For VBA applications that support `Application.Run` (which is at least Windows Excel, Word, and Access), you can create custom expect functions with `RunMatcher`. +`TestSuite` includes events for setup and teardown before tests and a `Context` object for passing values into tests that are properly torn down between tests. ```vb -Public Function Specs As SpecSuite - Set Specs = New SpecSuite - - With Specs.It("should be within 1 and 100") - .Expect(50).RunMatcher "ToBeWithin", "to be within", 1, 100 - ' ^ Actual - ' ^ Public Function to call - ' ^ message for matcher - ' ^ 0+ Args to pass to matcher - End With -End Function +' Class TestFixture +Private WithEvents pSuite As TestSuite -Public Function ToBeWithin(Actual As Variant, Args As Variant) As Variant - If UBound(Args) - LBound(Args) < 1 Then - ' Return string for specific failure message - ToBeWithin = "Need to pass in upper-bound to ToBeWithin" - Else - If Actual >= Args(0) And Actual <= Args(1) Then - ' Return true for pass - ToBeWithin = True - Else - ' Return false for fail or custom failure message - ToBeWithin = False - End If - End If -End Function -``` +Public Sub ListenTo(Suite As TestSuite) + Set pSuite = Suite +End Sub + +Private Sub pSuite_BeforeEach(Test As TestCase) + Test.Context.Add "fixture", New Collection +End Sub + +Private Sub pSuite_AfterEach(Test As TestCase) + ' Context is cleared automatically, + ' but can manually cleanup here +End Sub -To avoid compilation issues on unsupported applications, the compiler constant `EnableRunMatcher` in `SpecExpectation.cls` should be set to `False`. +' Elsewhere -For more details, check out the [Wiki](https://github.com/VBA-tools/VBA-TDD/wiki) +Dim Suite As New TestSuite -- Design based heavily on the [Jasmine](https://jasmine.github.io/) -- Author: Tim Hall -- License: MIT +Dim Fixture As New TestFixture +Fixture.ListenTo Suite + +With Suite.Test("...") + .Context("fixture").Add "..." +End With +``` diff --git a/specs/Specs_SpecDefinition.bas b/specs/Specs_SpecDefinition.bas deleted file mode 100644 index 032938a..0000000 --- a/specs/Specs_SpecDefinition.bas +++ /dev/null @@ -1,57 +0,0 @@ -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 - .Expect("A").ToEqual "A" - .Expect(2).ToEqual 2 - .Expect("pass").ToEqual "pass" - End With - - .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 - .Expect("A").ToEqual "A" - .Expect(2).ToEqual 2 - .Expect("pass").ToEqual "fail" - End With - - .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 - .Expect("A").ToEqual "A" - .Expect(2).ToEqual 1 - .Expect("pass").ToEqual "fail" - .Expect(True).ToEqual False - End With - - .Expect(Definition.Result).ToEqual SpecResultType.Fail - .Expect(Definition.FailedExpectations(1).Actual).ToEqual 2 - .Expect(Definition.FailedExpectations(1).Passed).ToEqual False - .Expect(Definition.FailedExpectations(2).Actual).ToEqual "pass" - .Expect(Definition.FailedExpectations(2).Passed).ToEqual False - .Expect(Definition.FailedExpectations(3).Actual).ToEqual True - .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 SpecResultType.Pending - End With -End Function diff --git a/specs/Specs_SpecExpectation.bas b/specs/Specs_SpecExpectation.bas deleted file mode 100644 index fa68896..0000000 --- a/specs/Specs_SpecExpectation.bas +++ /dev/null @@ -1,216 +0,0 @@ -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 - .Expect(3.14).ToEqual 3.14 - .Expect(1.50000000000001).ToEqual 1.50000000000001 - .Expect(True).ToEqual True - - .Expect("B").ToNotEqual "A" - .Expect(1).ToNotEqual 2 - .Expect(3.145).ToNotEqual 3.14 - .Expect(1.5).ToNotEqual 1.50000000000001 - .Expect(False).ToNotEqual True - End With - - With Specs.It("ToEqual/ToNotEqual with Double") - ' Compare to 15 significant figures - .Expect(123456789012345#).ToEqual 123456789012345# - .Expect(1.50000000000001).ToEqual 1.50000000000001 - .Expect(Val("1234567890123450")).ToEqual Val("1234567890123451") - .Expect(Val("0.1000000000000010")).ToEqual Val("0.1000000000000011") - - .Expect(123456789012344#).ToNotEqual 123456789012345# - .Expect(1.5).ToNotEqual 1.50000000000001 - .Expect(Val("1234567890123454")).ToNotEqual Val("1234567890123456") - .Expect(Val("0.1000000000000014")).ToNotEqual Val("0.1000000000000016") - End With - - With Specs.It("ToBeUndefined/ToNotBeUndefined") - .Expect(Nothing).ToBeUndefined - .Expect(Empty).ToBeUndefined - .Expect(Null).ToBeUndefined - .Expect().ToBeUndefined - - Dim Test As SpecExpectation - .Expect(Test).ToBeUndefined - - .Expect("A").ToNotBeUndefined - .Expect(2).ToNotBeUndefined - .Expect(3.14).ToNotBeUndefined - .Expect(True).ToNotBeUndefined - - Set Test = New SpecExpectation - .Expect(Test).ToNotBeUndefined - End With - - With Specs.It("ToBeNothing/ToNotBeNothing") - .Expect(Nothing).ToBeNothing - - Dim Test2 As SpecExpectation - .Expect(Test2).ToBeNothing - - .Expect(Null).ToNotBeNothing - .Expect(Empty).ToNotBeNothing - .Expect().ToNotBeNothing - .Expect("A").ToNotBeNothing - - Set Test2 = New SpecExpectation - .Expect(Test2).ToNotBeUndefined - End With - - With Specs.It("ToBeEmpty/ToNotBeEmpty") - .Expect(Empty).ToBeEmpty - - .Expect(Nothing).ToNotBeEmpty - .Expect(Null).ToNotBeEmpty - .Expect().ToNotBeEmpty - .Expect("A").ToNotBeEmpty - End With - - With Specs.It("ToBeNull/ToNotBeNull") - .Expect(Null).ToBeNull - - .Expect(Nothing).ToNotBeNull - .Expect(Empty).ToNotBeNull - .Expect().ToNotBeNull - .Expect("A").ToNotBeNull - End With - - With Specs.It("ToBeMissing/ToNotBeMissing") - .Expect().ToBeMissing - - .Expect(Nothing).ToNotBeMissing - .Expect(Null).ToNotBeMissing - .Expect(Empty).ToNotBeMissing - .Expect("A").ToNotBeMissing - End With - - With Specs.It("ToBeLessThan") - .Expect(1).ToBeLessThan 2 - .Expect(1.49999999999999).ToBeLessThan 1.5 - - .Expect(1).ToBeLT 2 - .Expect(1.49999999999999).ToBeLT 1.5 - End With - - With Specs.It("ToBeLessThanOrEqualTo") - .Expect(1).ToBeLessThanOrEqualTo 2 - .Expect(1.49999999999999).ToBeLessThanOrEqualTo 1.5 - .Expect(2).ToBeLessThanOrEqualTo 2 - .Expect(1.5).ToBeLessThanOrEqualTo 1.5 - - .Expect(1).ToBeLTE 2 - .Expect(1.49999999999999).ToBeLTE 1.5 - .Expect(2).ToBeLTE 2 - .Expect(1.5).ToBeLTE 1.5 - End With - - With Specs.It("ToBeGreaterThan") - .Expect(2).ToBeGreaterThan 1 - .Expect(1.5).ToBeGreaterThan 1.49999999999999 - - .Expect(2).ToBeGT 1 - .Expect(1.5).ToBeGT 1.49999999999999 - End With - - With Specs.It("ToBeGreaterThanOrEqualTo") - .Expect(2).ToBeGreaterThanOrEqualTo 1 - .Expect(1.5).ToBeGreaterThanOrEqualTo 1.49999999999999 - .Expect(2).ToBeGreaterThanOrEqualTo 2 - .Expect(1.5).ToBeGreaterThanOrEqualTo 1.5 - - .Expect(2).ToBeGTE 1 - .Expect(1.5).ToBeGTE 1.49999999999999 - .Expect(2).ToBeGTE 2 - .Expect(1.5).ToBeGTE 1.5 - End With - - With Specs.It("ToBeCloseTo") - .Expect(3.1415926).ToNotBeCloseTo 2.78, 3 - - .Expect(3.1415926).ToBeCloseTo 2.78, 1 - End With - - With Specs.It("ToContain") - .Expect(Array("A", "B", "C")).ToContain "B" - - Dim Test3 As New Collection - Test3.Add "A" - Test3.Add "B" - Test3.Add "C" - .Expect(Test3).ToContain "B" - - .Expect(Array("A", "B", "C")).ToNotContain "D" - .Expect(Test3).ToNotContain "D" - End With - - With Specs.It("ToMatch") - .Expect("abcde").ToMatch "bcd" - - .Expect("abcde").ToNotMatch "xyz" - End With - - With Specs.It("RunMatcher") - .Expect(100).RunMatcher "Specs_SpecExpectation.ToBeWithin", "to be within", 90, 110 - .Expect(Nothing).RunMatcher "Specs_SpecExpectation.ToBeNothing", "to be nothing" - End With - - 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 - If UBound(Args) - LBound(Args) < 1 Then - ' Return string for specific failure message - ToBeWithin = "Need to pass in upper-bound to ToBeWithin" - Else - If Actual >= Args(0) And Actual <= Args(1) Then - ' Return true for pass - ToBeWithin = True - Else - ' Return false for fail or custom failure message - ToBeWithin = False - End If - End If -End Function - -Public Function ToBeNothing(Actual As Variant) As Variant - If VBA.IsObject(Actual) Then - If Actual Is Nothing Then - ToBeNothing = True - Else - ToBeNothing = False - End If - Else - ToBeNothing = False - End If -End Function diff --git a/specs/Specs_SpecSuite.bas b/specs/Specs_SpecSuite.bas deleted file mode 100644 index 94dcd0c..0000000 --- a/specs/Specs_SpecSuite.bas +++ /dev/null @@ -1,79 +0,0 @@ -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/specs/VBA-TDD - Specs.xlsm b/specs/VBA-TDD - Specs.xlsm deleted file mode 100644 index 7bd0609..0000000 Binary files a/specs/VBA-TDD - Specs.xlsm and /dev/null differ diff --git a/src/ImmediateReporter.cls b/src/ImmediateReporter.cls index 45a7100..54a4503 100644 --- a/src/ImmediateReporter.cls +++ b/src/ImmediateReporter.cls @@ -15,7 +15,7 @@ Attribute VB_Exposed = True ' ' @class ImmediateReporter ' @author tim.hall.engr@gmail.com -' @license MIT (http://www.opensource.org/licenses/mit-license.php) +' @license MIT (https://opensource.org/licenses/MIT) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Option Explicit @@ -23,8 +23,8 @@ Option Explicit ' Constants and Private Variables ' --------------------------------------------- ' -Private WithEvents pSpecs As SpecSuite -Attribute pSpecs.VB_VarHelpID = -1 +Private WithEvents pSuite As TestSuite +Attribute pSuite.VB_VarHelpID = -1 Private Finished As Boolean ' ============================================= ' @@ -32,18 +32,18 @@ Private Finished As Boolean ' ============================================= ' '' -' Listen to given SpecSuite +' Listen to given TestSuite ' ' @method ListenTo -' @param {SpecSuite} Specs +' @param {TestSuite} Suite '' -Public Sub ListenTo(Specs As SpecSuite) - If Not pSpecs Is Nothing Then +Public Sub ListenTo(Suite As TestSuite) + If Not pSuite Is Nothing Then Done End If - Debug.Print "===" & IIf(Specs.Description <> "", " " & Specs.Description & " ===", "") - Set pSpecs = Specs + Debug.Print "===" & IIf(Suite.Description <> "", " " & Suite.Description & " ===", "") + Set pSuite = Suite Finished = False End Sub @@ -62,13 +62,13 @@ End Function ' Private Functions ' ============================================= ' -Private Function ResultTypeToString(ResultType As SpecResultType) As String +Private Function ResultTypeToString(ResultType As TestResultType) As String Select Case ResultType - Case SpecResultType.Pass + Case TestResultType.Pass ResultTypeToString = "+" - Case SpecResultType.Fail + Case TestResultType.Fail ResultTypeToString = "X" - Case SpecResultType.Pending + Case TestResultType.Pending ResultTypeToString = "." End Select End Function @@ -78,10 +78,13 @@ Private Function Summary() As String 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 Skipped As Long + + Total = pSuite.Tests.Count + Passed = pSuite.PassedTests.Count + Failed = pSuite.FailedTests.Count + Pending = pSuite.PendingTests.Count + Skipped = pSuite.SkippedTests.Count Dim SummaryMessage As String If Failed > 0 Then @@ -90,7 +93,10 @@ Private Function Summary() As String SummaryMessage = "PASS (" & Passed & " of " & Total & " passed" End If If Pending > 0 Then - SummaryMessage = SummaryMessage & ", " & Pending & " pending)" + SummaryMessage = SummaryMessage & ", " & Pending & " pending" + End If + If Skipped > 0 Then + SummaryMessage = SummaryMessage & ", " & Skipped & " skipped)" Else SummaryMessage = SummaryMessage & ")" End If @@ -98,14 +104,18 @@ Private Function Summary() As String Summary = SummaryMessage End Function -Private Sub pSpecs_Result(Spec As SpecDefinition) - Debug.Print ResultTypeToString(Spec.Result) & " " & Spec.Description & IIf(Spec.Id <> "", " [" & Spec.Id & "]", "") +Private Sub pSuite_Result(Test As TestCase) + If Test.Result = TestResultType.Skipped Then + Exit Sub + End If + + Debug.Print ResultTypeToString(Test.Result) & " " & Test.Name - If Spec.Result = SpecResultType.Fail Then - Dim Expectation As SpecExpectation - For Each Expectation In Spec.FailedExpectations - Debug.Print " " & Expectation.FailureMessage - Next Expectation + If Test.Result = TestResultType.Fail Then + Dim Failure As Variant + For Each Failure In Test.Failures + Debug.Print " " & Failure + Next Failure End If End Sub diff --git a/src/SpecDefinition.cls b/src/SpecDefinition.cls deleted file mode 100644 index d26ebc8..0000000 --- a/src/SpecDefinition.cls +++ /dev/null @@ -1,95 +0,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "SpecDefinition" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = True -'' -' SpecDefinition v2.0.0-beta -' (c) Tim Hall - https://github.com/VBA-tools/VBA-TDD -' -' Collection of expectations for verifying spec -' -' @class SpecDefinition -' @author tim.hall.engr@gmail.com -' @license MIT (http://www.opensource.org/licenses/mit-license.php) -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -Option Explicit - -' --------------------------------------------- ' -' Events and Properties -' --------------------------------------------- ' - -Public Description As String -Public Id As String -Public Expectations As VBA.Collection - -Public Suite As SpecSuite - -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 -End Property - -Public Property Get FailedExpectations() As Collection - 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 given actual value -' -' @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 VBA.VarType(Actual) = VBA.vbObject Then - Set Expectation.Actual = Actual - Else - Expectation.Actual = Actual - End If - Me.Expectations.Add Expectation - - Set Expect = Expectation -End Function - -' ============================================= ' -' Private Functions -' ============================================= ' - -Private Sub Class_Initialize() - Set Me.Expectations = New VBA.Collection -End Sub - -Private Sub Class_Terminate() - Me.Suite.SpecDone Me -End Sub - diff --git a/src/SpecExpectation.cls b/src/SpecExpectation.cls deleted file mode 100644 index 72b16d9..0000000 --- a/src/SpecExpectation.cls +++ /dev/null @@ -1,529 +0,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "SpecExpectation" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = True -'' -' SpecExpectation v2.0.0-beta -' (c) Tim Hall - https://github.com/VBA-tools/VBA-TDD -' -' Provides various tests that can be performed for a provided value -' -' @class SpecExpectation -' @author tim.hall.engr@gmail.com -' @license MIT (http://www.opensource.org/licenses/mit-license.php) -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -Option Explicit - -'' -' @feature RunMatcher -' @compatibility: Platforms / applications that support Application.Run -' Platforms: Windows -' Applications: Excel, Word, Access -'' -#Const EnableRunMatcher = True - -' --------------------------------------------- ' -' Properties -' --------------------------------------------- ' - -Public Actual As Variant -Public Expected As Variant -Public Passed As Boolean -Public FailureMessage As String - -' ============================================= ' -' Public Methods -' ============================================= ' - -'' -' Check if the actual value is equal to the expected value -' -' @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 VBA.IsError(Actual) Or VBA.IsError(Expected) Then - IsEqual = False - ElseIf VBA.IsObject(Actual) Or VBA.IsObject(Expected) Then - IsEqual = "Unsupported: Can't compare objects" - 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 - ' -> Format as scientific notation with 15 significant figures and then compare strings - IsEqual = IsCloseTo(Actual, Expected, 15) - Else - IsEqual = Actual = Expected - End If -End Function - -'' -' Check if the actual value is undefined -' (Nothing, Empty, Null, or Missing) -' -' @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 VBA.IsEmpty(Actual) Or VBA.IsNull(Actual) Or VBA.IsMissing(Actual) -End Function - -'' -' 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 VBA.IsObject(Actual) Then - If Actual Is Nothing Then - IsNothing = True - Else - IsNothing = False - End If - Else - IsNothing = False - End If -End Function - -'' -' Check if the actual value is empty -' -' @method ToBeEmpty -'' -Public Sub ToBeEmpty() - Check VBA.IsEmpty(Me.Actual), "to be empty" -End Sub - -'' -' Check if the actual value is not empty -' -' @method ToNotBeEmpty -'' -Public Sub ToNotBeEmpty() - Check VBA.IsEmpty(Me.Actual), "to not be empty", Inverse:=True -End Sub - -'' -' Check if the actual value is null -' -' @method ToBeNull -'' -Public Sub ToBeNull() - Check VBA.IsNull(Me.Actual), "to be null" -End Sub - -'' -' Check if the actual value is not null -' -' @method ToNotBeNull -'' -Public Sub ToNotBeNull() - Check VBA.IsNull(Me.Actual), "to not be null", Inverse:=True -End Sub - -'' -' Check if the actual value is missing -' -' @method ToBeMissing -'' -Public Sub ToBeMissing() - Check VBA.IsMissing(Me.Actual), "to be missing" -End Sub - -'' -' Check if the actual value is not missing -' -' @method ToNotBeMissing -'' -Public Sub ToNotBeMissing() - Check VBA.IsMissing(Me.Actual), "to not be missing", Inverse:=True -End Sub - -'' -' Check if the actual value is less than the expected value -' -' @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 -Public Sub ToBeLT(Expected As Variant) - ToBeLessThan Expected -End Sub - -Private Function IsLT(Actual As Variant, Expected As Variant) As Variant - If VBA.IsError(Actual) Or VBA.IsError(Expected) Or Actual >= Expected Then - IsLT = False - Else - IsLT = True - End If -End Function - -'' -' Check if the actual value is less than or equal to the expected value -' -' @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 -Public Sub ToBeLTE(Expected As Variant) - ToBeLessThanOrEqualTo Expected -End Sub - -Private Function IsLTE(Actual As Variant, Expected As Variant) As Variant - If VBA.IsError(Actual) Or VBA.IsError(Expected) Or Actual > Expected Then - IsLTE = False - Else - IsLTE = True - End If -End Function - -'' -' Check if the actual value is greater than the expected value -' -' @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 -Public Sub ToBeGT(Expected As Variant) - ToBeGreaterThan Expected -End Sub - -Private Function IsGT(Actual As Variant, Expected As Variant) As Variant - If VBA.IsError(Actual) Or VBA.IsError(Expected) Or Actual <= Expected Then - IsGT = False - Else - IsGT = True - End If -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 -Public Sub ToBeGTE(Expected As Variant) - ToBeGreaterThanOrEqualTo Expected -End Sub - -Private Function IsGTE(Actual As Variant, Expected As Variant) As Variant - If VBA.IsError(Actual) Or VBA.IsError(Expected) Or Actual < Expected Then - IsGTE = False - Else - IsGTE = True - End If -End Function - -'' -' Check if the actual value is close to the expected value -' -' @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 - -Private Function IsCloseTo(Actual As Variant, Expected As Variant, SignificantFigures As Integer) As Variant - Dim ActualAsString As String - Dim ExpectedAsString As String - - If SignificantFigures < 1 Or SignificantFigures > 15 Then - IsCloseTo = "ToBeCloseTo/ToNotBeClose to can only compare from 1 to 15 significant figures""" - 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") - Else - ActualAsString = VBA.Format$(Actual, VBA.Left$("0.00000000000000", SignificantFigures + 1) & "e-0") - End If - - If Expected > 1 Then - ExpectedAsString = VBA.Format$(Expected, VBA.Left$("0.00000000000000", SignificantFigures + 1) & "e+0") - Else - ExpectedAsString = VBA.Format$(Expected, VBA.Left$("0.00000000000000", SignificantFigures + 1) & "e-0") - End If - - IsCloseTo = ActualAsString = ExpectedAsString - End If -End Function - -'' -' Check if the actual value array contains the expected value -' -' @method ToContain -' @param {Variant} Expected value -'' -Public Sub ToContain(Expected As Variant) - Check Contains(Me.Actual, Expected), "to contain", Expected:=Expected -End Sub - -'' -' 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 IsArrayOrCollection(Actual) Then - Contains = "Error: Actual needs to be an Array or Collection for ToContain/ToNotContain" - Else - Dim i As Integer - If TypeOf Actual Is Collection Then - For i = 1 To Actual.Count - If Actual.Item(i) = Expected Then - Contains = True - Exit Function - End If - Next i - Else - For i = LBound(Actual) To UBound(Actual) - If Actual(i) = Expected Then - Contains = True - Exit Function - End If - Next i - End If - End If -End Function - -'' -' Check if the actual value string has a match for the expected value substring -' (Only checks if the actual contains the expected string currently) -' -' @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 VBA.InStr(Actual, Expected) > 0 Then - Matches = True - Else - Matches = False - End If -End Function - -'' -' Run custom matcher -' -' @example -' .Expect(100).RunMatcher "Module.ToBeWithin", "to be within", 90, 110 -' -' Module: -' Public Function ToBeWithin(Actual As Variant, Args As Variant) As Variant -' If UBound(Args) - LBound(Args) < 1 Then -' ' Return string for specific failure message -' ToBeWithin = "Need to pass in upper-bound to ToBeWithin" -' Else -' If Actual >= Args(0) And Actual <= Args(1) Then -' ' Return true for pass -' ToBeWithin = True -' Else -' ' Return false for fail or custom failure message -' ToBeWithin = False -' End If -' End If -' End Function -' -' @method RunMatcher -' @param {String} Name of function for matcher -' @param {String} Message -' @param {...} Arguments for custom matcher -'' -#If EnableRunMatcher Then -Public Sub RunMatcher(Name As String, Message As String, ParamArray Arguments()) - Dim Expected As String - Dim i As Integer - Dim HasArguments As Boolean - - HasArguments = UBound(Arguments) >= 0 - For i = LBound(Arguments) To UBound(Arguments) - If Expected = "" Then - Expected = GetStringForValue(Arguments(i)) - ElseIf i = UBound(Arguments) Then - If (UBound(Arguments) > 1) Then - Expected = Expected & ", and " & GetStringForValue(Arguments(i)) - Else - Expected = Expected & " and " & GetStringForValue(Arguments(i)) - End If - Else - Expected = Expected & ", " & GetStringForValue(Arguments(i)) - End If - Next i - - If HasArguments Then - Check Application.Run(Name, Me.Actual, Arguments), Message, Expected:=Expected - Else - Check Application.Run(Name, Me.Actual), Message - End If -End Sub -#End If - -' ============================================= ' -' Private Methods -' ============================================= ' - -Private Sub Check(Result As Variant, Message As String, Optional Expected As Variant, Optional Inverse As Boolean = False) - If Not VBA.IsMissing(Expected) Then - If VBA.IsObject(Expected) Then - Set Me.Expected = Expected - Else - Me.Expected = Expected - End If - End If - - If VBA.VarType(Result) = VBA.vbString Then - Fails CStr(Result) - Else - If Inverse Then - Result = Not Result - End If - - If Result Then - Passes - Else - Fails CreateFailureMessage(Message, Expected) - End If - End If -End Sub - -Private Sub Passes() - Me.Passed = True -End Sub - -Private Sub Fails(Message As String) - 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 VBA.IsMissing(Expected) Then - CreateFailureMessage = CreateFailureMessage & " " & GetStringForValue(Expected) - End If -End Function - -Private Function GetStringForValue(Value As Variant) As String - 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 - Case VBA.vbArray To VBA.vbArray + VBA.vbByte - GetStringForValue = "(Array)" - Case VBA.vbEmpty - GetStringForValue = "(Empty)" - Case VBA.vbNull - GetStringForValue = "(Null)" - Case VBA.vbString - GetStringForValue = """" & Value & """" - Case Else - GetStringForValue = CStr(Value) - End Select - - If GetStringForValue = "" Then - GetStringForValue = "(Undefined)" - End If -End Function - -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 Select -End Function - diff --git a/src/SpecSuite.cls b/src/SpecSuite.cls deleted file mode 100644 index c25135b..0000000 --- a/src/SpecSuite.cls +++ /dev/null @@ -1,162 +0,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "SpecSuite" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = True -'' -' SpecSuite v2.0.0-beta -' (c) Tim Hall - https://github.com/VBA-tools/VBA-TDD -' -' A collection of specs and results -' -' @class SpecSuite -' @author tim.hall.engr@gmail.com -' @license MIT (http://www.opensource.org/licenses/mit-license.php) -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -Option Explicit - -' --------------------------------------------- ' -' Types, Events, and Properties -' --------------------------------------------- ' - -Public Enum SpecResultType - Pass - Fail - Pending -End Enum - -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 - -'' -' @property Specs -' @type Collection -'' -Public Specs As VBA.Collection - -'' -' @property Result -' @type SpecResultType -'' -Public Property Get Result() As SpecResultType - Result = SpecResultType.Pending - - 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 - -'' -' @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} [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 - - RaiseEvent BeforeEach - - ' Prepare Spec - Spec.Description = Description - Spec.Id = Id - Set Spec.Suite = Me - - Set It = Spec -End Function - -'' -' Called at completion of SpecDefinition -' -' @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 -' ============================================= ' - -Private Sub Class_Initialize() - Set Me.Specs = New VBA.Collection -End Sub diff --git a/src/TestCase.cls b/src/TestCase.cls new file mode 100644 index 0000000..2ecdda7 --- /dev/null +++ b/src/TestCase.cls @@ -0,0 +1,550 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "TestCase" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = True +'' +' TestCase v2.0.0-beta +' (c) Tim Hall - https://github.com/vba-tools/vba-test +' +' Verify a single test case with assertions +' +' @class TestCase +' @author tim.hall.engr@gmail.com +' @license MIT (https://opensource.org/licenses/MIT) +' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Option Explicit + +Private pFailures As VBA.Collection + +' --------------------------------------------- ' +' Events and Properties +' --------------------------------------------- ' + +Public Name As String +Public Context As Dictionary + +Public Planned As Long +Public Successes As Long +Public Skipped As Boolean + +Public Suite As TestSuite + +Public Property Get Result() As TestResultType + If Me.Skipped Then + Result = TestResultType.Skipped + ElseIf Me.Successes = 0 And Me.Failures.Count = 0 Then + Result = TestResultType.Pending + ElseIf Me.Failures.Count > 0 Then + Result = TestResultType.Fail + Else + Result = TestResultType.Pass + End If +End Property + +Public Property Get Failures() As Collection + Dim Total As Long + Total = Me.Successes + pFailures.Count + + If Me.Planned > 0 And Me.Planned <> Total Then + Dim Message As String + Dim Failure As Variant + + Set Failures = New Collection + For Each Failure In pFailures + Failures.Add Failure + Next Failure + + Message = "Total assertions, ${1}, does not equal planned, ${2}" + Failures.Add FormatMessage(Message, Total, Me.Planned) + Else + Set Failures = pFailures + End If +End Property + +Public Property Get Self() As TestCase + Self = Me +End Property + +' ============================================= ' +' Public Methods +' ============================================= ' + +'' +' Check if two values are deep equal (including Array, Collection, and Dictionary) +' +' @param {Variant} A +' @param {Variant} B +' @param {String} [Message] +'' +Public Sub IsEqual(A As Variant, B As Variant, Optional Message As String = _ + "Expected ${1} to equal ${2}") + + Check IsDeepEqual(A, B), Message, A, B +End Sub + +'' +' Check if two values are not deep equal (including Array, Collection, and Dictionary) +' +' @param {Variant} A +' @param {Variant} B +' @param {String} [Message] +'' +Public Sub NotEqual(A As Variant, B As Variant, Optional Message As String = _ + "Expected ${1} to not equal ${2}") + + Check Not IsDeepEqual(A, B), Message, A, B +End Sub + +'' +' Check if a value is "truthy" +' +' From https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/if-then-else-statement +' +' Must evaluate to True or False, or to a data type that is implicitly convertible to Boolean. +' If the expression is a Nullable Boolean variable that evaluates to Nothing, the condition is treated as if the expression is False. +' +' @param {Variant} Value +' @param {String} [Message] +'' +Public Sub IsOk(Value As Variant, Optional Message As String = _ + "Expected ${1} to be ok") + + Check Value, Message, Value +End Sub + +'' +' Check if a value is not "truthy" (See .IsOk) +' +' @param {Variant} Value +' @param {String} [Message] +'' +Public Sub NotOk(Value As Variant, Optional Message As String = _ + "Expected ${1} to not be ok") + + Check Not CBool(Value), Message, Value +End Sub + +'' +' Check if a value is "undefined": Nothing, Empty, Null, or Missing +' +' @param {Variant} Value +' @param {String} [Message] +'' +Public Sub IsUndefined(Optional Value As Variant, Optional Message As String = _ + "Expected ${1} to be undefined") + + Check IsNothing(Value) Or VBA.IsEmpty(Value) Or VBA.IsNull(Value) Or VBA.IsMissing(Value), Message, Value +End Sub + +'' +' Check if a value is not "undefined": Nothing, Empty, Null, or Missing +' +' @param {Variant} Value +' @param {String} [Message] +'' +Public Sub NotUndefined(Value As Variant, Optional Message As String = _ + "Expected ${1} to not be undefined") + + Check Not IsNothing(Value) And Not VBA.IsEmpty(Value) And Not VBA.IsNull(Value) And Not VBA.IsMissing(Value), Message, Value +End Sub + +'' +' Check if a value is included in an arbitrarily nested Array or Collection +' +' @param {Array|Collection} Values +' @param {Variant} Value +' @param {String} [Message] +'' +Public Sub Includes(Values As Variant, Value As Variant, Optional Message As String = _ + "Expected ${2} to be included in ${1}") + + If IsCollection(Values) Then + Check CollectionIncludes(Values, Value), Message, Values, Value + ElseIf IsArray(Values) Then + Check ArrayIncludes(Values, Value), Message, Values, Value + Else + pFailures.Add FormatMessage(Message, Values, Value) & " (Incompatible type for Values)" + End If +End Sub + +'' +' Check if a value is not included in an arbitrarily nested Array or Collection +' +' @param {Array|Collection} Values +' @param {Variant} Value +' @param {String} [Message] +'' +Public Sub NotIncludes(Values As Variant, Value As Variant, Optional Message As String = _ + "Expected ${2} not to be included in ${1}") + + If IsCollection(Values) Then + Check Not CollectionIncludes(Values, Value), Message, Values, Value + ElseIf IsArray(Values) Then + Check Not ArrayIncludes(Values, Value), Message, Values, Value + Else + pFailures.Add FormatMessage(Message, Values, Value) & " (Incompatible type for Values)" + End If +End Sub + +'' +' Check if two values are approximately equal, up to the given amount of significant figures +' +' @example +' ```vb +' .IsApproximate 1.001, 1.002, 3 +' +' ' Equivalent to .IsEqual 1.00e+0, 1.00e+0 +' ``` +' @param {Variant} A +' @param {Variant} B +' @param {String} [Message] +'' +Public Sub IsApproximate(A As Variant, B As Variant, SignificantFigures As Integer, Optional Message As String = _ + "Expected ${1} to be approximately equal to ${2} (with ${3} significant figures of precision)") + + If SignificantFigures < 1 Or SignificantFigures > 15 Then + pFailures.Add "IsApproximate can only compare from 1 to 15 significant figures" + Else + Check IsApproximatelyEqual(A, B, SignificantFigures), Message, A, B, SignificantFigures + End If +End Sub + +'' +' Check if two values are approximately equal, up to the given amount of significant figures +' +' @example +' ```vb +' .NotApproximate 1.001, 1.009, 3 +' +' ' Equivalent to .IsEqual 1.00e+0, 1.01e+0 +' ``` +' @param {Variant} A +' @param {Variant} B +' @param {String} [Message] +'' +Public Sub NotApproximate(A As Variant, B As Variant, SignificantFigures As Integer, Optional Message As String = _ + "Expected ${1} to not be approximately equal to ${2} (with ${3} significant figures of precision)") + + If SignificantFigures < 1 Or SignificantFigures > 15 Then + pFailures.Add "NotApproximate can only compare from 1 to 15 significant figures" + Else + Check Not IsApproximatelyEqual(A, B, SignificantFigures), Message, A, B, SignificantFigures + End If +End Sub + +'' +' Mark the test as passing +'' +Public Sub Pass() + Me.Successes = 1 + Set pFailures = New Collection +End Sub + +'' +' Mark the test as failing +' +' @param {String} {Message] +'' +Public Sub Fail(Optional Message As String = _ + "Test failed unexpectedly") + + pFailures.Add Message +End Sub + +'' +' Set the planned number of assertions for the test +' +' @param {Long} Count +'' +Public Sub Plan(Count As Long) + Planned = Count +End Sub + +'' +' Mark the test as skipped +'' +Public Sub Skip() + Me.Skipped = True +End Sub + +' ============================================= ' +' Private Functions +' ============================================= ' + +Private Sub Check(Assertion As Variant, Message As String, ParamArray Values() As Variant) + If Assertion Then + Me.Successes = Me.Successes + 1 + Else + pFailures.Add FormatMessage(Message, Values) + End If +End Sub + +Private Function IsDeepEqual(A As Variant, B As Variant) As Boolean + Dim AType As VbVarType + Dim BType As VbVarType + + AType = VBA.VarType(A) + BType = VBA.VarType(B) + + If VBA.IsError(A) Or VBA.IsError(B) Then + IsDeepEqual = False + + ElseIf VBA.IsArray(A) And VBA.IsArray(B) Then + IsDeepEqual = IsArrayEqual(A, B) + + ElseIf AType = VBA.vbObject Or BType = VBA.vbObject Then + If AType <> BType Or VBA.TypeName(A) <> VBA.TypeName(B) Then + IsDeepEqual = False + ElseIf VBA.TypeName(A) = "Collection" Then + IsDeepEqual = IsCollectionEqual(A, B) + ElseIf VBA.TypeName(A) = "Dictionary" Then + IsDeepEqual = IsDictionaryEqual(A, B) + Else + IsDeepEqual = A Is B + End If + + ElseIf VBA.VarType(A) = VBA.vbDouble Or VBA.VarType(B) = VBA.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 + IsDeepEqual = IsApproximatelyEqual(A, B, 15) + + Else + IsDeepEqual = A = B + End If +End Function + +Private Function IsArrayEqual(A As Variant, B As Variant) As Boolean + If UBound(A) <> UBound(B) Then + IsArrayEqual = False + Exit Function + End If + + Dim i As Long + For i = LBound(A) To UBound(A) + If Not IsDeepEqual(A(i), B(i)) Then + IsArrayEqual = False + Exit Function + End If + Next i + + IsArrayEqual = True +End Function + +Private Function IsCollectionEqual(A As Variant, B As Variant) As Boolean + If A.Count <> B.Count Then + IsCollectionEqual = False + Exit Function + End If + + Dim i As Long + For i = 1 To A.Count + If Not IsDeepEqual(A(i), B(i)) Then + IsCollectionEqual = False + Exit Function + End If + Next i + + IsCollectionEqual = True +End Function + +Private Function IsDictionaryEqual(A As Variant, B As Variant) As Boolean + If UBound(A.Keys) <> UBound(B.Keys) Then + IsDictionaryEqual = False + Exit Function + End If + + Dim AKeys As Variant + Dim BKeys As Variant + Dim i As Long + + AKeys = A.Keys + BKeys = B.Keys + + For i = LBound(AKeys) To UBound(AKeys) + If AKeys(i) <> BKeys(i) Or A.Item(AKeys(i)) <> B.Item(BKeys(i)) Then + IsDictionaryEqual = False + Exit Function + End If + Next i + + IsDictionaryEqual = True +End Function + +Private Function IsCollection(Value As Variant) As Boolean + IsCollection = VBA.VarType(Value) = VBA.vbObject And VBA.TypeName(Value) = "Collection" +End Function + +Private Function IsNothing(Value As Variant) As Boolean + If VBA.IsObject(Value) Then + IsNothing = Value Is Nothing + Else + IsNothing = False + End If +End Function + +Private Function ArrayIncludes(Values As Variant, Value As Variant) As Boolean + Dim i As Long + For i = LBound(Values) To UBound(Values) + If VBA.IsArray(Values(i)) Then + If ArrayIncludes(Values(i), Value) Then + ArrayIncludes = True + Exit Function + End If + ElseIf IsCollection(Values(i)) Then + If CollectionIncludes(Values(i), Value) Then + ArrayIncludes = True + Exit Function + End If + ElseIf IsDeepEqual(Values(i), Value) Then + ArrayIncludes = True + Exit Function + End If + Next i + + ArrayIncludes = False +End Function + +Private Function CollectionIncludes(Values As Variant, Value As Variant) As Boolean + Dim Item As Variant + For Each Item In Values + If VBA.IsArray(Item) Then + If ArrayIncludes(Item, Value) Then + CollectionIncludes = True + Exit Function + End If + ElseIf IsCollection(Item) Then + If CollectionIncludes(Item, Value) Then + CollectionIncludes = True + Exit Function + End If + ElseIf IsDeepEqual(Item, Value) Then + CollectionIncludes = True + Exit Function + End If + Next Item + + CollectionIncludes = False +End Function + +Private Function IsApproximatelyEqual(A As Variant, B As Variant, SignificantFigures As Integer) As Boolean + If SignificantFigures < 1 Or SignificantFigures > 15 Or VBA.IsError(A) Or VBA.IsError(B) Then + IsApproximatelyEqual = False + Exit Function + End If + + Dim AValue As String + Dim BValue As String + + AValue = VBA.Format$(A, VBA.Left$("0.00000000000000", SignificantFigures + 1) & IIf(A > 1, "e+0", "e-0")) + BValue = VBA.Format$(B, VBA.Left$("0.00000000000000", SignificantFigures + 1) & IIf(B > 1, "e+0", "e-0")) + + IsApproximatelyEqual = AValue = BValue +End Function + +Private Function FormatMessage(Message As String, ParamArray Values() As Variant) As String + Dim Value As Variant + Dim Index As Long + + FormatMessage = Message + For Each Value In IIf(VBA.IsArray(Values(0)), Values(0), Values) + Index = Index + 1 + FormatMessage = VBA.Replace(FormatMessage, "${" & Index & "}", PrettyPrint(Value)) + Next Value +End Function + +Private Function PrettyPrint(Value As Variant, Optional Indentation As Long = 0) As String + If VBA.IsMissing(Value) Then + PrettyPrint = "[Missing]" + Exit Function + End If + + Dim i As Long + Dim Indented As String + Indented = VBA.String$(Indentation + 1, " ") + + Select Case VBA.VarType(Value) + Case VBA.vbObject + ' Nothing + If Value Is Nothing Then + PrettyPrint = "[Nothing]" + + ' Collection + ElseIf VBA.TypeName(Value) = "Collection" Then + PrettyPrint = "[Collection [" & vbNewLine + + For i = 1 To Value.Count + PrettyPrint = PrettyPrint & Indent(Indentation + 1) & _ + PrettyPrint(Value(i), Indentation + 1) & _ + IIf(i <> Value.Count, ",", "") & vbNewLine + Next i + + PrettyPrint = PrettyPrint & Indent(Indentation) & "]" + + ' Dictionary + ElseIf VBA.TypeName(Value) = "Dictionary" Then + PrettyPrint = "[Dictionary {" & vbNewLine + + For i = LBound(Value.Keys) To UBound(Value.Keys) + PrettyPrint = PrettyPrint & Indent(Indentation + 1) & _ + Value.Keys(i) & ": " & _ + PrettyPrint(Value.Item(Value.Keys(i)), Indentation + 1) & _ + IIf(i <> Value.Count, ",", "") & vbNewLine + Next i + + PrettyPrint = PrettyPrint & Indent(Indentation) & "}]" + + ' Object + Else + PrettyPrint = "[" & VBA.TypeName(Value) & "]" + End If + + ' Array + Case VBA.vbArray To VBA.vbArray + VBA.vbByte + PrettyPrint = "[" & vbNewLine + + For i = LBound(Value) To UBound(Value) + PrettyPrint = PrettyPrint & Indent(Indentation + 1) & _ + PrettyPrint(Value(i), Indentation + 1) & _ + IIf(i <> UBound(Value), ",", "") & vbNewLine + Next i + + PrettyPrint = PrettyPrint & Indent(Indentation) & "]" + + ' Empty + Case VBA.vbEmpty + PrettyPrint = "[Empty]" + + ' Null + Case VBA.vbNull + PrettyPrint = "[Null]" + + ' String + Case VBA.vbString + PrettyPrint = """" & Value & """" + + ' Everything else + Case Else + PrettyPrint = CStr(Value) + End Select +End Function + +Private Function Indent(Optional Indentation As Long) + Indent = VBA.String$(Indentation, " ") +End Function + +Private Sub Class_Initialize() + Set Me.Context = New Dictionary + Set pFailures = New VBA.Collection +End Sub + +Private Sub Class_Terminate() + Me.Suite.TestComplete Me + Set Me.Context = Nothing +End Sub diff --git a/src/TestSuite.cls b/src/TestSuite.cls new file mode 100644 index 0000000..a8edb42 --- /dev/null +++ b/src/TestSuite.cls @@ -0,0 +1,151 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "TestSuite" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = True +'' +' TestSuite v2.0.0-beta +' (c) Tim Hall - https://github.com/vba-tools/vba-test +' +' A collection of tests, with events and results +' +' @class TestSuite +' @author tim.hall.engr@gmail.com +' @license MIT (https://opensource.org/licenses/MIT) +' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Option Explicit + +' --------------------------------------------- ' +' Types, Events, and Properties +' --------------------------------------------- ' + +Public Enum TestResultType + Pass + Fail + Pending + Skipped +End Enum + +Public Event BeforeEach(Test As TestCase) +Public Event Result(Test As TestCase) +Public Event AfterEach(Test As TestCase) + +'' +' (Optional) description of suite for display in runners +' +' @property Description +' @type String +'' +Public Description As String + +'' +' @property Tests +' @type Collection +'' +Public Tests As VBA.Collection + +'' +' Compute suite result from tests +' +' @property Result +' @type SpecResultType +'' +Public Property Get Result() As TestResultType + Result = TestResultType.Pending + + Dim Test As TestCase + For Each Test In Me.Tests + If Test.Result = TestResultType.Pass Then + Result = TestResultType.Pass + ElseIf Test.Result = TestResultType.Fail Then + Result = TestResultType.Fail + Exit For + End If + Next Test +End Property + +'' +' @property PassedTests +' @type Collection +'' +Public Property Get PassedTests() As VBA.Collection + Set PassedTests = GetTestsByType(TestResultType.Pass) +End Property + +'' +' @property FailedTests +' @type Collection +'' +Public Property Get FailedTests() As VBA.Collection + Set FailedTests = GetTestsByType(TestResultType.Fail) +End Property + +'' +' @property PendingTests +' @type Collection +'' +Public Property Get PendingTests() As VBA.Collection + Set PendingTests = GetTestsByType(TestResultType.Pending) +End Property + +'' +' @property SkippedTests +' @type Collection +'' +Public Property Get SkippedTests() As VBA.Collection + Set SkippedTests = GetTestsByType(TestResultType.Skipped) +End Property + +' ============================================= ' +' Public Methods +' ============================================= ' + +'' +' Create a new test case with name +' +' @method Test +' @param {String} Name +' @returns {TestCase} +'' +Public Function Test(Name As String) As TestCase + Dim Instance As New TestCase + + Instance.Name = Name + Set Instance.Suite = Me + + RaiseEvent BeforeEach(Instance) + + Set Test = Instance +End Function + +Public Sub TestComplete(Test As TestCase) + Tests.Add Test + + RaiseEvent Result(Test) + RaiseEvent AfterEach(Test) +End Sub + +' ============================================= ' +' Private Functions +' ============================================= ' + +Private Function GetTestsByType(ResultType As TestResultType) As Collection + Dim Test As TestCase + Dim Filtered As New VBA.Collection + For Each Test In Me.Tests + If Test.Result = ResultType Then + Filtered.Add Test + End If + Next Test + + Set GetTestsByType = Filtered +End Function + + +Private Sub Class_Initialize() + Set Tests = New VBA.Collection +End Sub diff --git a/specs/Specs_Fixture.cls b/tests/Test_Fixture.cls similarity index 66% rename from specs/Specs_Fixture.cls rename to tests/Test_Fixture.cls index 2f603e4..ee41b0c 100644 --- a/specs/Specs_Fixture.cls +++ b/tests/Test_Fixture.cls @@ -2,31 +2,31 @@ VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END -Attribute VB_Name = "Specs_Fixture" +Attribute VB_Name = "Test_Fixture" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True -Private WithEvents pSuite As SpecSuite +Private WithEvents pSuite As TestSuite Attribute pSuite.VB_VarHelpID = -1 Public BeforeEachCallCount As Long Public ResultCalls As Collection Public AfterEachCallCount As Long -Public Sub ListenTo(Suite As SpecSuite) +Public Sub ListenTo(Suite As TestSuite) Set pSuite = Suite End Sub -Private Sub pSuite_BeforeEach() +Private Sub pSuite_BeforeEach(Test As TestCase) BeforeEachCallCount = BeforeEachCallCount + 1 End Sub -Private Sub pSuite_Result(Spec As SpecDefinition) - Me.ResultCalls.Add Spec +Private Sub pSuite_Result(Test As TestCase) + Me.ResultCalls.Add Test End Sub -Private Sub pSuite_AfterEach() +Private Sub pSuite_AfterEach(Test As TestCase) AfterEachCallCount = AfterEachCallCount + 1 End Sub diff --git a/tests/Tests_TestCase.bas b/tests/Tests_TestCase.bas new file mode 100644 index 0000000..8e7c103 --- /dev/null +++ b/tests/Tests_TestCase.bas @@ -0,0 +1,197 @@ +Attribute VB_Name = "Tests_TestCase" +Public Function Tests() As TestSuite + Set Tests = New TestSuite + Tests.Description = "TestCase" + + Dim Reporter As New ImmediateReporter + Reporter.ListenTo Tests + + Dim Suite As New TestSuite + Dim Test As TestCase + Dim A As Variant + Dim B As Variant + + With Tests.Test("should pass if all assertions pass") + Set Test = Suite.Test("should pass") + With Test + .IsEqual "A", "A" + .IsEqual 2, 2 + End With + + .IsEqual Test.Result, TestResultType.Pass + End With + + With Tests.Test("should fail if any assertion fails") + Set Test = Suite.Test("should fail") + With Test + .IsEqual "A", "A" + .IsEqual 2, 1 + End With + + .IsEqual Test.Result, TestResultType.Fail + End With + + With Tests.Test("should contain collection of failures") + Set Test = Suite.Test("should have failures") + With Test + .IsEqual "A", "A" + .IsEqual 2, 1 + .IsEqual True, False + End With + + .IsEqual Test.Failures(1), "Expected 2 to equal 1" + .IsEqual Test.Failures(2), "Expected True to equal False" + End With + + With Tests.Test("should be pending if there are no assertions") + Set Test = Suite.Test("pending") + .IsEqual Test.Result, TestResultType.Pending + End With + + With Tests.Test("should skip even with failed assertions") + Set Test = Suite.Test("skipped") + With Test + .IsEqual 2, 1 + .Skip + End With + + .IsEqual Test.Result, TestResultType.Skipped + End With + + With Tests.Test("should explicitly pass test") + Set Test = Suite.Test("pass") + With Test + .IsEqual 2, 1 + .Pass + End With + + .IsEqual Test.Result, TestResultType.Pass + End With + + With Tests.Test("should explicitly fail test") + Set Test = Suite.Test("fail") + With Test + .IsEqual 2, 2 + .Fail + End With + + .IsEqual Test.Result, TestResultType.Fail + End With + + With Tests.Test("should fail if plan doesn't match") + Set Test = Suite.Test("plan") + With Test + .Plan 2 + .IsEqual 2, 2 + End With + + .IsEqual Test.Result, TestResultType.Fail + End With + + With Tests.Test("IsEqual") + .IsEqual 1, 1 + .IsEqual 1.2, 1.2 + .IsEqual True, True + .IsEqual Array(1, 2, 3), Array(1, 2, 3) + + Set A = New Collection + A.Add 1 + A.Add 2 + + Set B = New Collection + B.Add 1 + B.Add 2 + + .IsEqual A, B + + Set A = New Dictionary + A("a") = 1 + A("b") = 2 + + Set B = New Dictionary + B("a") = 1 + B("b") = 2 + + .IsEqual A, B + End With + + With Tests.Test("NotEqual") + .NotEqual 1, 2 + .NotEqual 1.2, 1.1 + .NotEqual True, False + .NotEqual Array(1, 2, 3), Array(3, 2, 1) + + Set A = New Collection + A.Add 1 + A.Add 2 + + Set B = New Collection + B.Add 2 + B.Add 1 + + .NotEqual A, B + + Set A = New Dictionary + A("a") = 1 + A("b") = 2 + + Set B = New Dictionary + B("a") = 2 + B("b") = 1 + + .NotEqual A, B + End With + + With Tests.Test("IsOk") + .IsOk True + .IsOk 4 + End With + + With Tests.Test("NotOk") + .NotOk False + .NotOk 0 + End With + + With Tests.Test("IsUndefined") + .IsUndefined + .IsUndefined Nothing + .IsUndefined Null + .IsUndefined Empty + End With + + With Tests.Test("NotUndefined") + .NotUndefined 4 + .NotUndefined True + End With + + With Tests.Test("Includes") + .Includes Array(1, 2, 3), 2 + .Includes Array(Array(1, 2, 3), 4, 5), 2 + + Set A = New Collection + A.Add New Collection + A(1).Add Array(1, 2, 3) + + .Includes A, 2 + End With + + With Tests.Test("NotIncludes") + .NotIncludes Array(1, 2, 3), 4 + + Set A = New Collection + A.Add New Collection + A(1).Add Array(1, 2, 3) + + .NotIncludes A, 4 + End With + + With Tests.Test("IsApproximate") + .IsApproximate 1.001, 1.002, 3 + .IsApproximate 1.00001, 1.00004, 5 + End With + + With Tests.Test("NotApproximate") + .NotApproximate 1.001, 1.009, 3 + End With +End Function + diff --git a/tests/Tests_TestSuite.bas b/tests/Tests_TestSuite.bas new file mode 100644 index 0000000..6bf7ccf --- /dev/null +++ b/tests/Tests_TestSuite.bas @@ -0,0 +1,82 @@ +Attribute VB_Name = "Tests_TestSuite" +Public Function Tests() As TestSuite + Dim Suite As New TestSuite + + Set Tests = New TestSuite + Tests.Description = "TestSuite" + + Dim Reporter As New ImmediateReporter + Reporter.ListenTo Tests + + Dim Fixture As New Test_Fixture + Fixture.ListenTo Tests + + With Tests.Test("should fire BeforeEach event") + .IsEqual Fixture.BeforeEachCallCount, 1 + End With + + With Tests.Test("should fire Result event") + .IsEqual Fixture.ResultCalls(1).Name, "should fire BeforeEach event" + .IsEqual Fixture.ResultCalls(1).Result, TestResultType.Pass + End With + + With Tests.Test("should fire AfterEach event") + .IsEqual Fixture.AfterEachCallCount, 2 + End With + + With Tests.Test("should store specs") + Set Suite = New TestSuite + With Suite.Test("(pass)") + .IsEqual 4, 4 + End With + With Suite.Test("(fail)") + .IsEqual 4, 3 + End With + With Suite.Test("(pending)") + End With + With Suite.Test("(skipped)") + .Skip + End With + + .IsEqual Suite.Tests.Count, 4 + .IsEqual Suite.PassedTests.Count, 1 + .IsEqual Suite.FailedTests.Count, 1 + .IsEqual Suite.PendingTests.Count, 1 + .IsEqual Suite.SkippedTests.Count, 1 + + .IsEqual Suite.PassedTests(1).Name, "(pass)" + .IsEqual Suite.FailedTests(1).Name, "(fail)" + .IsEqual Suite.PendingTests(1).Name, "(pending)" + .IsEqual Suite.SkippedTests(1).Name, "(skipped)" + End With + + With Tests.Test("should have overall result") + Set Suite = New TestSuite + + .IsEqual Suite.Result, TestResultType.Pending + + With Suite.Test("(pending)") + End With + + .IsEqual Suite.Result, TestResultType.Pending + + With Suite.Test("(pass)") + .IsEqual 4, 4 + End With + + .IsEqual Suite.Result, TestResultType.Pass + + With Suite.Test("(fail)") + .IsEqual 4, 3 + End With + + .IsEqual Suite.Result, TestResultType.Fail + + With Suite.Test("(pass)") + .IsEqual 2, 2 + End With + + .IsEqual Suite.Result, TestResultType.Fail + End With + +End Function diff --git a/tests/vba-test-tests.xlsm b/tests/vba-test-tests.xlsm new file mode 100644 index 0000000..6e28209 Binary files /dev/null and b/tests/vba-test-tests.xlsm differ diff --git a/vba-block.toml b/vba-block.toml new file mode 100644 index 0000000..52b95f1 --- /dev/null +++ b/vba-block.toml @@ -0,0 +1,12 @@ +[package] +name = "test" +version = "2.0.0-beta.2" +authors = ["Tim Hall (https://github.com/timhall)"] + +[src] +TestSuite = "src/TestSuite.cls" +TestCase = "src/TestCase.cls" +ImmediateReporter = "src/ImmediateReporter.cls" + +[dependencies] +dictionary = "^1" diff --git a/VBA-TDD - Blank.xlsm b/vba-test-blank.xlsm similarity index 100% rename from VBA-TDD - Blank.xlsm rename to vba-test-blank.xlsm