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.budea@collabora.com>
Tested-by: Aron Budea <aron.budea@collabora.com>

5 files changed, 225 insertions, 0 deletions

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 },