basic/qa/vba_tests/win32compatb.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 ' This module tests different signatures for the same methods.
  17 '
  18
  19 Dim passCount As Integer
  20 Dim failCount As Integer
  21 Dim result As String
  22
  23 Private Type LARGE_INTEGER
  24     lowpart As Long
  25     highpart As Long
  26 End Type
  27
  28 Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
  29 Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
  30
  31 ' FIXME: all this cut/paste should be factored out !
  32
  33 Function doUnitTest() As String
  34     result = verify_win32compat()
  35     If failCount <> 0 Or passCount = 0 Then
  36         doUnitTest = result
  37     Else
  38         doUnitTest = "OK"
  39     End If
  40 End Function
  41
  42 Function convertLarge(scratch As LARGE_INTEGER) As Double
  43     Dim ret As Double
  44     ret = scratch.highpart
  45     ret = ret * 65536 * 65536
  46     ret = ret + scratch.lowpart
  47     convertLarge = ret
  48 End Function
  49
  50 Function verify_win32compat() as String
  51     passCount = 0
  52     failCount = 0
  53
  54     result = "Test Results" & Chr$(10) & "================" & Chr$(10)
  55
  56     Dim scratch as LARGE_INTEGER
  57     Dim freq As Double
  58     Dim count_a As Double
  59     Dim count_b As Double
  60     Dim success As Long
  61
  62     On Error GoTo errorHandler
  63
  64     success = QueryPerformanceFrequency(scratch)
  65     TestLog_ASSERT success <> 0, "fetching perf. frequency"
  66     freq = convertLarge(scratch)
  67     TestLog_ASSERT freq > 0, "perf. frequency is incorrect " & freq
  68
  69     success = QueryPerformanceCounter(scratch)
  70     TestLog_ASSERT success <> 0, "fetching performance count"
  71     count_a = convertLarge(scratch)
  72
  73 '    success = QueryPerformanceCounter(scratch)
  74 '    TestLog_ASSERT success <> 0, "fetching performance count"
  75 '    count_b = convertLarge(scratch)
  76 '    TestLog_ASSERT count_a < count_b, "count mismatch " & count_a & " is > " & count_b
  77
  78     verify_win32compat = "OK"
  79     Exit Function
  80
  81 errorHandler:
  82     TestLog_ASSERT (False), "hit error handler - " & Err & ": " & Error$ & " (line : " & Erl & ")"
  83     verify_win32compat = result
  84
  85 End Function
  86
  87 Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
  88
  89     If assertion = True Then
  90         passCount = passCount + 1
  91     Else
  92         Dim testMsg As String
  93         If Not IsMissing(testId) Then
  94             testMsg = testMsg + " : " + testId
  95         End If
  96         If Not IsMissing(testComment) And Not (testComment = "") Then
  97             testMsg = testMsg + " (" + testComment + ")"
  98         End If
  99
 100         result = result & Chr$(10) & " Failed: " & testMsg
 101         failCount = failCount + 1
 102     End If
 103
 104 End Sub