path: root/testautomation/global/input/macros.txt

# This is a collection of BASIC macros that can cause Syntax errors, Exceptions, 
# Runtime Errors.

# ---------------------------------------------------------------------------- #

[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( "Hello" )

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 "Paramtheses 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