From 40031dd453991b3397f02726bd83cc857bef1044 Mon Sep 17 00:00:00 2001 From: Andreas Heinisch Date: Mon, 24 Aug 2020 11:15:59 +0200 Subject: tdf#54912 - with option base arrays should start at index 1 Using option base, every array should start at index 1. Previously, it needed option VBASupport too. Without option compatible, the upper bound of an array is increased as well in order to preserve the specified size. Change-Id: I52885f14914a4636b98258aa428c2123f62482a3 Reviewed-on: https://gerrit.libreoffice.org/c/core/+/101269 Tested-by: Jenkins Reviewed-by: Mike Kaganski --- basic/qa/basic_coverage/test_option_base.vb | 60 +++++++++++++++++++++ .../basic_coverage/test_option_base_compatible.vb | 61 ++++++++++++++++++++++ basic/source/runtime/methods.cxx | 2 +- basic/source/runtime/methods1.cxx | 4 +- basic/source/sbx/sbxstr.cxx | 2 +- 5 files changed, 124 insertions(+), 5 deletions(-) create mode 100644 basic/qa/basic_coverage/test_option_base.vb create mode 100644 basic/qa/basic_coverage/test_option_base_compatible.vb (limited to 'basic') diff --git a/basic/qa/basic_coverage/test_option_base.vb b/basic/qa/basic_coverage/test_option_base.vb new file mode 100644 index 000000000000..fff5858a4ee6 --- /dev/null +++ b/basic/qa/basic_coverage/test_option_base.vb @@ -0,0 +1,60 @@ +Option Base 1 + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String + result = verify_optionBase() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +Function verify_optionBase() As String + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + ' tdf#54912 - with option base arrays should start at index 1. + ' Without option compatible the upper bound is changed as well (#109275). + Dim strArray(2) As String + TestLog_ASSERT LBound(strArray), 1, "Lower bound of a string array (before assignment): " & LBound(strArray) + TestLog_ASSERT UBound(strArray), 3, "Upper bound of a string array (before assignment): " & UBound(strArray) + strArray = Array("a", "b") + TestLog_ASSERT LBound(strArray), 1, "Lower bound of a string array (after assignment): " & LBound(strArray) + TestLog_ASSERT UBound(strArray), 2, "Upper bound of a string array (after assignment): " & UBound(strArray) + + Dim intArray(2) As Integer + TestLog_ASSERT LBound(intArray), 1, "Lower bound of an integer array (before assignment): " & LBound(intArray) + TestLog_ASSERT UBound(intArray), 3, "Upper bound of an integer array (before assignment): " & UBound(intArray) + intArray = Array(1, 2) + TestLog_ASSERT LBound(intArray), 1, "Lower bound of an integer array (after assignment): " & LBound(intArray) + TestLog_ASSERT UBound(intArray), 2, "Upper bound of an integer array (after assignment): " & UBound(intArray) + + Dim byteArray(2) As Byte + TestLog_ASSERT LBound(byteArray), 1, "Lower bound of a byte array (before assignment): " & LBound(byteArray) + TestLog_ASSERT UBound(byteArray), 3, "Upper bound of a byte array (before assignment): " & UBound(byteArray) + byteArray = StrConv("ab", 128) + TestLog_ASSERT LBound(byteArray), 1, "Lower bound of a byte array (StrConv): " & LBound(byteArray) + TestLog_ASSERT UBound(byteArray), 2, "Upper bound of a byte array (StrConv): " & UBound(byteArray) + + ReDim byteArray(3) + TestLog_ASSERT LBound(byteArray), 1, "Lower bound of a byte array (ReDim): " & LBound(byteArray) + TestLog_ASSERT UBound(byteArray), 4, "Upper bound of a byte array (ReDim): " & UBound(byteArray) + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_optionBase = result +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & "Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub diff --git a/basic/qa/basic_coverage/test_option_base_compatible.vb b/basic/qa/basic_coverage/test_option_base_compatible.vb new file mode 100644 index 000000000000..37644e59faa4 --- /dev/null +++ b/basic/qa/basic_coverage/test_option_base_compatible.vb @@ -0,0 +1,61 @@ +Option Base 1 +Option Compatible + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String + result = verify_optionBase() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +Function verify_optionBase() As String + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + ' tdf#54912 - with option base arrays should start at index 1. + ' With option compatible the upper bound is not changed (#109275). + Dim strArray(2) As String + TestLog_ASSERT LBound(strArray), 1, "Lower bound of a string array (before assignment): " & LBound(strArray) + TestLog_ASSERT UBound(strArray), 2, "Upper bound of a string array (before assignment): " & UBound(strArray) + strArray = Array("a", "b") + TestLog_ASSERT LBound(strArray), 1, "Lower bound of a string array (after assignment): " & LBound(strArray) + TestLog_ASSERT UBound(strArray), 2, "Upper bound of a string array (after assignment): " & UBound(strArray) + + Dim intArray(2) As Integer + TestLog_ASSERT LBound(intArray), 1, "Lower bound of an integer array (before assignment): " & LBound(intArray) + TestLog_ASSERT UBound(intArray), 2, "Upper bound of an integer array (before assignment): " & UBound(intArray) + intArray = Array(1, 2) + TestLog_ASSERT LBound(intArray), 1, "Lower bound of an integer array (after assignment): " & LBound(intArray) + TestLog_ASSERT UBound(intArray), 2, "Upper bound of an integer array (after assignment): " & UBound(intArray) + + Dim byteArray(2) As Byte + TestLog_ASSERT LBound(byteArray), 1, "Lower bound of a byte array (before assignment): " & LBound(byteArray) + TestLog_ASSERT UBound(byteArray), 2, "Upper bound of a byte array (before assignment): " & UBound(byteArray) + byteArray = StrConv("ab", 128) + TestLog_ASSERT LBound(byteArray), 1, "Lower bound of a byte array (StrConv): " & LBound(byteArray) + TestLog_ASSERT UBound(byteArray), 2, "Upper bound of a byte array (StrConv): " & UBound(byteArray) + + ReDim byteArray(3) + TestLog_ASSERT LBound(byteArray), 1, "Lower bound of a byte array (ReDim): " & LBound(byteArray) + TestLog_ASSERT UBound(byteArray), 3, "Upper bound of a byte array (ReDim): " & UBound(byteArray) + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_optionBase = result +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & "Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub diff --git a/basic/source/runtime/methods.cxx b/basic/source/runtime/methods.cxx index cc60076b58a6..7f43ee0c7c60 100644 --- a/basic/source/runtime/methods.cxx +++ b/basic/source/runtime/methods.cxx @@ -4186,7 +4186,7 @@ void SbRtl_StrConv(StarBASIC *, SbxArray & rPar, bool) const char* pChar = aOStr.getStr(); sal_Int32 nArraySize = aOStr.getLength(); SbxDimArray* pArray = new SbxDimArray(SbxBYTE); - bool bIncIndex = (IsBaseIndexOne() && SbiRuntime::isVBAEnabled() ); + bool bIncIndex = IsBaseIndexOne(); if(nArraySize) { if( bIncIndex ) diff --git a/basic/source/runtime/methods1.cxx b/basic/source/runtime/methods1.cxx index 75f273042a60..898fc0329672 100644 --- a/basic/source/runtime/methods1.cxx +++ b/basic/source/runtime/methods1.cxx @@ -715,9 +715,7 @@ void SbRtl_Array(StarBASIC *, SbxArray & rPar, bool) { SbxDimArray* pArray = new SbxDimArray( SbxVARIANT ); sal_uInt32 nArraySize = rPar.Count32() - 1; - - // ignore Option Base so far (unfortunately only known by the compiler) - bool bIncIndex = (IsBaseIndexOne() && SbiRuntime::isVBAEnabled() ); + bool bIncIndex = IsBaseIndexOne(); if( nArraySize ) { if ( bIncIndex ) diff --git a/basic/source/sbx/sbxstr.cxx b/basic/source/sbx/sbxstr.cxx index 8edfb9d7ab2b..19504ff597d1 100644 --- a/basic/source/sbx/sbxstr.cxx +++ b/basic/source/sbx/sbxstr.cxx @@ -273,7 +273,7 @@ SbxArray* StringToByteArray(const OUString& rStr) #if !HAVE_FEATURE_SCRIPTING bool bIncIndex = false; #else - bool bIncIndex = ( IsBaseIndexOne() && SbiRuntime::isVBAEnabled() ); + bool bIncIndex = IsBaseIndexOne(); #endif if( bIncIndex ) pArray->AddDim32( 1, nArraySize ); -- cgit