From 5afebab7773cc19a9cccc093f94022566b6cf4e6 Mon Sep 17 00:00:00 2001 From: Mike Kaganski Date: Fri, 29 Jun 2018 02:44:13 +1000 Subject: tdf#118218: Implement FormatNumber VBA function The existing unit test (previously non-functional because of defunct success condition) is fixed and extended. Also includes backport of commit 7283125c563a2759f278c1caa6a7b71ade4f0101 Change-Id: I2544f865144b25f51a5f0941e5d961f246f41c4b Reviewed-on: https://gerrit.libreoffice.org/56610 Tested-by: Jenkins Reviewed-by: Mike Kaganski (cherry picked from commit 0f7a7c8e719dab6b79e24285b907b5be17f39fc8) Reviewed-on: https://gerrit.libreoffice.org/56731 Reviewed-by: Andras Timar Tested-by: Andras Timar --- basic/qa/vba_tests/formatnumber.vb | 43 ++++++++++--- basic/source/inc/rtlproto.hxx | 1 + basic/source/runtime/methods.cxx | 129 +++++++++++++++++++++++++++++++++++++ basic/source/runtime/stdobj.cxx | 6 ++ 4 files changed, 170 insertions(+), 9 deletions(-) (limited to 'basic') diff --git a/basic/qa/vba_tests/formatnumber.vb b/basic/qa/vba_tests/formatnumber.vb index 3132e58edb54..060d1342cb98 100644 --- a/basic/qa/vba_tests/formatnumber.vb +++ b/basic/qa/vba_tests/formatnumber.vb @@ -8,7 +8,7 @@ Dim result As String Function doUnitTest() As String result = verify_testFormatNumber() -If failCount <> 0 And passCount > 0 Then +If failCount <> 0 Or passCount = 0 Then doUnitTest = result Else doUnitTest = "OK" @@ -25,20 +25,45 @@ Function verify_testFormatNumber() As String result = "Test Results" & Chr$(10) & "============" & Chr$(10) Dim testName As String - Dim date1, date2 - testName = "Test FormatNumber function" + Dim str1 As String, str2 As String On Error GoTo errorHandler - date2 = "42778.00" - date1 = FormatNumber("12.2", 2, vbFalse, vbFalse, vbFalse) - TestLog_ASSERT date1 = date2, "the return FormatNumber is: " & date1 + 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" + TestLog_ASSERT False, testName & ": hit error handler" End Function Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String) @@ -48,10 +73,10 @@ Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional tes Else Dim testMsg As String If Not IsMissing(testId) Then - testMsg = testMsg + " : " + testId + testMsg = testId & " " End If If Not IsMissing(testComment) And Not (testComment = "") Then - testMsg = testMsg + " (" + testComment + ")" + testMsg = testMsg + "(" + testComment + ")" End If result = result & Chr$(10) & " Failed: " & testMsg diff --git a/basic/source/inc/rtlproto.hxx b/basic/source/inc/rtlproto.hxx index 75ef16f469a5..6e26f9316103 100644 --- a/basic/source/inc/rtlproto.hxx +++ b/basic/source/inc/rtlproto.hxx @@ -234,6 +234,7 @@ extern void SbRtl_IsUnoStruct(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); extern void SbRtl_FileDateTime(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); extern void SbRtl_Format(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); +extern void SbRtl_FormatNumber(StarBASIC* pBasic, SbxArray& rPar, bool bWrite); extern void SbRtl_GetAttr(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); extern void SbRtl_Randomize(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); // JSM extern void SbRtl_Round(StarBASIC * pBasic, SbxArray & rPar, bool bWrite); diff --git a/basic/source/runtime/methods.cxx b/basic/source/runtime/methods.cxx index 07044ac5e6c5..c7b2e960b54b 100644 --- a/basic/source/runtime/methods.cxx +++ b/basic/source/runtime/methods.cxx @@ -47,6 +47,7 @@ #include #include +#include #include #include @@ -57,6 +58,7 @@ #include #include #include +#include #include #include #include @@ -3309,6 +3311,133 @@ void SbRtl_Format(StarBASIC *, SbxArray & rPar, bool) } } +// 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 23c00519214b..648ffdee470b 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_ | COMPATONLY_, 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 }, -- cgit