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/56610
Tested-by: Jenkins
Reviewed-by: Mike Kaganski <mike.kaganski@collabora.com>

4 files changed, 170 insertions, 9 deletions

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 9049d787d04e..4eb36147f175 100644
--- a/basic/source/runtime/methods.cxx
+++ b/basic/source/runtime/methods.cxx
@@ -48,6 +48,7 @@
 #include <osl/file.hxx>
 #include <errobject.hxx>
 
+#include <comphelper/string.hxx>
 #include <comphelper/processfactory.hxx>
 #include <comphelper/string.hxx>
 
@@ -59,6 +60,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>
@@ -3294,6 +3296,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 d6349e0000a0..ff10ad4f2695 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 },