basic/qa/cppunit/test_vba.cxx | 1
basic/qa/vba_tests/formatnumber.vb | 87 ++++++++++++++++++++++++
basic/source/inc/rtlproto.hxx | 2
basic/source/runtime/methods.cxx | 129 +++++++++++++++++++++++++++++++++++++
basic/source/runtime/stdobj.cxx | 6 +
5 files changed, 225 insertions(+)
New commits:
commit 5a920ccffd595fe828c6d042864f62f1797ee164
Author: Mike Kaganski <mike.kagan...@collabora.com>
Date: Fri Jun 29 02:44:13 2018 +1000
tdf#118218: Implement FormatNumber VBA function
The existing unit test (previously non-functional because of defunct
success condition) is fixed and extended.
Change-Id: I2544f865144b25f51a5f0941e5d961f246f41c4b
Reviewed-on: https://gerrit.libreoffice.org/56717
Reviewed-by: Aron Budea <aron.bu...@collabora.com>
Tested-by: Aron Budea <aron.bu...@collabora.com>
diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx
index 4e5adc312d58..f0bf1d2060c5 100644
--- a/basic/qa/cppunit/test_vba.cxx
+++ b/basic/qa/cppunit/test_vba.cxx
@@ -54,6 +54,7 @@ void VBATest::testMiscVBAFunctions()
"strconv.vb",
"dateserial.vb",
"format.vb",
+ "formatnumber.vb",
"replace.vb",
"stringplusdouble.vb",
#ifndef WIN32 // missing 64bit Currency marshalling.
diff --git a/basic/qa/vba_tests/formatnumber.vb
b/basic/qa/vba_tests/formatnumber.vb
new file mode 100644
index 000000000000..060d1342cb98
--- /dev/null
+++ b/basic/qa/vba_tests/formatnumber.vb
@@ -0,0 +1,87 @@
+Rem Attribute VBA_ModuleType=VBAModule
+Option VBASupport 1
+Rem Option VBASupport 1 'unREM in .vb file
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testFormatNumber()
+If failCount <> 0 Or passCount = 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testFormatNumber() As String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim str1 As String, str2 As String
+ On Error GoTo errorHandler
+
+ testName = "Test 1: positive, 2 decimals"
+ str2 = "12.20"
+ str1 = FormatNumber("12.2", 2, vbFalse, vbFalse, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 2: negative, 20 decimals, use leading zero"
+ str2 = "-0.20000000000000000000"
+ str1 = FormatNumber("-.2", 20, vbTrue, vbFalse, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 3: negative, 20 decimals, no leading zero"
+ str2 = "-.20000000000000000000"
+ str1 = FormatNumber("-0.2", 20, vbFalse, vbFalse, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 4: negative, no leading zero, use parens"
+ str2 = "(.20)"
+ str1 = FormatNumber("-0.2", -1, vbFalse, vbTrue, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 5: negative, default leading zero, use parens"
+ str2 = "(0.20)"
+ str1 = FormatNumber("-0.2", -1, vbUseDefault, vbTrue, vbFalse)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ testName = "Test 6: group digits"
+ str2 = "-12,345,678.00"
+ str1 = FormatNumber("-12345678", -1, vbUseDefault, vbUseDefault, vbTrue)
+ TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) &
"Tests failed: " & failCount & Chr$(10)
+ verify_testFormatNumber = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT False, testName & ": hit error handler"
+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 = 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/inc/rtlproto.hxx b/basic/source/inc/rtlproto.hxx
index aceff7393dfe..692884e8a651 100644
--- a/basic/source/inc/rtlproto.hxx
+++ b/basic/source/inc/rtlproto.hxx
@@ -235,6 +235,7 @@ extern RTLFUNC(IsUnoStruct);
extern RTLFUNC(FileDateTime);
extern RTLFUNC(Format);
+extern RTLFUNC(FormatNumber);
extern RTLFUNC(GetAttr);
extern RTLFUNC(Randomize); // JSM
extern RTLFUNC(Round);
@@ -300,6 +301,7 @@ extern RTLFUNC(Blue);
extern RTLFUNC(Switch);
extern RTLFUNC(Wait);
+
//i#64882# add new WaitUntil
extern RTLFUNC(WaitUntil);
extern RTLFUNC(FuncCaller);
diff --git a/basic/source/runtime/methods.cxx b/basic/source/runtime/methods.cxx
index 5b230e147c73..ac2f0d2fcd98 100644
--- a/basic/source/runtime/methods.cxx
+++ b/basic/source/runtime/methods.cxx
@@ -46,6 +46,7 @@
#include <osl/file.hxx>
#include "errobject.hxx"
+#include <comphelper/string.hxx>
#include <comphelper/processfactory.hxx>
#include <comphelper/string.hxx>
@@ -56,6 +57,7 @@
#include <com/sun/star/ucb/SimpleFileAccess.hpp>
#include <com/sun/star/script/XErrorQuery.hpp>
#include <ooo/vba/XHelperInterface.hpp>
+#include <ooo/vba/VbTriState.hpp>
#include <com/sun/star/bridge/oleautomation/XAutomationObject.hpp>
#include <memory>
#include <random>
@@ -3559,6 +3561,133 @@ RTLFUNC(Format)
}
}
+//
https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/formatnumber-function
+void SbRtl_FormatNumber(StarBASIC*, SbxArray& rPar, bool)
+{
+ const sal_uInt16 nArgCount = rPar.Count();
+ if (nArgCount < 2 || nArgCount > 6)
+ {
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+
+ // The UI locale never changes -> we can use static value here
+ static const LocaleDataWrapper
localeData(Application::GetSettings().GetUILanguageTag());
+ sal_Int16 nNumDigitsAfterDecimal = -1;
+ if (nArgCount > 2 && !rPar.Get(2)->IsEmpty())
+ {
+ nNumDigitsAfterDecimal = rPar.Get(2)->GetInteger();
+ if (nNumDigitsAfterDecimal < -1)
+ {
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ else if (nNumDigitsAfterDecimal > 255)
+ nNumDigitsAfterDecimal %= 256;
+ }
+ if (nNumDigitsAfterDecimal == -1)
+ nNumDigitsAfterDecimal = LocaleDataWrapper::getNumDigits();
+
+ bool bIncludeLeadingDigit = LocaleDataWrapper::isNumLeadingZero();
+ if (nArgCount > 3 && !rPar.Get(3)->IsEmpty())
+ {
+ switch (rPar.Get(3)->GetInteger())
+ {
+ case ooo::vba::VbTriState::vbFalse:
+ bIncludeLeadingDigit = false;
+ break;
+ case ooo::vba::VbTriState::vbTrue:
+ bIncludeLeadingDigit = true;
+ break;
+ case ooo::vba::VbTriState::vbUseDefault:
+ // do nothing;
+ break;
+ default:
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ bool bUseParensForNegativeNumbers = false;
+ if (nArgCount > 4 && !rPar.Get(4)->IsEmpty())
+ {
+ switch (rPar.Get(4)->GetInteger())
+ {
+ case ooo::vba::VbTriState::vbFalse:
+ case ooo::vba::VbTriState::vbUseDefault:
+ // do nothing
+ break;
+ case ooo::vba::VbTriState::vbTrue:
+ bUseParensForNegativeNumbers = true;
+ break;
+ default:
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ bool bGroupDigits = false;
+ if (nArgCount > 5 && !rPar.Get(5)->IsEmpty())
+ {
+ switch (rPar.Get(5)->GetInteger())
+ {
+ case ooo::vba::VbTriState::vbFalse:
+ case ooo::vba::VbTriState::vbUseDefault:
+ // do nothing
+ break;
+ case ooo::vba::VbTriState::vbTrue:
+ bGroupDigits = true;
+ break;
+ default:
+ StarBASIC::Error(ERRCODE_BASIC_BAD_ARGUMENT);
+ return;
+ }
+ }
+
+ double fVal = rPar.Get(1)->GetDouble();
+ const bool bNegative = fVal < 0;
+ if (bNegative)
+ fVal = fabs(fVal); // Always work with non-negatives, to easily handle
leading zero
+
+ static const sal_Unicode decSep = localeData.getNumDecimalSep().toChar();
+ OUString aResult = rtl::math::doubleToUString(
+ fVal, rtl_math_StringFormat_F, nNumDigitsAfterDecimal, decSep,
+ bGroupDigits ? localeData.getDigitGrouping().getConstArray() : nullptr,
+ localeData.getNumThousandSep().toChar());
+
+ if (!bIncludeLeadingDigit && aResult.getLength() > 1 &&
aResult.startsWith("0"))
+ aResult = aResult.copy(1);
+
+ if (nNumDigitsAfterDecimal > 0)
+ {
+ sal_Int32 nActualDigits = nNumDigitsAfterDecimal;
+ const sal_Int32 nSepPos = aResult.indexOf(decSep);
+ if (nSepPos == -1)
+ nActualDigits = 0;
+ else
+ nActualDigits = aResult.getLength() - nSepPos - 1;
+
+ // VBA allows up to 255 digits; rtl::math::doubleToUString outputs up
to 15 digits
+ // for ~small numbers, so pad them as appropriate.
+ if (nActualDigits < nNumDigitsAfterDecimal)
+ {
+ OUStringBuffer sBuf;
+ comphelper::string::padToLength(sBuf, nNumDigitsAfterDecimal -
nActualDigits, '0');
+ aResult += sBuf.makeStringAndClear();
+ }
+ }
+
+ if (bNegative)
+ {
+ if (bUseParensForNegativeNumbers)
+ aResult = "(" + aResult + ")";
+ else
+ aResult = "-" + aResult;
+ }
+
+ rPar.Get(0)->PutString(aResult);
+}
+
namespace {
// note: BASIC does not use comphelper::random, because
diff --git a/basic/source/runtime/stdobj.cxx b/basic/source/runtime/stdobj.cxx
index 115252c5b6a9..85412af44823 100644
--- a/basic/source/runtime/stdobj.cxx
+++ b/basic/source/runtime/stdobj.cxx
@@ -278,6 +278,12 @@ static Methods aMethods[] = {
{ "FormatDateTime", SbxSTRING, 2 | FUNCTION_ | COMPATONLY_,
RTLNAME(FormatDateTime),0 },
{ "Date", SbxDATE, 0,nullptr,0 },
{ "NamedFormat", SbxINTEGER, OPT_, nullptr,0 },
+{ "FormatNumber", SbxSTRING, 5 | FUNCTION_, RTLNAME(FormatNumber), 0 },
+ { "expression", SbxDOUBLE, 0, nullptr, 0 },
+ { "numDigitsAfterDecimal", SbxINTEGER, OPT_, nullptr, 0 },
+ { "includeLeadingDigit", SbxINTEGER, OPT_, nullptr, 0 }, //
vbTriState
+ { "useParensForNegativeNumbers", SbxINTEGER, OPT_, nullptr, 0 }, //
vbTriState
+ { "groupDigits", SbxINTEGER, OPT_, nullptr, 0 }, //
vbTriState
{ "Frac", SbxDOUBLE, 1 | FUNCTION_, RTLNAME(Frac),0 },
{ "number", SbxDOUBLE, 0,nullptr,0 },
{ "FRAMEANCHORCHAR", SbxINTEGER, CPROP_,
RTLNAME(FRAMEANCHORCHAR),0 },
_______________________________________________
Libreoffice-commits mailing list
libreoffice-comm...@lists.freedesktop.org
https://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
