vba: add a different variant of the same compatibility function.

Change-Id: I92bc1dbceea2f10cbb055d97f68b33e575d9be11

3 files changed, 130 insertions, 6 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
diff --git a/basic/source/runtime/dllmgr-none.cxx b/basic/source/runtime/dllmgr-none.cxx
index 10079d65bbd9..426b2b156a4f 100644
--- a/basic/source/runtime/dllmgr-none.cxx
+++ b/basic/source/runtime/dllmgr-none.cxx
@@ -39,8 +39,8 @@ struct SbiDllMgr::Impl {};
 namespace {
 
 // Overcome the mess of Currency vs. custom types etc.
-SbError returnInt64(SbxArray *pArgs, SbxVariable &rRetVal,
-                    sal_Int64 nValue)
+SbError returnInt64InOutArg(SbxArray *pArgs, SbxVariable &rRetVal,
+                            sal_Int64 nValue)
 {
     if (!rRetVal.PutLong(true) && !rRetVal.PutInteger(true))
         return ERRCODE_BASIC_BAD_ARGUMENT;
@@ -54,7 +54,26 @@ SbError returnInt64(SbxArray *pArgs, SbxVariable &rRetVal,
         pOut->PutCurrency(nValue);
         return ERRCODE_NONE;
     }
-    // FIXME: tolerate custom type bits ...
+    if (pOut->IsObject())
+    {
+        // FIXME: should we clone this and use pOut->PutObject ?
+        SbxObject* pObj = PTR_CAST(SbxObject,pOut->GetObject());
+        if (!pObj)
+            return ERRCODE_BASIC_BAD_ARGUMENT;
+
+        // We expect two Longs but other mappings could be possible too.
+        SbxArray* pProps = pObj->GetProperties();
+        if (pProps->Count32() != 2)
+            return ERRCODE_BASIC_BAD_ARGUMENT;
+        SbxVariable* pLow = pProps->Get32( 0 );
+        SbxVariable* pHigh = pProps->Get32( 1 );
+        if (!pLow || !pLow->IsLong() ||
+            !pHigh || !pHigh->IsLong())
+            return ERRCODE_BASIC_BAD_ARGUMENT;
+        pLow->PutLong(nValue & 0xffffffff);
+        pHigh->PutLong(nValue >> 32);
+        return ERRCODE_NONE;
+    }
     return ERRCODE_BASIC_BAD_ARGUMENT;
 }
 
@@ -63,14 +82,14 @@ SbError builtin_kernel32(const OUString &aFuncName, SbxArray *pArgs,
 {
     sal_Int64 nNanoSecsPerSec = 1000.0*1000*1000;
     if (aFuncName == "QueryPerformanceFrequency")
-        return returnInt64(pArgs, rRetVal, nNanoSecsPerSec);
+        return returnInt64InOutArg(pArgs, rRetVal, nNanoSecsPerSec);
 
     else if (aFuncName == "QueryPerformanceCounter")
     {
         TimeValue aNow;
         osl_getSystemTime( &aNow );
         sal_Int64 nStamp = aNow.Nanosec + aNow.Seconds * nNanoSecsPerSec;
-        return returnInt64(pArgs, rRetVal, nStamp);
+        return returnInt64InOutArg(pArgs, rRetVal, nStamp);
     }
     return ERRCODE_BASIC_NOT_IMPLEMENTED;
 }