tdf#136755, tdf#124008 - delete the variable beforehand REDIM
If an array of objects is passed as an argument to ReDim, delete the
variable beforehand, otherwise the construction of the new variable
fails, because the old one is still on the stack.
Change-Id: Ic863a36f5f2aca658df369f95d275aa287edf795
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/106832
Tested-by: Jenkins
Reviewed-by: Andreas Heinisch <andreas.heinisch@yahoo.de>
diff --git a/basic/qa/basic_coverage/test_redim_objects.vb b/basic/qa/basic_coverage/test_redim_objects.vb
new file mode 100644
index 0000000..053ba1a
--- /dev/null
+++ b/basic/qa/basic_coverage/test_redim_objects.vb
@@ -0,0 +1,33 @@
' This file is part of the LibreOffice project.
'
' This Source Code Form is subject to the terms of the Mozilla Public
' License, v. 2.0. If a copy of the MPL was not distributed with this
' file, You can obtain one at http://mozilla.org/MPL/2.0/.
'
Type testType
iNr As Integer
sType As String
aValue As Variant
oColor As Object
End Type
Function doUnitTest as Integer
doUnitTest = 0
' tdf#136755 - ReDim did not work on an array of objects
Dim aPropertyValues(1) As New com.sun.star.beans.PropertyValue
If (UBound(aPropertyValues) <> 1) Then Exit Function
ReDim aPropertyValues(5) As com.sun.star.beans.PropertyValue
If (UBound(aPropertyValues) <> 5) Then Exit Function
' tdf#124008 - ReDim did not work on an array of individual declared types
Dim aType(1) As testType
If (UBound(aType) <> 1) Then Exit Function
ReDim aType(5) As testType
If (UBound(aType) <> 5) Then Exit Function
doUnitTest = 1
End Function
diff --git a/basic/qa/vba_tests/redim_objects.vb b/basic/qa/vba_tests/redim_objects.vb
new file mode 100644
index 0000000..9355b28
--- /dev/null
+++ b/basic/qa/vba_tests/redim_objects.vb
@@ -0,0 +1,42 @@
' This file is part of the LibreOffice project.
'
' This Source Code Form is subject to the terms of the Mozilla Public
' License, v. 2.0. If a copy of the MPL was not distributed with this
' file, You can obtain one at http://mozilla.org/MPL/2.0/.
'
Option VBASupport 1
Option Explicit
Type testType
iNr As Integer
sType As String
aValue As Variant
oColor As Object
End Type
Function doUnitTest() As String
TestUtil.TestInit
verify_testReDimObjects
doUnitTest = TestUtil.GetResult()
End Function
Sub verify_testReDimObjects()
On Error GoTo errorHandler
' tdf#136755 - ReDim did not work on an array of objects
Dim aPropertyValues(1) As New com.sun.star.beans.PropertyValue
TestUtil.AssertEqual(UBound(aPropertyValues), 1, "UBound(aPropertyValues)")
ReDim aPropertyValues(5) As com.sun.star.beans.PropertyValue
TestUtil.AssertEqual(UBound(aPropertyValues), 5, "UBound(aPropertyValues)")
' tdf#124008 - ReDim did not work on an array of individual declared types
Dim aType(1) As testType
TestUtil.AssertEqual(UBound(aType), 1, "UBound(aType)")
ReDim aType(5) As testType
TestUtil.AssertEqual(UBound(aType), 5, "UBound(aType)")
Exit Sub
errorHandler:
TestUtil.ReportErrorHandler("verify_testReDimObjects", Err, Error$, Erl)
End Sub
diff --git a/basic/source/comp/dim.cxx b/basic/source/comp/dim.cxx
index 17eef0a..e95e8ee 100644
--- a/basic/source/comp/dim.cxx
+++ b/basic/source/comp/dim.cxx
@@ -431,9 +431,14 @@ void SbiParser::DefVar( SbiOpcode eOp, bool bStatic )
}
else
{
pDef->SetDims( pDim->GetDims() );
SbiExpression aExpr( this, *pDef, std::move(pDim) );
// tdf#136755 - delete the variable beforehand REDIM
SbiExpression aExpr(this, *pDef, nullptr);
aExpr.Gen();
aGen.Gen(bVBASupportOn ? SbiOpcode::ERASE_CLEAR_ : SbiOpcode::ERASE_);
pDef->SetDims( pDim->GetDims() );
SbiExpression aExpr2( this, *pDef, std::move(pDim) );
aExpr2.Gen();
aGen.Gen( SbiOpcode::DCREATE_, pDef->GetId(), pDef->GetTypeId() );
}
}
