diff options
author | Michael Meeks <michael.meeks@collabora.com> | 2014-09-19 13:54:11 +0100 |
---|---|---|
committer | Michael Meeks <michael.meeks@collabora.com> | 2014-09-19 15:31:07 +0100 |
commit | 01e14011e5b38fbfa713f4dcd8ca5bf2ed75c436 (patch) | |
tree | dfa1e31e6065a134c03f9ec0394a2be785183651 /basic/qa | |
parent | 19ee058a21747efd36a91a5aaa2231fefe1e7fa4 (diff) |
vba: add a different variant of the same compatibility function.
Change-Id: I92bc1dbceea2f10cbb055d97f68b33e575d9be11
Diffstat (limited to 'basic/qa')
-rw-r--r-- | basic/qa/cppunit/test_vba.cxx | 3 | ||||
-rw-r--r-- | basic/qa/vba_tests/win32compatb.vb | 104 |
2 files changed, 106 insertions, 1 deletions
diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx index 739e96a88b22..777b94ad49dc 100644 --- a/basic/qa/cppunit/test_vba.cxx +++ b/basic/qa/cppunit/test_vba.cxx @@ -51,7 +51,8 @@ void VBATest::testMiscVBAFunctions() "format.vb", "replace.vb", "stringplusdouble.vb", - "win32compat.vb" + "win32compat.vb", // windows compatibility hooks. + "win32compatb.vb" // same methods, different signatures. }; OUString sMacroPathURL = getURLFromSrc("/basic/qa/vba_tests/"); // Some test data expects the uk locale diff --git a/basic/qa/vba_tests/win32compatb.vb b/basic/qa/vba_tests/win32compatb.vb new file mode 100644 index 000000000000..d6819fa6ff8c --- /dev/null +++ b/basic/qa/vba_tests/win32compatb.vb @@ -0,0 +1,104 @@ +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. +' +' This module tests different signatures for the same methods. +' + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Private Type LARGE_INTEGER + lowpart As Long + highpart As Long +End Type + +Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long +Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) 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 convertLarge(scratch As LARGE_INTEGER) As Double + Dim ret As Double + ret = scratch.highpart + ret = ret * 65536 * 65536 + ret = ret + scratch.lowpart + convertLarge = ret +End Function + +Function verify_win32compat() as String + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "================" & Chr$(10) + + Dim scratch as LARGE_INTEGER + Dim freq As Double + Dim count_a As Double + Dim count_b As Double + Dim success As Long + + On Error GoTo errorHandler + + success = QueryPerformanceFrequency(scratch) + TestLog_ASSERT success <> 0, "fetching perf. frequency" + freq = convertLarge(scratch) + TestLog_ASSERT freq > 0, "perf. frequency is incorrect " & freq + + success = QueryPerformanceCounter(scratch) + TestLog_ASSERT success <> 0, "fetching performance count" + count_a = convertLarge(scratch) + +' success = QueryPerformanceCounter(scratch) +' TestLog_ASSERT success <> 0, "fetching performance count" +' count_b = convertLarge(scratch) +' 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 - " & Err & ": " & Error$ & " (line : " & Erl & ")" + 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 |