-
Notifications
You must be signed in to change notification settings - Fork 0
/
M_clsStopWatch_Test.def
153 lines (110 loc) · 3.81 KB
/
M_clsStopWatch_Test.def
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
'AccUnit:TestClass
'--------------------------------------------------------------------
' AccUnit Infrastructure
'--------------------------------------------------------------------
Dim c_Watchstop As clsStopWatch
Private Declare Sub apiSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Implements SimplyVBUnit.ITestFixture
Implements AccUnit_Integration.ITestManagerBridge
Private TestManager As AccUnit_Integration.TestManager
Private Sub ITestManagerBridge_InitTestManager(ByVal NewTestManager As AccUnit_Integration.ITestManagerComInterface): Set TestManager = NewTestManager: End Sub
Private Function ITestManagerBridge_GetTestManager() As AccUnit_Integration.ITestManagerComInterface: Set ITestManagerBridge_GetTestManager = TestManager: End Function
Private Sub ITestFixture_AddTestCases(ByVal Tests As SimplyVBUnit.TestCaseCollector): TestManager.AddTestCases Tests: End Sub
Public Sub HasFrequency()
Set c_Watchstop = Utils.StopWatch
Assert.That c_Watchstop.Frequency, Iz.GreaterThan(1) ' more than once in a millisecond
End Sub
Public Sub MinimumResolution()
Dim cElapsed As Currency
Set c_Watchstop = Utils.StopWatch
cElapsed = c_Watchstop.Elapsedms
Assert.That cElapsed, Iz.GreaterThan(0)
Assert.That cElapsed, Iz.LessThan(1)
End Sub
Public Sub SleepOneSecond()
Dim cElapsed As Currency
Set c_Watchstop = Utils.StopWatch
apiSleep 1000
cElapsed = c_Watchstop.Elapsedms
Assert.That cElapsed, Iz.GreaterThan(0)
Assert.That cElapsed, Iz.InRange(990, 1010)
End Sub
' ------------------------------------------------------------------------
' Measure Overhead including logging !!
Public Sub Overhead_for_stacked_StopWatch()
Dim Log As New clsLogSaver_Console
Dim t1 As Currency
Dim t2 As Currency
Logger.LogSaver.KillAll
Log.StartLog
With Utils.StopWatch("Outer Watch")
With Utils.StopWatch("Inner Watch")
apiSleep 1000
t1 = .Elapsedms
End With
t2 = .Elapsedms
End With
Log.StopLog
Assert.That (t2 - t1), Iz.LessThan(1), "should be less than 1 msec"
End Sub
' ------------------------------------------------------------------------
Public Sub Measure_Long_Assignment()
Const LOOPS = 100000
Dim l As Long
Dim Value As Long
Dim lDuration As Currency
With Utils.StopWatch
For l = 1 To LOOPS
Value = 1
Next
lDuration = .Elapsedms
End With
Debug.Print "Longs: " & Int(LOOPS / (lDuration / 1000#)) & " 1/Sec"
End Sub
Public Sub Measure_String_Assignment()
Const LOOPS = 100000
Dim l As Long
Dim Value As String
Dim lDuration As Currency
With Utils.StopWatch
For l = 1 To LOOPS
Value = "1"
Next
lDuration = .Elapsedms
End With
Debug.Print "Strings: " & Int(LOOPS / (lDuration / 1000#)) & " 1/Sec"
End Sub
Public Sub Measure_Object_Assignment()
Const LOOPS = 100000
Dim l As Long
Dim obj As Object
Dim Value As Object
Dim lDuration As Currency
Set obj = New clsDateTime
With Utils.StopWatch
For l = 1 To LOOPS
Set Value = obj
Next
lDuration = .Elapsedms
End With
Debug.Print "Objects: " & Int(LOOPS / (lDuration / 1000#)) & " 1/Sec"
End Sub
Public Sub Measure_Object_Creation()
Const LOOPS = 100000
Dim l As Long
Dim Value As Object
Dim lDuration As Currency
With Utils.StopWatch
For l = 1 To LOOPS
Set Value = New clsDateTime
Next
lDuration = .Elapsedms
End With
Debug.Print "Objects: " & Int(LOOPS / (lDuration / 1000#)) & " 1/Sec"
End Sub