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>
This commit is contained in:
Mike Kaganski
2018-06-29 02:44:13 +10:00
parent 2871d455ca
commit 0f7a7c8e71
4 changed files with 170 additions and 9 deletions

View File

@@ -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

View File

@@ -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);

View File

@@ -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

View File

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