basic/qa/vba_tests/redim_objects.vb

   1 ' This file is part of the LibreOffice project.
   2 '
   3 ' This Source Code Form is subject to the terms of the Mozilla Public
   4 ' License, v. 2.0. If a copy of the MPL was not distributed with this
   5 ' file, You can obtain one at http://mozilla.org/MPL/2.0/.
   6 '
   7
   8 Option VBASupport 1
   9 Option Explicit
  10
  11 Type testType
  12     iNr    As Integer
  13     sType  As String
  14     aValue As Variant
  15     oColor As Object
  16 End Type
  17
  18 Function doUnitTest() As String
  19      TestUtil.TestInit
  20      verify_testReDimObjects
  21      doUnitTest = TestUtil.GetResult()
  22 End Function
  23
  24 Sub verify_testReDimObjects()
  25     On Error GoTo errorHandler
  26
  27     ' tdf#136755 - ReDim did not work on an array of objects
  28     Dim aPropertyValues(1) As New com.sun.star.beans.PropertyValue
  29     TestUtil.AssertEqual(UBound(aPropertyValues), 1, "UBound(aPropertyValues)")
  30     ReDim aPropertyValues(5) As com.sun.star.beans.PropertyValue
  31     TestUtil.AssertEqual(UBound(aPropertyValues), 5, "UBound(aPropertyValues)")
  32
  33     ' tdf#124008 - ReDim did not work on an array of individual declared types
  34     Dim aType(1) As testType
  35     TestUtil.AssertEqual(UBound(aType), 1, "UBound(aType)")
  36     ReDim aType(5) As testType
  37     TestUtil.AssertEqual(UBound(aType), 5, "UBound(aType)")
  38
  39     Exit Sub
  40 errorHandler:
  41     TestUtil.ReportErrorHandler("verify_testReDimObjects", Err, Error$, Erl)
  42 End Sub