326 lines
6.7 KiB
Text
Executable file
326 lines
6.7 KiB
Text
Executable file
# This is a collection of BASIC macros that can cause Syntax errors, Exceptions,
|
|
# Runtime Errors. They are loaded in the test framework/optional/f_basic_issues.bas
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[Default_Macro]
|
|
REM BASIC
|
|
|
|
sub main
|
|
|
|
end sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[MessageBoxes]
|
|
'# MessageBoxes - Macro that opens all flavors of messageboxes
|
|
function TestMessageBoxes()
|
|
|
|
msgbox( "0x" , 0 )
|
|
msgbox( "1x" , 1 )
|
|
msgbox( "2x" , 2 )
|
|
msgbox( "3x" , 3 )
|
|
msgbox( "4x" , 4 )
|
|
msgbox( "5x" , 5 )
|
|
|
|
msgbox( "16" , 2 + 16 )
|
|
msgbox( "32" , 2 + 32 )
|
|
msgbox( "48" , 2 + 48 )
|
|
msgbox( "64" , 2 + 64 )
|
|
msgbox( "128" , 2 + 128 )
|
|
msgbox( "256" , 2 + 256 )
|
|
msgbox( "512" , 2 + 512 )
|
|
|
|
end function
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[TTMacro1]
|
|
'# TTMacro1: This is a short testscript for automated testing!
|
|
sub main
|
|
|
|
print( "TTMacro1" )
|
|
|
|
end sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[TTMacro2]
|
|
'# TTMacro2: Macro that only contains a comment on the first line
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[TTMacro3]
|
|
'# TTMacro3: Bring up a messagebox
|
|
sub main
|
|
|
|
msgbox( "TTMacro3" )
|
|
|
|
end sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[tBasicExport]
|
|
' This is a macro to test the BASIC library export
|
|
sub main
|
|
|
|
msgbox( "tBasicExport" )
|
|
|
|
end sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i41695]
|
|
' No runtime exception
|
|
sub main
|
|
|
|
dim F as string
|
|
dim S as string
|
|
msgbox( "i41695-1" )
|
|
F = "file://" & curdir & "/test.txt"
|
|
Open F for random as #17
|
|
|
|
get #17, 1, S
|
|
msgbox( "i41695-2" )
|
|
|
|
end sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i77436]
|
|
'# This is a macro required for verification of issue 77436
|
|
Sub Main
|
|
'test service
|
|
o= createUnoService("TestNamesComp")
|
|
msgbox o.dbg_supportedInterfaces
|
|
|
|
'test singleton
|
|
ctx = getDefaultContext
|
|
factory = ctx.getValueByName("org.openoffice.test.Names")
|
|
msgbox o.dbg_supportedInterfaces
|
|
|
|
End Sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i82830]
|
|
'should display
|
|
'12D687
|
|
'4553207
|
|
Sub Main
|
|
dim l as long
|
|
l = 1234567
|
|
msgbox hex( l )
|
|
msgbox oct( l )
|
|
end sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i81674]
|
|
Sub Main
|
|
MsgBox Format(1250, "Currency")
|
|
MsgBox Format(1250, "Yes/No")
|
|
MsgBox Format(1250, "True/False")
|
|
MsgBox Format(1250, "On/Off")
|
|
End Sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i80532]
|
|
' Should display three messageboxes: -10,1,-10
|
|
Sub Main
|
|
aTestFunction (-10) ' will compile
|
|
aTestFunction 1,-10 ' will compile
|
|
aTestFunction -10 ' should now compile and run, too
|
|
End Sub
|
|
|
|
function aTestFunction( param1 as variant )
|
|
msgbox "param1 = " & param1
|
|
end function
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i83978]
|
|
' This should trigger an exception
|
|
|
|
Sub Main
|
|
BasicLibraries.LoadLibrary( "ThisLibDoesNotExist" )
|
|
End Sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i84040]
|
|
' Two messageboxes that should display "false"
|
|
|
|
Sub Main
|
|
Dim oError1 as new com.sun.star.sdbc.SQLException
|
|
print isnull( oError1 )
|
|
Dim oError2 as Object
|
|
oError2 = CreateUnoStruct( "com.sun.star.sdbc.SQLException" )
|
|
print isnull( oError2 )
|
|
End Sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i86265]
|
|
' There should be no "Parantheses do not match" warning
|
|
OPTION EXPLICIT
|
|
Public Const cMAX = 256
|
|
|
|
Sub Main
|
|
|
|
Dim mRangeArray(0, 0) as String
|
|
Dim n as Integer
|
|
|
|
n = 10
|
|
MsgBox "i86265-1"
|
|
ReDim mRangeArray(CInt(cMAX), n) as String
|
|
MsgBox "i86265-2"
|
|
|
|
End Sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i92329]
|
|
Option VBASupport 1
|
|
Sub Main()
|
|
|
|
Dim mTmp() As String
|
|
mTmp() = Test(False) '<-- generates an 'unexpected ')' compiler error
|
|
MsgBox mTmp(0) & " " & mTmp(1)
|
|
|
|
End Sub
|
|
|
|
Function Test(ByVal bFlag As Boolean) As Variant
|
|
|
|
Dim mRanges(100) As String
|
|
|
|
If (bFlag = True) Then
|
|
Test = "return a String"
|
|
Else
|
|
mRanges(0) = "Return an"
|
|
mRanges(1) = "Array"
|
|
Test = mRanges()
|
|
End If
|
|
|
|
End Function
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i97038]
|
|
' Date should contain the year 1900 and the value should be 2
|
|
|
|
Sub Main
|
|
Dim v
|
|
v = DateSerial(0,1,1)
|
|
Msgbox ("Date : " & v)
|
|
MsgBox ("Value : " & CDbl(v))
|
|
End Sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i103691]
|
|
option vbasupport 1
|
|
|
|
Sub Main
|
|
dim a, b
|
|
|
|
if (not a = b) then
|
|
msgbox( "not equal" )
|
|
else
|
|
msgbox( "Equal" )
|
|
end if
|
|
End Sub
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i103697]
|
|
Private Declare Function FooFunction Lib "foo" ( nVal )
|
|
Public Declare Function FooFunction2 Lib "foo" ( nVal )
|
|
|
|
sub main
|
|
msgbox( "i103697" )
|
|
end sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i103990]
|
|
type MyType
|
|
a( 3 ) as integer
|
|
b as double
|
|
end type
|
|
|
|
Sub Main
|
|
dim mt as MyType
|
|
mt.a(0) = 42
|
|
mt.a(1) = 43
|
|
mt.b = 3.14
|
|
msgbox( mt.a(0) )
|
|
msgbox( mt.a(1) )
|
|
if ( mt.b = 3.14 ) then
|
|
msgbox( "Pi" )
|
|
else
|
|
msgbox( "Error" )
|
|
endif
|
|
end sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i107070]
|
|
Sub Main
|
|
oSingleton = com.sun.star.logging.LoggerPool
|
|
|
|
oInstance1 = oSingleton.get()
|
|
msgbox oInstance1.dbg_properties
|
|
|
|
oCtx = GetDefaultContext()
|
|
oInstance2 = oSingleton.get( oCtx )
|
|
msgbox oInstance2.dbg_properties
|
|
|
|
' Uncommenting this should result in an error "Invalid procedure call"
|
|
oInstanceErr1 = oSingleton.get( 42 )
|
|
End Sub
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i106744-1]
|
|
sub main
|
|
msgbox test1()
|
|
end sub
|
|
|
|
Function test1() As String
|
|
|
|
Dim foo As String : foo = "astring"
|
|
|
|
On Error Resume Next
|
|
test1 = "GOT ERROR"
|
|
If IsEmpty(foo) Then
|
|
test1 = "EMPTY"
|
|
Else
|
|
test1 = "NOT EMPTY"
|
|
End If
|
|
|
|
End Function
|
|
|
|
# ---------------------------------------------------------------------------- #
|
|
|
|
[i106744-2]
|
|
option VBASupport 1
|
|
|
|
sub main
|
|
msgbox test1()
|
|
end sub
|
|
|
|
Function test1() As String
|
|
|
|
Dim foo As String : foo = "astring"
|
|
|
|
On Error Resume Next
|
|
test1 = "GOT ERROR"
|
|
If IsEmpty(foo) Then
|
|
test1 = "EMPTY"
|
|
Else
|
|
test1 = "NOT EMPTY"
|
|
End If
|
|
|
|
End Function
|
|
|