# *************************************************************
#  
#  Licensed to the Apache Software Foundation (ASF) under one
#  or more contributor license agreements.  See the NOTICE file
#  distributed with this work for additional information
#  regarding copyright ownership.  The ASF licenses this file
#  to you under the Apache License, Version 2.0 (the
#  "License"); you may not use this file except in compliance
#  with the License.  You may obtain a copy of the License at
#  
#    http://www.apache.org/licenses/LICENSE-2.0
#  
#  Unless required by applicable law or agreed to in writing,
#  software distributed under the License is distributed on an
#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
#  KIND, either express or implied.  See the License for the
#  specific language governing permissions and limitations
#  under the License.
#  
# *************************************************************

# 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