-
Notifications
You must be signed in to change notification settings - Fork 1
/
ImmediateReporter.cls
126 lines (109 loc) · 3.15 KB
/
ImmediateReporter.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
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-beta.3
' (c) Tim Hall - https://github.com/VBA-tools/VBA-TDD
'
' Report results to Immediate Window
'
' @class ImmediateReporter
' @author tim.hall.engr@gmail.com
' @license MIT (https://opensource.org/licenses/MIT)
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
Option Explicit
' --------------------------------------------- '
' Constants and Private Variables
' --------------------------------------------- '
Private WithEvents pSuite As TestSuite
Attribute pSuite.VB_VarHelpID = -1
Private Finished As Boolean
' ============================================= '
' Public Methods
' ============================================= '
''
' Listen to given TestSuite
'
' @method ListenTo
' @param {TestSuite} Suite
''
Public Sub ListenTo(Suite As TestSuite)
If Not pSuite Is Nothing Then
Done
End If
Debug.Print "===" & IIf(Suite.Description <> "", " " & Suite.Description & " ===", "")
Set pSuite = Suite
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 TestResultType) As String
Select Case ResultType
Case TestResultType.Pass
ResultTypeToString = "+"
Case TestResultType.Fail
ResultTypeToString = "X"
Case TestResultType.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
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
SummaryMessage = "FAIL (" & Failed & " of " & total & " failed"
Else
SummaryMessage = "PASS (" & Passed & " of " & total & " passed"
End If
If Pending > 0 Then
SummaryMessage = SummaryMessage & ", " & Pending & " pending"
End If
If Skipped > 0 Then
SummaryMessage = SummaryMessage & ", " & Skipped & " skipped)"
Else
SummaryMessage = SummaryMessage & ")"
End If
Summary = SummaryMessage
End Function
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 Test.Result = TestResultType.Fail Then
Dim Failure As Variant
For Each Failure In Test.Failures
Debug.Print " " & Failure
Next Failure
End If
End Sub
Private Sub Class_Terminate()
If Not Finished Then
Done
End If
End Sub