basic/qa/cppunit/test_vba.cxx | 6 +- basic/qa/vba_tests/cdec.vb | 4 - basic/qa/vba_tests/datevalue.vb | 8 +- basic/qa/vba_tests/win32compat.vb | 86 ++++++++++++++++++++++++++++ basic/qa/vba_tests/win32compatb.vb | 104 +++++++++++++++++++++++++++++++++++ basic/source/runtime/dllmgr-none.cxx | 72 ++++++++++++++++++++++-- 6 files changed, 269 insertions(+), 11 deletions(-)
New commits: commit 857f72dfe32b269a864dc30e687ce5920d1c0fda Author: Michael Meeks <[email protected]> Date: Fri Sep 19 14:45:06 2014 +0100 vba - disable Currency test / invocation on master. We're missing an effective SbxCURRENCY conversion here. Change-Id: Id6530ed3a93623b31089304f3451d9693ab4f3af diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx index 777b94ad..936cce3 100644 --- a/basic/qa/cppunit/test_vba.cxx +++ b/basic/qa/cppunit/test_vba.cxx @@ -51,7 +51,9 @@ void VBATest::testMiscVBAFunctions() "format.vb", "replace.vb", "stringplusdouble.vb", +#ifndef WIN32 // missing 64bit Currency marshalling. "win32compat.vb", // windows compatibility hooks. +#endif "win32compatb.vb" // same methods, different signatures. }; OUString sMacroPathURL = getURLFromSrc("/basic/qa/vba_tests/"); diff --git a/basic/qa/vba_tests/win32compat.vb b/basic/qa/vba_tests/win32compat.vb index 7697648..681d330 100644 --- a/basic/qa/vba_tests/win32compat.vb +++ b/basic/qa/vba_tests/win32compat.vb @@ -18,8 +18,8 @@ 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 +Private Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef lpPerformanceCount As Currency) As Long +Private Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef lpFrequency As Currency) As Long ' FIXME: all this cut/paste should be factored out ! @@ -61,7 +61,7 @@ Function verify_win32compat() as String Exit Function errorHandler: - TestLog_ASSERT (False), "hit error handler" + TestLog_ASSERT (False), "hit error handler - " & Err & ": " & Error$ & " (line : " & Erl & ")" verify_win32compat = result End Function commit 01e14011e5b38fbfa713f4dcd8ca5bf2ed75c436 Author: Michael Meeks <[email protected]> Date: Fri Sep 19 13:54:11 2014 +0100 vba: add a different variant of the same compatibility function. Change-Id: I92bc1dbceea2f10cbb055d97f68b33e575d9be11 diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx index 739e96a..777b94ad 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 0000000..d6819fa --- /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 10079d6..426b2b1 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; } commit 19ee058a21747efd36a91a5aaa2231fefe1e7fa4 Author: Michael Meeks <[email protected]> Date: Fri Sep 19 12:23:46 2014 +0100 vba: initial impl. of compatibility methods. Change-Id: Iebc25f1730766e96d2ad6921a8b4d2ea880c63f3 diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx index 87c6512..739e96a 100644 --- a/basic/qa/cppunit/test_vba.cxx +++ b/basic/qa/cppunit/test_vba.cxx @@ -50,7 +50,8 @@ void VBATest::testMiscVBAFunctions() "dateserial.vb", "format.vb", "replace.vb", - "stringplusdouble.vb" + "stringplusdouble.vb", + "win32compat.vb" }; OUString sMacroPathURL = getURLFromSrc("/basic/qa/vba_tests/"); // Some test data expects the uk locale diff --git a/basic/qa/vba_tests/cdec.vb b/basic/qa/vba_tests/cdec.vb index 3ed82b3..56166ca 100644 --- a/basic/qa/vba_tests/cdec.vb +++ b/basic/qa/vba_tests/cdec.vb @@ -23,7 +23,7 @@ Function verify_testCDec() as String Dim ret As Double testName = "Test CDec function" On Error GoTo errorHandler - + ret = CDec("") TestLog_ASSERT ret = 0, "Empty string test:" & ret @@ -82,5 +82,5 @@ Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional tes result = result & Chr$(10) & " Failed: " & testMsg failCount = failCount + 1 End If - + End Sub diff --git a/basic/qa/vba_tests/datevalue.vb b/basic/qa/vba_tests/datevalue.vb index 20aac64..6ac6fe7 100644 --- a/basic/qa/vba_tests/datevalue.vb +++ b/basic/qa/vba_tests/datevalue.vb @@ -28,12 +28,12 @@ Function verify_testDateValue() as String Dim date1, date2 As Date testName = "Test DateValue function" date2 = 25246 - + On Error GoTo errorHandler - + date1 = DateValue("February 12, 1969") '2/12/1969 TestLog_ASSERT date1 = date2, "the return date is: " & date1 - + date2 = 39468 date1 = DateValue("21/01/2008") '1/21/2008 TestLog_ASSERT date1 = date2, "the return date is: " & date1 @@ -61,5 +61,5 @@ Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional tes result = result & Chr$(10) & " Failed: " & testMsg failCount = failCount + 1 End If - + End Sub diff --git a/basic/qa/vba_tests/win32compat.vb b/basic/qa/vba_tests/win32compat.vb new file mode 100644 index 0000000..7697648 --- /dev/null +++ b/basic/qa/vba_tests/win32compat.vb @@ -0,0 +1,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 diff --git a/basic/source/runtime/dllmgr-none.cxx b/basic/source/runtime/dllmgr-none.cxx index 5272d17..10079d6 100644 --- a/basic/source/runtime/dllmgr-none.cxx +++ b/basic/source/runtime/dllmgr-none.cxx @@ -26,23 +26,68 @@ #include <basic/sbx.hxx> #include <basic/sbxvar.hxx> -#include <osl/thread.h> #include <rtl/ref.hxx> #include <rtl/string.hxx> #include <rtl/ustring.hxx> #include <salhelper/simplereferenceobject.hxx> +#include <osl/time.h> #include "dllmgr.hxx" struct SbiDllMgr::Impl {}; -SbError SbiDllMgr::Call( - OUString const &, OUString const &, SbxArray *, SbxVariable &, - bool) +namespace { + +// Overcome the mess of Currency vs. custom types etc. +SbError returnInt64(SbxArray *pArgs, SbxVariable &rRetVal, + sal_Int64 nValue) +{ + if (!rRetVal.PutLong(true) && !rRetVal.PutInteger(true)) + return ERRCODE_BASIC_BAD_ARGUMENT; + if (!pArgs || pArgs->Count() != 2) + return ERRCODE_BASIC_BAD_ARGUMENT; + SbxVariable *pOut = pArgs->Get(1); + if (!pOut) + return ERRCODE_BASIC_BAD_ARGUMENT; + if (pOut->IsCurrency()) + { + pOut->PutCurrency(nValue); + return ERRCODE_NONE; + } + // FIXME: tolerate custom type bits ... + return ERRCODE_BASIC_BAD_ARGUMENT; +} + +SbError builtin_kernel32(const OUString &aFuncName, SbxArray *pArgs, + SbxVariable &rRetVal) { + sal_Int64 nNanoSecsPerSec = 1000.0*1000*1000; + if (aFuncName == "QueryPerformanceFrequency") + return returnInt64(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 ERRCODE_BASIC_NOT_IMPLEMENTED; } +}; + +SbError SbiDllMgr::Call( + const OUString &aFuncName, const OUString &aDllName, + SbxArray *pArgs, SbxVariable &rRetVal, + bool /* bCDecl */) +{ + if (aDllName == "kernel32") + return builtin_kernel32(aFuncName, pArgs, rRetVal); + else + return ERRCODE_BASIC_NOT_IMPLEMENTED; +} + void SbiDllMgr::FreeDll(OUString const &) {} SbiDllMgr::SbiDllMgr(): impl_(new Impl) {} _______________________________________________ Libreoffice-commits mailing list [email protected] http://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
