basic/qa/vba_tests/win32compat.vb

   1 Option VBASupport 1
   2 Option Explicit
   3
   4 '
   5 ' This file is part of the LibreOffice project.
   6 '
   7 ' This Source Code Form is subject to the terms of the Mozilla Public
   8 ' License, v. 2.0. If a copy of the MPL was not distributed with this
   9 ' file, You can obtain one at http://mozilla.org/MPL/2.0/.
  10 '
  11 '
  12 ' Test built-in compatibility versions of methods whose absence
  13 ' is really felt in VBA, and large numbers of macros import from
  14 ' the system.
  15 '
  16
  17 Dim passCount As Integer
  18 Dim failCount As Integer
  19 Dim result As String
  20
  21 Private Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef lpPerformanceCount As Currency) As Long
  22 Private Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef lpFrequency As Currency) As Long
  23
  24 ' FIXME: all this cut/paste should be factored out !
  25
  26 Function doUnitTest() As String
  27     result = verify_win32compat()
  28     If failCount <> 0 Then
  29         doUnitTest = result
  30     Else
  31         doUnitTest = "OK"
  32     End If
  33 End Function
  34
  35
  36 Function verify_win32compat() as String
  37     passCount = 0
  38     failCount = 0
  39
  40     result = "Test Results" & Chr$(10) & "================" & Chr$(10)
  41
  42     Dim freq As Currency
  43     Dim count_a As Currency
  44     Dim count_b As Currency
  45     Dim success As Long
  46
  47     On Error GoTo errorHandler
  48
  49     success = QueryPerformanceFrequency(freq)
  50     TestLog_ASSERT success <> 0, "fetching perf. frequency"
  51     TestLog_ASSERT freq > 0, "perf. frequency is incorrect " & freq
  52
  53     success = QueryPerformanceCounter(count_a)
  54     TestLog_ASSERT success <> 0, "fetching performance count"
  55
  56     success = QueryPerformanceCounter(count_b)
  57     TestLog_ASSERT success <> 0, "fetching performance count"
  58     TestLog_ASSERT count_a < count_b, "count mismatch " & count_a & " is > " & count_b
  59
  60     verify_win32compat = "OK"
  61     Exit Function
  62
  63 errorHandler:
  64     TestLog_ASSERT (False), "hit error handler - " & Err & ": " & Error$ & " (line : " & Erl & ")"
  65     verify_win32compat = result
  66
  67 End Function
  68
  69 Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
  70
  71     If assertion = True Then
  72         passCount = passCount + 1
  73     Else
  74         Dim testMsg As String
  75         If Not IsMissing(testId) Then
  76             testMsg = testMsg + " : " + testId
  77         End If
  78         If Not IsMissing(testComment) And Not (testComment = "") Then
  79             testMsg = testMsg + " (" + testComment + ")"
  80         End If
  81
  82         result = result & Chr$(10) & " Failed: " & testMsg
  83         failCount = failCount + 1
  84     End If
  85
  86 End Sub