diff options
Diffstat (limited to 'basic')
| -rw-r--r-- | basic/qa/cppunit/test_vba.cxx | 3 | ||||
| -rw-r--r-- | basic/qa/vba_tests/cdec.vb | 4 | ||||
| -rw-r--r-- | basic/qa/vba_tests/datevalue.vb | 8 | ||||
| -rw-r--r-- | basic/qa/vba_tests/win32compat.vb | 86 | ||||
| -rw-r--r-- | basic/source/runtime/dllmgr-none.cxx | 53 |
5 files changed, 143 insertions, 11 deletions
diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx index 87c6512c9449..739e96a88b22 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 3ed82b33ac90..56166cae5a4e 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 20aac6416345..6ac6fe73d47e 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 000000000000..7697648ddc93 --- /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 5272d172df2f..10079d65bbd9 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) {} |