Skip to content

Commit fb576ba

Browse files
ws-garciaws-garcia
committed
Initial source code
1 parent 01bccfc commit fb576ba

File tree

7 files changed

+3877
-0
lines changed

7 files changed

+3877
-0
lines changed

‎src/Tests/FileReporter.cls‎

Lines changed: 147 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,147 @@
1+
VERSION 1.0 CLASS
2+
BEGIN
3+
MultiUse = -1 'True
4+
END
5+
Attribute VB_Name = "FileReporter"
6+
Attribute VB_GlobalNameSpace = False
7+
Attribute VB_Creatable = False
8+
Attribute VB_PredeclaredId = False
9+
Attribute VB_Exposed = True
10+
''
11+
' # FileReporter
12+
'
13+
' Append test results to the given file
14+
'
15+
' ```vba
16+
' Dim Suite As New TestSuite
17+
' ...
18+
'
19+
' Dim Reporter As New FileReporter
20+
' Reporter.WriteTo "path/to/file"
21+
' Reporter.ListenTo Suite
22+
' ```
23+
'
24+
' @class FileReporter
25+
' @author Tim Hall <[email protected]>
26+
' @repository https://github.com/vba-tools/vba-test
27+
' @license MIT
28+
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
29+
Option Explicit
30+
31+
Private WithEvents pSuite As TestSuite
32+
Attribute pSuite.VB_VarHelpID = -1
33+
Private FilePath As String
34+
Private Finished As Boolean
35+
36+
''
37+
' Report test results to the given file path
38+
''
39+
Public Sub WriteTo(path As Variant)
40+
FilePath = path
41+
End Sub
42+
43+
''
44+
' Report test results from the given TestSuite
45+
''
46+
Public Sub ListenTo(Suite As TestSuite)
47+
If Not pSuite Is Nothing Then
48+
PrintSummary
49+
End If
50+
51+
Finished = False
52+
Set pSuite = Suite
53+
PrintHeader Suite
54+
End Sub
55+
56+
' ============================================= '
57+
58+
Private Sub PrintHeader(Suite As TestSuite)
59+
AppendToFile "===" & VBA.IIf(Suite.Description <> "", " " & Suite.Description & " ===", "")
60+
End Sub
61+
62+
Private Sub PrintResult(test As TestCase)
63+
If test.Result = TestResultType.Skipped Then
64+
Exit Sub
65+
End If
66+
67+
AppendToFile ResultTypeToString(test.Result) & " " & test.Description
68+
69+
If test.Result = TestResultType.Fail Then
70+
Dim Failure As Variant
71+
For Each Failure In test.Failures
72+
AppendToFile " " & Failure
73+
Next Failure
74+
End If
75+
End Sub
76+
77+
Private Sub PrintSummary()
78+
Dim Total As Long
79+
Dim Passed As Long
80+
Dim Failed As Long
81+
Dim Pending As Long
82+
Dim Skipped As Long
83+
84+
Total = pSuite.Tests.count
85+
Passed = pSuite.PassedTests.count
86+
Failed = pSuite.FailedTests.count
87+
Pending = pSuite.PendingTests.count
88+
Skipped = pSuite.SkippedTests.count
89+
90+
Dim Summary As String
91+
If Failed > 0 Then
92+
Summary = "FAIL (" & Failed & " of " & Total & " failed"
93+
Else
94+
Summary = "PASS (" & Passed & " of " & Total & " passed"
95+
End If
96+
If Pending > 0 Then
97+
Summary = Summary & ", " & Pending & " pending"
98+
End If
99+
If Skipped > 0 Then
100+
Summary = Summary & ", " & Skipped & " skipped)"
101+
Else
102+
Summary = Summary & ")"
103+
End If
104+
105+
AppendToFile "= " & Summary & " = " & Now & " =" & vbNewLine
106+
End Sub
107+
108+
Private Function ResultTypeToString(ResultType As TestResultType) As String
109+
Select Case ResultType
110+
Case TestResultType.Pass
111+
ResultTypeToString = "+"
112+
Case TestResultType.Fail
113+
ResultTypeToString = "X"
114+
Case TestResultType.Pending
115+
ResultTypeToString = "."
116+
End Select
117+
End Function
118+
119+
Private Sub AppendToFile(Message As String)
120+
If FilePath = "" Then Exit Sub
121+
122+
Dim File As Integer
123+
File = FreeFile
124+
125+
On Error GoTo Cleanup
126+
127+
Open FilePath For Append As #File
128+
Print #File, Message
129+
130+
Cleanup:
131+
Close #File
132+
End Sub
133+
134+
Private Sub pSuite_Result(test As TestCase)
135+
PrintResult test
136+
End Sub
137+
138+
Private Sub pSuite_Group(Suite As TestSuite)
139+
PrintHeader Suite
140+
End Sub
141+
142+
Private Sub Class_Terminate()
143+
If Not Finished Then
144+
PrintSummary
145+
End If
146+
End Sub
147+

