summaryrefslogtreecommitdiff
path: root/basic/qa/vba_tests/win32compat.vb
blob: 7697648ddc9364413380e39252a05a9b31bff196 (plain)
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
Option VBASupport 1
Option Explicit

'
' This file is part of the LibreOffice project.
'
' This Source Code Form is subject to the terms of the Mozilla Public
' License, v. 2.0. If a copy of the MPL was not distributed with this
' file, You can obtain one at http://mozilla.org/MPL/2.0/.
'
'
' Test built-in compatibility versions of methods whose absence
' is really felt in VBA, and large numbers of macros import from
' the system.
'

Dim passCount As Integer
Dim failCount As Integer
Dim result As String

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long

' FIXME: all this cut/paste should be factored out !

Function doUnitTest() As String
    result = verify_win32compat()
    If failCount <> 0 Then
        doUnitTest = result
    Else
        doUnitTest = "OK"
    End If
End Function


Function verify_win32compat() as String
    passCount = 0
    failCount = 0

    result = "Test Results" & Chr$(10) & "================" & Chr$(10)

    Dim freq As Currency
    Dim count_a As Currency
    Dim count_b As Currency
    Dim success As Long

    On Error GoTo errorHandler

    success = QueryPerformanceFrequency(freq)
    TestLog_ASSERT success <> 0, "fetching perf. frequency"
    TestLog_ASSERT freq > 0, "perf. frequency is incorrect " & freq

    success = QueryPerformanceCounter(count_a)
    TestLog_ASSERT success <> 0, "fetching performance count"

    success = QueryPerformanceCounter(count_b)
    TestLog_ASSERT success <> 0, "fetching performance count"
    TestLog_ASSERT count_a < count_b, "count mismatch " & count_a & " is > " & count_b

    verify_win32compat = "OK"
    Exit Function

errorHandler:
    TestLog_ASSERT (False), "hit error handler"
    verify_win32compat = result

End Function

Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)

    If assertion = True Then
        passCount = passCount + 1
    Else
        Dim testMsg As String
        If Not IsMissing(testId) Then
            testMsg = testMsg + " : " + testId
        End If
        If Not IsMissing(testComment) And Not (testComment = "") Then
            testMsg = testMsg + " (" + testComment + ")"
        End If

        result = result & Chr$(10) & " Failed: " & testMsg
        failCount = failCount + 1
    End If

End Sub