[Libreoffice-commits] core.git: 3 commits - basic/qa basic/source
Michael Meeks
michael.meeks at collabora.com
Fri Sep 19 07:31:38 PDT 2014
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 <michael.meeks at collabora.com>
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 <michael.meeks at collabora.com>
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 <michael.meeks at collabora.com>
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) {}
More information about the Libreoffice-commits
mailing list