‎src/Tests/ImmediateReporter.cls‎

Lines changed: 130 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,130 @@
1+
VERSION 1.0 CLASS
2+
BEGIN
3+
MultiUse = -1 'True
4+
END
5+
Attribute VB_Name = "ImmediateReporter"
6+
Attribute VB_GlobalNameSpace = False
7+
Attribute VB_Creatable = False
8+
Attribute VB_PredeclaredId = False
9+
Attribute VB_Exposed = True
10+
''
11+
' # ImmediateReporter
12+
'
13+
' Report results to Immediate Window
14+
'
15+
' ```vba
16+
' Dim Suite As New TestSuite
17+
' ...
18+
'
19+
' Dim Reporter As New ImmediateReporter
20+
' Reporter.ListenTo Suite
21+
' ```
22+
'
23+
' @class ImmediateReporter
24+
' @author [email protected]
25+
' @repository https://github.com/vba-tools/vba-test
26+
' @license MIT
27+
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
28+
Option Explicit
29+
30+
Private WithEvents pSuite As TestSuite
31+
Attribute pSuite.VB_VarHelpID = -1
32+
Private Finished As Boolean
33+
34+
''
35+
' Listen to given TestSuite
36+
''
37+
Public Sub ListenTo(Suite As TestSuite)
38+
If Not pSuite Is Nothing Then
39+
' If already listening to suite,
40+
' report summary before moving on to next suite
41+
PrintSummary
42+
End If
43+
44+
Finished = False
45+
Set pSuite = Suite
46+
PrintHeader Suite
47+
48+
' Report any tests added prior to listening
49+
Dim test As TestCase
50+
For Each test In Suite.Tests
51+
PrintResult test
52+
Next test
53+
End Sub
54+
55+
' ============================================= '
56+
57+
Private Sub PrintHeader(Suite As TestSuite)
58+
Debug.Print "===" & IIf(Suite.Description <> "", " " & Suite.Description & " ===", "")
59+
End Sub
60+
61+
Private Sub PrintResult(test As TestCase)
62+
If test.Result = TestResultType.Skipped Then
63+
Exit Sub
64+
End If
65+
66+
Debug.Print ResultTypeToString(test.Result) & " " & test.Description
67+
68+
If test.Result = TestResultType.Fail Then
69+
Dim Failure As Variant
70+
For Each Failure In test.Failures
71+
Debug.Print " " & Failure
72+
Next Failure
73+
End If
74+
End Sub
75+
76+
Private Sub PrintSummary()
77+
Dim Total As Long
78+
Dim Passed As Long
79+
Dim Failed As Long
80+
Dim Pending As Long
81+
Dim Skipped As Long
82+
83+
Total = pSuite.Tests.count
84+
Passed = pSuite.PassedTests.count
85+
Failed = pSuite.FailedTests.count
86+
Pending = pSuite.PendingTests.count
87+
Skipped = pSuite.SkippedTests.count
88+
89+
Dim Summary As String
90+
If Failed > 0 Then
91+
Summary = "FAIL (" & Failed & " of " & Total & " failed"
92+
Else
93+
Summary = "PASS (" & Passed & " of " & Total & " passed"
94+
End If
95+
If Pending > 0 Then
96+
Summary = Summary & ", " & Pending & " pending"
97+
End If
98+
If Skipped > 0 Then
99+
Summary = Summary & ", " & Skipped & " skipped)"
100+
Else
101+
Summary = Summary & ")"
102+
End If
103+
104+
Debug.Print "= " & Summary & " = " & Now & " =" & vbNewLine
105+
End Sub
106+
107+
Private Function ResultTypeToString(ResultType As TestResultType) As String
108+
Select Case ResultType
109+
Case TestResultType.Pass
110+
ResultTypeToString = "+"
111+
Case TestResultType.Fail
112+
ResultTypeToString = "X"
113+
Case TestResultType.Pending
114+
ResultTypeToString = "."
115+
End Select
116+
End Function
117+
118+
Private Sub pSuite_Group(Suite As TestSuite)
119+
PrintHeader Suite
120+
End Sub
121+
122+
Private Sub pSuite_Result(test As TestCase)
123+
PrintResult test
124+
End Sub
125+
126+
Private Sub Class_Terminate()
127+
If Not Finished Then
128+
PrintSummary
129+
End If
130+
End Sub

0 commit comments

Comments
 (0)