diff --git a/README.md b/README.md index 9a1ee6c..fbfe733 100644 --- a/README.md +++ b/README.md @@ -72,6 +72,17 @@ With Specs.It("should show an X when the user rolls a strike") End With ``` +Alter the failure description of `It` if it needs to be more descriptive + +```vb + ArrayOfValues = Array("Hello","World") + .Expect(ArrayOfValues, """" & Join(ArrayOfValues, """ and """) & """").ToContain "Moon" + '' RETURNS Expect "Hello" and "World" to contain "Moon" + '' INSTEAD OF Expect (array) to contain "Moon" +``` + + + `Expect` is how you test desired behavior ```vb @@ -117,6 +128,20 @@ 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) End With + +With Specs.It("Check for value(s) within arrays and collections") + .Expect(Array("A", "B", "C")).ToContain "B" + .Expect(Array("A", "B", "C")).ToContain CollectionBC + + .Expect(Array("A", "B")).ToNotContain Array("A", "B", "C") + .Expect(CollectionBC).ToNotContain CollectionABC + + .Expect("B").ToBeIn Array("A", "B", "C") + .Expect(CollectionBC).ToBeIn Array("A", "B", "C") + + .Expect(Array("D", "E")).ToNotBeIn CollectionABC + .Expect(CollectionABC).ToNotBeIn CollectionBC +End With ``` ### ImmediateReporter @@ -173,6 +198,6 @@ To avoid compilation issues on unsupported applications, the compiler constant ` For more details, check out the [Wiki](https://github.com/VBA-tools/VBA-TDD/wiki) -- Design based heavily on the [Jasmine](https://jasmine.github.io/) +- Design based heavily on [Jasmine](https://jasmine.github.io/) - Author: Tim Hall - License: MIT diff --git a/specs/Specs_SpecDefinition.bas b/specs/Specs_SpecDefinition.bas index 032938a..747e1e2 100644 --- a/specs/Specs_SpecDefinition.bas +++ b/specs/Specs_SpecDefinition.bas @@ -54,4 +54,22 @@ Public Function Specs() As SpecSuite Set Definition = TestSuite.It("pending") .Expect(Definition.Result).ToEqual SpecResultType.Pending End With + + With Specs.It("should have an alternative definition") + Dim ExpectedArray() As String + Dim ActualArray() As String + ExpectedArray = Split("Hello World") + ActualArray = Split("Goodbye Moon") + Set Definition = TestSuite.It("should fail and have descriptive text") + With Definition + .Expect(actuallarray, """" & Join(ActualArray, """ and """) & """").ToBeIn ExpectedArray + End With + + .Expect(Definition.FailedExpectations(1).Passed).ToEqual False + .Expect(Definition.FailedExpectations(1).FailureMessage) _ + .ToEqual "Expected ""Goodbye"" and ""Moon"" is contained within (Array)" + .Expect(Definition.FailedExpectations(1).FailureMessage) _ + .ToNotEqual "Expected (Array) is contained within (Array)" + End With + End Function diff --git a/specs/Specs_SpecExpectation.bas b/specs/Specs_SpecExpectation.bas index fa68896..c5a120e 100644 --- a/specs/Specs_SpecExpectation.bas +++ b/specs/Specs_SpecExpectation.bas @@ -1,7 +1,8 @@ Attribute VB_Name = "Specs_SpecExpectation" +Option Explicit Public Function Specs() As SpecSuite Dim Expectation As SpecExpectation - + Set Specs = New SpecSuite Specs.Description = "SpecExpectation" @@ -141,17 +142,54 @@ Public Function Specs() As SpecSuite .Expect(3.1415926).ToBeCloseTo 2.78, 1 End With - With Specs.It("ToContain") + + + Dim CollectionABC As New Collection + CollectionABC.Add "A" + CollectionABC.Add "B" + CollectionABC.Add "C" + + Dim CollectionBC As New Collection + CollectionBC.Add "B" + CollectionBC.Add "C" + + With Specs.It("ToContain/ToNotContain") .Expect(Array("A", "B", "C")).ToContain "B" + .Expect(Array("A", "B", "C")).ToContain Array("B", "C") + .Expect(Array("A", "B", "C")).ToContain CollectionBC - Dim Test3 As New Collection - Test3.Add "A" - Test3.Add "B" - Test3.Add "C" - .Expect(Test3).ToContain "B" + .Expect(CollectionABC).ToContain "B" + .Expect(CollectionABC).ToContain Array("B", "C") + .Expect(CollectionABC).ToContain CollectionBC .Expect(Array("A", "B", "C")).ToNotContain "D" - .Expect(Test3).ToNotContain "D" + .Expect(Array("A", "B", "C")).ToNotContain Array("D", "E") + .Expect(Array("A", "B", "C")).ToNotContain Array("C", "D") + .Expect(Array("A", "B")).ToNotContain Array("A", "B", "C") + + .Expect(CollectionABC).ToNotContain "D" + .Expect(CollectionABC).ToNotContain Array("D", "E") + .Expect(CollectionBC).ToNotContain CollectionABC + + End With + + With Specs.It("ToBeIn/ToNotBeIn") + .Expect("B").ToBeIn Array("A", "B", "C") + .Expect(Array("B", "C")).ToBeIn Array("A", "B", "C") + .Expect(CollectionBC).ToBeIn Array("A", "B", "C") + + .Expect("B").ToBeIn CollectionABC + .Expect(Array("B", "C")).ToBeIn CollectionABC + .Expect(CollectionBC).ToBeIn CollectionABC + + .Expect("D").ToNotBeIn Array("A", "B", "C") + .Expect(Array("D", "E")).ToNotBeIn Array("A", "B", "C") + .Expect(Array("C", "D")).ToNotBeIn Array("A", "B", "C") + .Expect(Array("A", "B", "C")).ToNotBeIn Array("A", "B") + + .Expect("D").ToNotBeIn CollectionABC + .Expect(Array("D", "E")).ToNotBeIn CollectionABC + .Expect(CollectionABC).ToNotBeIn CollectionBC End With With Specs.It("ToMatch") @@ -160,6 +198,11 @@ Public Function Specs() As SpecSuite .Expect("abcde").ToNotMatch "xyz" End With + With Specs.It("ToMatchRegEx") + .Expect("person@place.com").ToMatchRegEx "^([a-zA-Z0-9_\-\.]+)\@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$" + + 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" diff --git a/src/SpecDefinition.cls b/src/SpecDefinition.cls index d26ebc8..6a13d9c 100644 --- a/src/SpecDefinition.cls +++ b/src/SpecDefinition.cls @@ -68,7 +68,7 @@ End Property ' @param {Variant} Actual value to test ' @return {SpecExpectation} '' -Public Function Expect(Optional Actual As Variant) As SpecExpectation +Public Function Expect(Optional Actual As Variant, Optional Description As String) As SpecExpectation Dim Expectation As New SpecExpectation If VBA.VarType(Actual) = VBA.vbObject Then @@ -77,6 +77,7 @@ Public Function Expect(Optional Actual As Variant) As SpecExpectation Expectation.Actual = Actual End If Me.Expectations.Add Expectation + Expectation.Description = Description Set Expect = Expectation End Function diff --git a/src/SpecExpectation.cls b/src/SpecExpectation.cls index 72b16d9..f3e8326 100644 --- a/src/SpecExpectation.cls +++ b/src/SpecExpectation.cls @@ -33,6 +33,7 @@ Option Explicit Public Actual As Variant Public Expected As Variant +Public Description As String Public Passed As Boolean Public FailureMessage As String @@ -333,11 +334,37 @@ Public Sub ToNotContain(Expected As Variant) Check Contains(Me.Actual, Expected), "to not contain", Expected:=Expected, Inverse:=True End Sub +'' +' Check if the actual value is found within an array +' +' @method ToBeIn +' @param {Variant} Expected value +'' +Public Sub ToBeIn(Expected As Variant) + Check Contains(Expected, Me.Actual), "is contained within", Expected:=Expected +End Sub + +'' +' Check if the actual value is not found within an array +' +' @method ToNotBeIn +' @param {Variant} Expected value +'' +Public Sub ToNotBeIn(Expected As Variant) + Check Contains(Expected, Me.Actual), "is not contained within", 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" + ElseIf IsArrayOrCollection(Expected) Then + Dim e As Variant + For Each e In Expected + Contains = Contains(Actual, e) + If Not Contains Then Exit Function + Next e Else - Dim i As Integer + Dim i As Variant If TypeOf Actual Is Collection Then For i = 1 To Actual.Count If Actual.Item(i) = Expected Then @@ -346,8 +373,8 @@ Private Function Contains(Actual As Variant, Expected As Variant) As Variant End If Next i Else - For i = LBound(Actual) To UBound(Actual) - If Actual(i) = Expected Then + For Each i In Actual + If i = Expected Then Contains = True Exit Function End If @@ -386,6 +413,28 @@ Private Function Matches(Actual As Variant, Expected As Variant) As Variant End If End Function +Public Sub ToMatchRegEx(Expected As Variant) + Check MatchesRegEx(Me.Actual, Expected), "to match the pattern", Expected:=Expected +End Sub + +Private Function MatchesRegEx(Actual As Variant, Expected As Variant) As Variant + Dim RE As Object, REMatches As Object + + Set RE = CreateObject("vbscript.regexp") + With RE + .MultiLine = False + .Global = False + .IgnoreCase = False + .Pattern = Expected + End With + + Set REMatches = RE.Execute(Actual) + If REMatches.Count > 0 Then + MatchesRegEx = True + Else + MatchesRegEx = False + End If +End Function '' ' Run custom matcher ' @@ -480,7 +529,7 @@ Private Sub Fails(Message As String) End Sub Private Function CreateFailureMessage(Message As String, Optional Expected As Variant) As String - CreateFailureMessage = "Expected " & GetStringForValue(Me.Actual) & " " & Message + CreateFailureMessage = "Expected " & IIf(Me.Description = vbNullString, GetStringForValue(Me.Actual), Me.Description) & " " & Message If Not VBA.IsMissing(Expected) Then CreateFailureMessage = CreateFailureMessage & " " & GetStringForValue(Expected) End If