' ' Copyright 2011 Jacek Caban for CodeWeavers ' ' This library is free software; you can redistribute it and/or ' modify it under the terms of the GNU Lesser General Public ' License as published by the Free Software Foundation; either ' version 2.1 of the License, or (at your option) any later version. ' ' This library is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ' Lesser General Public License for more details. ' ' You should have received a copy of the GNU Lesser General Public ' License along with this library; if not, write to the Free Software ' Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA ' OPTION EXPLICIT : : DIM W dim x, y, z Dim obj call ok(true, "true is not true?") ok true, "true is not true?" call ok((true), "true is not true?") ok not false, "not false but not true?" ok not not true, "not not true but not true?" Call ok(true = true, "true = true is false") Call ok(false = false, "false = false is false") Call ok(not (true = false), "true = false is true") Call ok("x" = "x", """x"" = ""x"" is false") Call ok(empty = empty, "empty = empty is false") Call ok(empty = "", "empty = """" is false") Call ok(0 = 0.0, "0 <> 0.0") Call ok(16 = &h10&, "16 <> &h10&") Call ok(010 = 10, "010 <> 10") Call ok(10. = 10, "10. <> 10") Call ok(&hffFFffFF& = -1, "&hffFFffFF& <> -1") Call ok(&hffFFffFF& = -1, "&hffFFffFF& <> -1") Call ok(34e5 = 3400000, "34e5 <> 3400000") Call ok(56.789e5 = 5678900, "56.789e5 = 5678900") Call ok(56.789e-2 = 0.56789, "56.789e-2 <> 0.56789") Call ok(1e-94938484 = 0, "1e-... <> 0") Call ok(34e0 = 34, "34e0 <> 34") Call ok(34E1 = 340, "34E0 <> 340") Call ok(--1 = 1, "--1 = " & --1) Call ok(-empty = 0, "-empty = " & (-empty)) Call ok(true = -1, "! true = -1") Call ok(false = 0, "false <> 0") Call ok(&hff = 255, "&hff <> 255") Call ok(&Hff = 255, "&Hff <> 255") W = 5 Call ok(W = 5, "W = " & W & " expected " & 5) x = "xx" Call ok(x = "xx", "x = " & x & " expected ""xx""") Call ok(true <> false, "true <> false is false") Call ok(not (true <> true), "true <> true is true") Call ok(not ("x" <> "x"), """x"" <> ""x"" is true") Call ok(not (empty <> empty), "empty <> empty is true") Call ok(x <> "x", "x = ""x""") Call ok("true" <> true, """true"" = true is true") Call ok("" = true = false, """"" = true = false is false") Call ok(not(false = true = ""), "false = true = """" is true") Call ok(not (false = false <> false = false), "false = false <> false = false is true") Call ok(not ("" <> false = false), """"" <> false = false is true") Call ok(getVT(false) = "VT_BOOL", "getVT(false) is not VT_BOOL") Call ok(getVT(true) = "VT_BOOL", "getVT(true) is not VT_BOOL") Call ok(getVT("") = "VT_BSTR", "getVT("""") is not VT_BSTR") Call ok(getVT("test") = "VT_BSTR", "getVT(""test"") is not VT_BSTR") Call ok(getVT(Empty) = "VT_EMPTY", "getVT(Empty) is not VT_EMPTY") Call ok(getVT(null) = "VT_NULL", "getVT(null) is not VT_NULL") Call ok(getVT(0) = "VT_I2", "getVT(0) is not VT_I2") Call ok(getVT(1) = "VT_I2", "getVT(1) is not VT_I2") Call ok(getVT(0.5) = "VT_R8", "getVT(0.5) is not VT_R8") Call ok(getVT(0.0) = "VT_R8", "getVT(0.0) is not VT_R8") Call ok(getVT(2147483647) = "VT_I4", "getVT(2147483647) is not VT_I4") Call ok(getVT(2147483648) = "VT_R8", "getVT(2147483648) is not VT_R8") Call ok(getVT(&h10&) = "VT_I2", "getVT(&h10&) is not VT_I2") Call ok(getVT(&h10000&) = "VT_I4", "getVT(&h10000&) is not VT_I4") Call ok(getVT(&H10000&) = "VT_I4", "getVT(&H10000&) is not VT_I4") Call ok(getVT(&hffFFffFF&) = "VT_I2", "getVT(&hffFFffFF&) is not VT_I2") Call ok(getVT(1e2) = "VT_R8", "getVT(1e2) is not VT_R8") Call ok(getVT(1e0) = "VT_R8", "getVT(1e0) is not VT_R8") Call ok(getVT(0.1e2) = "VT_R8", "getVT(0.1e2) is not VT_R8") Call ok(getVT(1 & 100000) = "VT_BSTR", "getVT(1 & 100000) is not VT_BSTR") Call ok(getVT(-empty) = "VT_I2", "getVT(-empty) = " & getVT(-empty)) Call ok(getVT(-null) = "VT_NULL", "getVT(-null) = " & getVT(-null)) Call ok(getVT(y) = "VT_EMPTY*", "getVT(y) = " & getVT(y)) Call ok(getVT(nothing) = "VT_DISPATCH", "getVT(nothing) = " & getVT(nothing)) set x = nothing Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x=nothing) = " & getVT(x)) x = true Call ok(getVT(x) = "VT_BOOL*", "getVT(x) = " & getVT(x)) Call ok(getVT(false or true) = "VT_BOOL", "getVT(false) is not VT_BOOL") x = "x" Call ok(getVT(x) = "VT_BSTR*", "getVT(x) is not VT_BSTR*") x = 0.0 Call ok(getVT(x) = "VT_R8*", "getVT(x) = " & getVT(x)) Call ok(isNullDisp(nothing), "nothing is not nulldisp?") x = "xx" Call ok("ab" & "cd" = "abcd", """ab"" & ""cd"" <> ""abcd""") Call ok("ab " & null = "ab ", """ab"" & null = " & ("ab " & null)) Call ok("ab " & empty = "ab ", """ab"" & empty = " & ("ab " & empty)) Call ok(1 & 100000 = "1100000", "1 & 100000 = " & (1 & 100000)) Call ok("ab" & x = "abxx", """ab"" & x = " & ("ab"&x)) if(isEnglishLang) then Call ok("" & true = "True", """"" & true = " & true) Call ok(true & false = "TrueFalse", "true & false = " & (true & false)) end if call ok(true and true, "true and true is not true") call ok(true and not false, "true and not false is not true") call ok(not (false and true), "not (false and true) is not true") call ok(getVT(null and true) = "VT_NULL", "getVT(null and true) = " & getVT(null and true)) call ok(false or true, "false or uie is false?") call ok(not (false or false), "false or false is not false?") call ok(false and false or true, "false and false or true is false?") call ok(true or false and false, "true or false and false is false?") call ok(null or true, "null or true is false") call ok(true xor false, "true xor false is false?") call ok(not (false xor false), "false xor false is true?") call ok(not (true or false xor true), "true or false xor true is true?") call ok(not (true xor false or true), "true xor false or true is true?") call ok(false eqv false, "false does not equal false?") call ok(not (false eqv true), "false equals true?") call ok(getVT(false eqv null) = "VT_NULL", "getVT(false eqv null) = " & getVT(false eqv null)) call ok(true imp true, "true does not imp true?") call ok(false imp false, "false does not imp false?") call ok(not (true imp false), "true imp false?") call ok(false imp null, "false imp null is false?") Call ok(2 >= 1, "! 2 >= 1") Call ok(2 >= 2, "! 2 >= 2") Call ok(not(true >= 2), "true >= 2 ?") Call ok(2 > 1, "! 2 > 1") Call ok(false > true, "! false < true") Call ok(0 > true, "! 0 > true") Call ok(not (true > 0), "true > 0") Call ok(not (0 > 1 = 1), "0 > 1 = 1") Call ok(1 < 2, "! 1 < 2") Call ok(1 = 1 < 0, "! 1 = 1 < 0") Call ok(1 <= 2, "! 1 <= 2") Call ok(2 <= 2, "! 2 <= 2") Call ok(isNull(0 = null), "'(0 = null)' is not null") Call ok(isNull(null = 1), "'(null = 1)' is not null") Call ok(isNull(0 > null), "'(0 > null)' is not null") Call ok(isNull(null > 1), "'(null > 1)' is not null") Call ok(isNull(0 < null), "'(0 < null)' is not null") Call ok(isNull(null < 1), "'(null < 1)' is not null") Call ok(isNull(0 <> null), "'(0 <> null)' is not null") Call ok(isNull(null <> 1), "'(null <> 1)' is not null") Call ok(isNull(0 >= null), "'(0 >= null)' is not null") Call ok(isNull(null >= 1), "'(null >= 1)' is not null") Call ok(isNull(0 <= null), "'(0 <= null)' is not null") Call ok(isNull(null <= 1), "'(null <= 1)' is not null") x = 3 Call ok(2+2 = 4, "2+2 = " & (2+2)) Call ok(false + 6 + true = 5, "false + 6 + true <> 5") Call ok(getVT(2+null) = "VT_NULL", "getVT(2+null) = " & getVT(2+null)) Call ok(2+empty = 2, "2+empty = " & (2+empty)) Call ok(x+x = 6, "x+x = " & (x+x)) Call ok(5-1 = 4, "5-1 = " & (5-1)) Call ok(3+5-true = 9, "3+5-true <> 9") Call ok(getVT(2-null) = "VT_NULL", "getVT(2-null) = " & getVT(2-null)) Call ok(2-empty = 2, "2-empty = " & (2-empty)) Call ok(2-x = -1, "2-x = " & (2-x)) Call ok(9 Mod 6 = 3, "9 Mod 6 = " & (9 Mod 6)) Call ok(11.6 Mod 5.5 = False, "11.6 Mod 5.5 = " & (11.6 Mod 5.5 = 0.6)) Call ok(7 Mod 4+2 = 5, "7 Mod 4+2 <> 5") Call ok(getVT(2 mod null) = "VT_NULL", "getVT(2 mod null) = " & getVT(2 mod null)) Call ok(getVT(null mod 2) = "VT_NULL", "getVT(null mod 2) = " & getVT(null mod 2)) 'FIXME: Call ok(empty mod 2 = 0, "empty mod 2 = " & (empty mod 2)) Call ok(5 \ 2 = 2, "5 \ 2 = " & (5\2)) Call ok(4.6 \ 1.5 = 2, "4.6 \ 1.5 = " & (4.6\1.5)) Call ok(4.6 \ 1.49 = 5, "4.6 \ 1.49 = " & (4.6\1.49)) Call ok(2+3\4 = 2, "2+3\4 = " & (2+3\4)) Call ok(2*3 = 6, "2*3 = " & (2*3)) Call ok(3/2 = 1.5, "3/2 = " & (3/2)) Call ok(5\4/2 = 2, "5\4/2 = " & (5\2/1)) Call ok(12/3\2 = 2, "12/3\2 = " & (12/3\2)) Call ok(5/1000000 = 0.000005, "5/1000000 = " & (5/1000000)) Call ok(2^3 = 8, "2^3 = " & (2^3)) Call ok(2^3^2 = 64, "2^3^2 = " & (2^3^2)) Call ok(-3^2 = 9, "-3^2 = " & (-3^2)) Call ok(2*3^2 = 18, "2*3^2 = " & (2*3^2)) x =_ 3 x _ = 3 x = 3 if true then y = true : x = y ok x, "x is false" x = true : if false then x = false ok x, "x is false, if false called?" if not false then x = true ok x, "x is false, if not false not called?" if not false then x = "test" : x = true ok x, "x is false, if not false not called?" if false then x = y : call ok(false, "if false .. : called") if false then x = y : call ok(false, "if false .. : called") else x = "else" Call ok(x = "else", "else not called?") if true then x = y else y = x : Call ok(false, "in else?") if false then : if false then x = y : if true then call ok(false, "embedded if called") if false then x=1 else x=2 end if if true then x=1 end if x = false if false then x = true : x = true Call ok(x = false, "x <> false") if false then ok false, "if false called" end if x = true if x then x = false end if Call ok(not x, "x is false, if not evaluated?") x = false If false Then Call ok(false, "inside if false") Else x = true End If Call ok(x, "else not called?") x = false If false Then Call ok(false, "inside if false") ElseIf not True Then Call ok(false, "inside elseif not true") Else x = true End If Call ok(x, "else not called?") x = false If false Then Call ok(false, "inside if false") x = 1 y = 10+x ElseIf not False Then x = true Else Call ok(false, "inside else not true") End If Call ok(x, "elseif not called?") x = false If false Then Call ok(false, "inside if false") ElseIf not False Then x = true End If Call ok(x, "elseif not called?") x = false if 1 then x = true Call ok(x, "if 1 not run?") x = false if &h10000& then x = true Call ok(x, "if &h10000& not run?") x = false y = false while not (x and y) if x then y = true end if x = true wend call ok((x and y), "x or y is false after while") if false then ' empty body end if if false then x = false elseif true then ' empty body end if if false then x = false else ' empty body end if while false wend x = 0 WHILE x < 3 : x = x + 1 Wend Call ok(x = 3, "x not equal to 3") z = 2 while z > -4 : z = z -2 wend x = false y = false do while not (x and y) if x then y = true end if x = true loop call ok((x and y), "x or y is false after while") do while false loop do while true exit do ok false, "exit do didn't work" loop x = 0 Do While x < 2 : x = x + 1 Loop Call ok(x = 2, "x not equal to 2") x = 0 Do While x >= -2 : x = x - 1 Loop Call ok(x = -3, "x not equal to -3") x = false y = false do until x and y if x then y = true end if x = true loop call ok((x and y), "x or y is false after do until") do until true loop do until false exit do ok false, "exit do didn't work" loop x = 0 Do: :: x = x + 2 Loop Until x = 4 Call ok(x = 4, "x not equal to 4") x = 5 Do: : : x = x * 2 Loop Until x = 40 Call ok(x = 40, "x not equal to 40") x = false do if x then exit do x = true loop call ok(x, "x is false after do..loop?") x = 0 Do :If x = 6 Then Exit Do End If x = x + 3 Loop Call ok(x = 6, "x not equal to 6") x = false y = false do if x then y = true end if x = true loop until x and y call ok((x and y), "x or y is false after while") do loop until true do exit do ok false, "exit do didn't work" loop until false x = false y = false do if x then y = true end if x = true loop while not (x and y) call ok((x and y), "x or y is false after while") do loop while false do exit do ok false, "exit do didn't work" loop while true y = "for1:" for x = 5 to 8 y = y & " " & x next Call ok(y = "for1: 5 6 7 8", "y = " & y) y = "for2:" for x = 5 to 8 step 2 y = y & " " & x next Call ok(y = "for2: 5 7", "y = " & y) y = "for3:" x = 2 for x = x+3 to 8 y = y & " " & x next Call ok(y = "for3: 5 6 7 8", "y = " & y) y = "for4:" for x = 5 to 4 y = y & " " & x next Call ok(y = "for4:", "y = " & y) y = "for5:" for x = 5 to 3 step true y = y & " " & x next Call ok(y = "for5: 5 4 3", "y = " & y) y = "for6:" z = 4 for x = 5 to z step 3-4 y = y & " " & x z = 0 next Call ok(y = "for6: 5 4", "y = " & y) y = "for7:" z = 1 for x = 5 to 8 step z y = y & " " & x z = 2 next Call ok(y = "for7: 5 6 7 8", "y = " & y) z = 0 For x = 10 To 18 Step 2 : : z = z + 1 Next Call ok(z = 5, "z not equal to 5") y = "for8:" for x = 5 to 8 y = y & " " & x x = x+1 next Call ok(y = "for8: 5 7", "y = " & y) for x = 1.5 to 1 Call ok(false, "for..to called when unexpected") next for x = 1 to 100 exit for Call ok(false, "exit for not escaped the loop?") next for x = 1 to 5 : : : :exit for Call ok(false, "exit for not escaped the loop?") next do while true for x = 1 to 100 exit do next loop if null then call ok(false, "if null evaluated") while null call ok(false, "while null evaluated") wend Call collectionObj.reset() y = 0 for each x in collectionObj : :y = y + 3 next Call ok(y = 9, "y = " & y) Call collectionObj.reset() y = 0 x = 10 z = 0 for each x in collectionObj : z = z + 2 y = y+1 Call ok(x = y, "x <> y") next Call ok(y = 3, "y = " & y) Call ok(z = 6, "z = " & z) Call ok(getVT(x) = "VT_EMPTY*", "getVT(x) = " & getVT(x)) Call collectionObj.reset() y = false for each x in collectionObj if x = 2 then exit for y = 1 next Call ok(y = 1, "y = " & y) Call ok(x = 2, "x = " & x) Set obj = collectionObj Call obj.reset() y = 0 x = 10 for each x in obj y = y+1 Call ok(x = y, "x <> y") next Call ok(y = 3, "y = " & y) Call ok(getVT(x) = "VT_EMPTY*", "getVT(x) = " & getVT(x)) x = false select case 3 case 2 Call ok(false, "unexpected case") case 2 Call ok(false, "unexpected case") case 4 Call ok(false, "unexpected case") case "test" case "another case" Call ok(false, "unexpected case") case 0, false, 2+1, 10 x = true case ok(false, "unexpected case") Call ok(false, "unexpected case") case else Call ok(false, "unexpected case") end select Call ok(x, "wrong case") x = false select case 3 case 3 x = true end select Call ok(x, "wrong case") x = false select case 2+2 case 3 Call ok(false, "unexpected case") case else x = true end select Call ok(x, "wrong case") y = "3" x = false select case y case "3" x = true case 3 Call ok(false, "unexpected case") end select Call ok(x, "wrong case") select case 0 case 1 Call ok(false, "unexpected case") case "2" Call ok(false, "unexpected case") end select select case 0 end select x = false select case 2 case 3,1,2,4: x = true case 5,6,7 Call ok(false, "unexpected case") end select Call ok(x, "wrong case") x = false select case 2: case 5,6,7: Call ok(false, "unexpected case") case 2,1,2,4 x = true case else: Call ok(false, "unexpected case else") end select Call ok(x, "wrong case") x = False select case 1 : :case 3, 4 : case 5 : Call ok(false, "unexpected case") : Case Else: x = True end select Call ok(x, "wrong case") if false then Sub testsub x = true End Sub end if x = false Call testsub Call ok(x, "x is false, testsub not called?") Sub SubSetTrue(v) Call ok(not v, "v is not true") v = true End Sub x = false SubSetTrue x Call ok(x, "x was not set by SubSetTrue") SubSetTrue false Call ok(not false, "false is no longer false?") Sub SubSetTrue2(ByRef v) Call ok(not v, "v is not true") v = true End Sub x = false SubSetTrue2 x Call ok(x, "x was not set by SubSetTrue") Sub TestSubArgVal(ByVal v) Call ok(not v, "v is not false") v = true Call ok(v, "v is not true?") End Sub x = false Call TestSubArgVal(x) Call ok(not x, "x is true after TestSubArgVal call?") Sub TestSubMultiArgs(a,b,c,d,e) Call ok(a=1, "a = " & a) Call ok(b=2, "b = " & b) Call ok(c=3, "c = " & c) Call ok(d=4, "d = " & d) Call ok(e=5, "e = " & e) End Sub Sub TestSubExit(ByRef a) If a Then Exit Sub End If Call ok(false, "Exit Sub not called?") End Sub Call TestSubExit(true) Sub TestSubExit2 for x = 1 to 100 Exit Sub next End Sub Call TestSubExit2 TestSubMultiArgs 1, 2, 3, 4, 5 Call TestSubMultiArgs(1, 2, 3, 4, 5) Sub TestSubLocalVal x = false Call ok(not x, "local x is not false?") Dim x Dim a,b, c End Sub x = true y = true Call TestSubLocalVal Call ok(x, "global x is not true?") Public Sub TestPublicSub End Sub Call TestPublicSub Private Sub TestPrivateSub End Sub Call TestPrivateSub Public Sub TestSeparatorSub : : : End Sub Call TestSeparatorSub if false then Function testfunc x = true End Function end if x = false Call TestFunc Call ok(x, "x is false, testfunc not called?") Function FuncSetTrue(v) Call ok(not v, "v is not true") v = true End Function x = false FuncSetTrue x Call ok(x, "x was not set by FuncSetTrue") FuncSetTrue false Call ok(not false, "false is no longer false?") Function FuncSetTrue2(ByRef v) Call ok(not v, "v is not true") v = true End Function x = false FuncSetTrue2 x Call ok(x, "x was not set by FuncSetTrue") Function TestFuncArgVal(ByVal v) Call ok(not v, "v is not false") v = true Call ok(v, "v is not true?") End Function x = false Call TestFuncArgVal(x) Call ok(not x, "x is true after TestFuncArgVal call?") Function TestFuncMultiArgs(a,b,c,d,e) Call ok(a=1, "a = " & a) Call ok(b=2, "b = " & b) Call ok(c=3, "c = " & c) Call ok(d=4, "d = " & d) Call ok(e=5, "e = " & e) End Function TestFuncMultiArgs 1, 2, 3, 4, 5 Call TestFuncMultiArgs(1, 2, 3, 4, 5) Function TestFuncLocalVal x = false Call ok(not x, "local x is not false?") Dim x End Function x = true y = true Call TestFuncLocalVal Call ok(x, "global x is not true?") Function TestFuncExit(ByRef a) If a Then Exit Function End If Call ok(false, "Exit Function not called?") End Function Call TestFuncExit(true) Function TestFuncExit2(ByRef a) For x = 1 to 100 For y = 1 to 100 Exit Function Next Next Call ok(false, "Exit Function not called?") End Function Call TestFuncExit2(true) Sub SubParseTest End Sub : x = false Call SubParseTest Function FuncParseTest End Function : x = false Function ReturnTrue ReturnTrue = false ReturnTrue = true End Function Call ok(ReturnTrue(), "ReturnTrue returned false?") Function SetVal(ByRef x, ByVal v) x = v SetVal = x Exit Function End Function x = false ok SetVal(x, true), "SetVal returned false?" Call ok(x, "x is not set to true by SetVal?") Public Function TestPublicFunc End Function Call TestPublicFunc Private Function TestPrivateFunc End Function Call TestPrivateFunc Public Function TestSepFunc(ByVal a) : : : TestSepFunc = a End Function Call ok(TestSepFunc(1) = 1, "Function did not return 1") ' Stop has an effect only in debugging mode Stop set x = testObj Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x=testObj) = " & getVT(x)) Set obj = New EmptyClass Call ok(getVT(obj) = "VT_DISPATCH*", "getVT(obj) = " & getVT(obj)) Class EmptyClass End Class Set x = obj Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x) = " & getVT(x)) Class TestClass Public publicProp Private privateProp Public Function publicFunction() privateSub() publicFunction = 4 End Function Public Property Get gsProp() gsProp = privateProp funcCalled = "gsProp get" exit property Call ok(false, "exit property not returned?") End Property Public Default Property Get DefValGet DefValGet = privateProp funcCalled = "GetDefVal" End Property Public Property Let DefValGet(x) End Property Public publicProp2 Public Sub publicSub End Sub Public Property Let gsProp(val) privateProp = val funcCalled = "gsProp let" exit property Call ok(false, "exit property not returned?") End Property Public Property Set gsProp(val) funcCalled = "gsProp set" exit property Call ok(false, "exit property not returned?") End Property Public Sub setPrivateProp(x) privateProp = x End Sub Function getPrivateProp getPrivateProp = privateProp End Function Private Sub privateSub End Sub Public Sub Class_Initialize publicProp2 = 2 privateProp = true Call ok(getVT(privateProp) = "VT_BOOL*", "getVT(privateProp) = " & getVT(privateProp)) Call ok(getVT(publicProp2) = "VT_I2*", "getVT(publicProp2) = " & getVT(publicProp2)) Call ok(getVT(Me.publicProp2) = "VT_I2", "getVT(Me.publicProp2) = " & getVT(Me.publicProp2)) End Sub Property Get gsGetProp(x) gsGetProp = x End Property End Class Call testDisp(new testClass) Set obj = New TestClass Call ok(obj.publicFunction = 4, "obj.publicFunction = " & obj.publicFunction) Call ok(obj.publicFunction() = 4, "obj.publicFunction() = " & obj.publicFunction()) obj.publicSub() Call obj.publicSub Call obj.publicFunction() Call ok(getVT(obj.publicProp) = "VT_EMPTY", "getVT(obj.publicProp) = " & getVT(obj.publicProp)) obj.publicProp = 3 Call ok(getVT(obj.publicProp) = "VT_I2", "getVT(obj.publicProp) = " & getVT(obj.publicProp)) Call ok(obj.publicProp = 3, "obj.publicProp = " & obj.publicProp) obj.publicProp() = 3 Call ok(obj.getPrivateProp() = true, "obj.getPrivateProp() = " & obj.getPrivateProp()) Call obj.setPrivateProp(6) Call ok(obj.getPrivateProp = 6, "obj.getPrivateProp = " & obj.getPrivateProp) Dim funcCalled funcCalled = "" Call ok(obj.gsProp = 6, "obj.gsProp = " & obj.gsProp) Call ok(funcCalled = "gsProp get", "funcCalled = " & funcCalled) obj.gsProp = 3 Call ok(funcCalled = "gsProp let", "funcCalled = " & funcCalled) Call ok(obj.getPrivateProp = 3, "obj.getPrivateProp = " & obj.getPrivateProp) Set obj.gsProp = New testclass Call ok(funcCalled = "gsProp set", "funcCalled = " & funcCalled) x = obj Call ok(x = 3, "(x = obj) = " & x) Call ok(funcCalled = "GetDefVal", "funcCalled = " & funcCalled) funcCalled = "" Call ok(obj = 3, "(x = obj) = " & obj) Call ok(funcCalled = "GetDefVal", "funcCalled = " & funcCalled) Call obj.Class_Initialize Call ok(obj.getPrivateProp() = true, "obj.getPrivateProp() = " & obj.getPrivateProp()) x = (New testclass).publicProp Class TermTest Public Sub Class_Terminate() funcCalled = "terminate" End Sub End Class Set obj = New TermTest funcCalled = "" Set obj = Nothing Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled) Set obj = New TermTest funcCalled = "" Call obj.Class_Terminate Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled) funcCalled = "" Set obj = Nothing Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled) Call (New testclass).publicSub() Call (New testclass).publicSub class PropTest property get prop0() prop0 = 1 end property property get prop1(x) prop1 = x+1 end property property get prop2(x, y) prop2 = x+y end property end class set obj = new PropTest call ok(obj.prop0 = 1, "obj.prop0 = " & obj.prop0) call ok(obj.prop1(3) = 4, "obj.prop1(3) = " & obj.prop1(3)) call ok(obj.prop2(3,4) = 7, "obj.prop2(3,4) = " & obj.prop2(3,4)) call obj.prop0() call obj.prop1(2) call obj.prop2(3,4) x = "following ':' is correct syntax" : x = "following ':' is correct syntax" :: : :: x = "also correct syntax" rem another ugly way for comments x = "rem as simplestatement" : rem rem comment : Set obj = new EmptyClass Set x = obj Set y = new EmptyClass Call ok(obj is x, "obj is not x") Call ok(x is obj, "x is not obj") Call ok(not (obj is y), "obj is not y") Call ok(not obj is y, "obj is not y") Call ok(not (x is Nothing), "x is 1") Call ok(Nothing is Nothing, "Nothing is not Nothing") Call ok(x is obj and true, "x is obj and true is false") Class TestMe Public Sub Test(MyMe) Call ok(Me is MyMe, "Me is not MyMe") End Sub End Class Set obj = New TestMe Call obj.test(obj) Call ok(getVT(test) = "VT_DISPATCH", "getVT(test) = " & getVT(test)) Call ok(Me is Test, "Me is not Test") Const c1 = 1, c2 = 2, c3 = -3 Call ok(c1 = 1, "c1 = " & c1) Call ok(getVT(c1) = "VT_I2", "getVT(c1) = " & getVT(c1)) Call ok(c3 = -3, "c3 = " & c3) Call ok(getVT(c3) = "VT_I2", "getVT(c3) = " & getVT(c3)) Const cb = True, cs = "test", cnull = null Call ok(cb, "cb = " & cb) Call ok(getVT(cb) = "VT_BOOL", "getVT(cb) = " & getVT(cb)) Call ok(cs = "test", "cs = " & cs) Call ok(getVT(cs) = "VT_BSTR", "getVT(cs) = " & getVT(cs)) Call ok(isNull(cnull), "cnull = " & cnull) Call ok(getVT(cnull) = "VT_NULL", "getVT(cnull) = " & getVT(cnull)) if false then Const conststr = "str" Call ok(conststr = "str", "conststr = " & conststr) Call ok(getVT(conststr) = "VT_BSTR", "getVT(conststr) = " & getVT(conststr)) Call ok(conststr = "str", "conststr = " & conststr) Sub ConstTestSub Const funcconst = 1 Call ok(c1 = 1, "c1 = " & c1) Call ok(funcconst = 1, "funcconst = " & funcconst) End Sub Call ConstTestSub Dim funcconst ' Property may be used as an identifier (although it's a keyword) Sub TestProperty Dim Property PROPERTY = true Call ok(property, "property = " & property) for property = 1 to 2 next End Sub Call TestProperty Class Property Public Sub Property() End Sub Sub Test(byref property) End Sub End Class Class Property2 Function Property() End Function Sub Test(property) End Sub Sub Test2(byval property) End Sub End Class Class SeparatorTest : : Dim varTest1 : Private Sub Class_Initialize : varTest1 = 1 End Sub :: Property Get Test1() : Test1 = varTest1 End Property :: : : Property Let Test1(a) : varTest1 = a End Property : Public Function AddToTest1(ByVal a) :: : varTest1 = varTest1 + a AddToTest1 = varTest1 End Function : End Class : :: Set obj = New SeparatorTest Call ok(obj.Test1 = 1, "obj.Test1 is not 1") obj.Test1 = 6 Call ok(obj.Test1 = 6, "obj.Test1 is not 6") obj.AddToTest1(5) Call ok(obj.Test1 = 11, "obj.Test1 is not 11") ' Array tests Call ok(getVT(arr) = "VT_EMPTY*", "getVT(arr) = " & getVT(arr)) Dim arr(3) Dim arr2(4,3), arr3(5,4,3), arr0(0), noarr() Call ok(getVT(arr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr) = " & getVT(arr)) Call ok(getVT(arr2) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr2) = " & getVT(arr2)) Call ok(getVT(arr0) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr0) = " & getVT(arr0)) Call ok(getVT(noarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(noarr) = " & getVT(noarr)) Call testArray(1, arr) Call testArray(2, arr2) Call testArray(3, arr3) Call testArray(0, arr0) Call testArray(-1, noarr) Call ok(getVT(arr(1)) = "VT_EMPTY*", "getVT(arr(1)) = " & getVT(arr(1))) Call ok(getVT(arr2(1,2)) = "VT_EMPTY*", "getVT(arr2(1,2)) = " & getVT(arr2(1,2))) Call ok(getVT(arr3(1,2,2)) = "VT_EMPTY*", "getVT(arr3(1,2,3)) = " & getVT(arr3(1,2,2))) Call ok(getVT(arr(0)) = "VT_EMPTY*", "getVT(arr(0)) = " & getVT(arr(0))) Call ok(getVT(arr(3)) = "VT_EMPTY*", "getVT(arr(3)) = " & getVT(arr(3))) Call ok(getVT(arr0(0)) = "VT_EMPTY*", "getVT(arr0(0)) = " & getVT(arr0(0))) arr(2) = 3 Call ok(arr(2) = 3, "arr(2) = " & arr(2)) Call ok(getVT(arr(2)) = "VT_I2*", "getVT(arr(2)) = " & getVT(arr(2))) arr3(3,2,1) = 1 arr3(1,2,3) = 2 Call ok(arr3(3,2,1) = 1, "arr3(3,2,1) = " & arr3(3,2,1)) Call ok(arr3(1,2,3) = 2, "arr3(1,2,3) = " & arr3(1,2,3)) arr2(4,3) = 1 Call ok(arr2(4,3) = 1, "arr2(4,3) = " & arr2(4,3)) x = arr3 Call ok(x(3,2,1) = 1, "x(3,2,1) = " & x(3,2,1)) Function getarr() Dim arr(3) arr(2) = 2 getarr = arr arr(3) = 3 End Function x = getarr() Call ok(getVT(x) = "VT_ARRAY|VT_VARIANT*", "getVT(x) = " & getVT(x)) Call ok(x(2) = 2, "x(2) = " & x(2)) Call ok(getVT(x(3)) = "VT_EMPTY*", "getVT(x(3)) = " & getVT(x(3))) x(1) = 1 Call ok(x(1) = 1, "x(1) = " & x(1)) x = getarr() Call ok(getVT(x(1)) = "VT_EMPTY*", "getVT(x(1)) = " & getVT(x(1))) Call ok(x(2) = 2, "x(2) = " & x(2)) x(1) = 1 y = x x(1) = 2 Call ok(y(1) = 1, "y(1) = " & y(1)) for x=1 to 1 Dim forarr(3) if x=1 then Call ok(getVT(forarr(1)) = "VT_EMPTY*", "getVT(forarr(1)) = " & getVT(forarr(1))) else Call ok(forarr(1) = x, "forarr(1) = " & forarr(1)) end if forarr(1) = x+1 next x=1 Call ok(forarr(x) = 2, "forarr(x) = " & forarr(x)) Class ArrClass Dim classarr(3) Dim classnoarr() Dim var Private Sub Class_Initialize Call ok(getVT(classarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(classarr) = " & getVT(classarr)) Call testArray(-1, classnoarr) classarr(0) = 1 classarr(1) = 2 classarr(2) = 3 classarr(3) = 4 End Sub Public Sub testVarVT Call ok(getVT(var) = "VT_ARRAY|VT_VARIANT*", "getVT(var) = " & getVT(var)) End Sub End Class Set obj = new ArrClass Call ok(getVT(obj.classarr) = "VT_ARRAY|VT_VARIANT", "getVT(obj.classarr) = " & getVT(obj.classarr)) 'todo_wine Call ok(obj.classarr(1) = 2, "obj.classarr(1) = " & obj.classarr(1)) obj.var = arr Call ok(getVT(obj.var) = "VT_ARRAY|VT_VARIANT", "getVT(obj.var) = " & getVT(obj.var)) Call obj.testVarVT Sub arrarg(byref refarr, byval valarr, byref refarr2, byval valarr2) Call ok(getVT(refarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(refarr) = " & getVT(refarr)) Call ok(getVT(valarr) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr) = " & getVT(valarr)) Call ok(getVT(refarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(refarr2) = " & getVT(refarr2)) Call ok(getVT(valarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr2) = " & getVT(valarr2)) End Sub Call arrarg(arr, arr, obj.classarr, obj.classarr) Sub arrarg2(byref refarr(), byval valarr(), byref refarr2(), byval valarr2()) Call ok(getVT(refarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(refarr) = " & getVT(refarr)) Call ok(getVT(valarr) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr) = " & getVT(valarr)) Call ok(getVT(refarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(refarr2) = " & getVT(refarr2)) Call ok(getVT(valarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr2) = " & getVT(valarr2)) End Sub Call arrarg2(arr, arr, obj.classarr, obj.classarr) Sub testarrarg(arg(), vt) Call ok(getVT(arg) = vt, "getVT() = " & getVT(arg) & " expected " & vt) End Sub Call testarrarg(1, "VT_I2*") Call testarrarg(false, "VT_BOOL*") Call testarrarg(Empty, "VT_EMPTY*") Sub modifyarr(arr) 'Following test crashes on wine 'Call ok(arr(0) = "not modified", "arr(0) = " & arr(0)) arr(0) = "modified" End Sub arr(0) = "not modified" Call modifyarr(arr) Call ok(arr(0) = "modified", "arr(0) = " & arr(0)) arr(0) = "not modified" modifyarr(arr) Call todo_wine_ok(arr(0) = "not modified", "arr(0) = " & arr(0)) for x = 0 to UBound(arr) arr(x) = x next y = 0 for each x in arr Call ok(x = y, "x = " & x & ", expected " & y) Call ok(arr(y) = y, "arr(" & y & ") = " & arr(y)) arr(y) = 1 x = 1 y = y+1 next Call ok(y = 4, "y = " & y & " after array enumeration") for x=0 to UBound(arr2, 1) for y=0 to UBound(arr2, 2) arr2(x, y) = x + y*(UBound(arr2, 1)+1) next next y = 0 for each x in arr2 Call ok(x = y, "x = " & x & ", expected " & y) y = y+1 next Call ok(y = 20, "y = " & y & " after array enumeration") for each x in noarr Call ok(false, "Empty array contains: " & x) next ' It's allowed to declare non-builtin RegExp class... class RegExp public property get Global() Call ok(false, "Global called") Global = "fail" end property end class ' ...but there is no way to use it because builtin instance is always created set x = new RegExp Call ok(x.Global = false, "x.Global = " & x.Global) sub test_identifiers ' test keywords that can also be a declared identifier Dim default default = "xx" Call ok(default = "xx", "default = " & default & " expected ""xx""") Dim error error = "xx" Call ok(error = "xx", "error = " & error & " expected ""xx""") Dim explicit explicit = "xx" Call ok(explicit = "xx", "explicit = " & explicit & " expected ""xx""") Dim step step = "xx" Call ok(step = "xx", "step = " & step & " expected ""xx""") end sub call test_identifiers() sub test_dotIdentifiers ' test keywords that can also be an indentifier after a dot ' Call ok(testObj.rem = 10, "testObj.rem = " & testObj.rem & " expected 10") Call ok(testObj.true = 10, "testObj.true = " & testObj.true & " expected 10") Call ok(testObj.false = 10, "testObj.false = " & testObj.false & " expected 10") Call ok(testObj.not = 10, "testObj.not = " & testObj.not & " expected 10") Call ok(testObj.and = 10, "testObj.and = " & testObj.and & " expected 10") Call ok(testObj.or = 10, "testObj.or = " & testObj.or & " expected 10") Call ok(testObj.xor = 10, "testObj.xor = " & testObj.xor & " expected 10") Call ok(testObj.eqv = 10, "testObj.eqv = " & testObj.eqv & " expected 10") Call ok(testObj.imp = 10, "testObj.imp = " & testObj.imp & " expected 10") Call ok(testObj.is = 10, "testObj.is = " & testObj.is & " expected 10") Call ok(testObj.mod = 10, "testObj.mod = " & testObj.mod & " expected 10") Call ok(testObj.call = 10, "testObj.call = " & testObj.call & " expected 10") Call ok(testObj.dim = 10, "testObj.dim = " & testObj.dim & " expected 10") Call ok(testObj.sub = 10, "testObj.sub = " & testObj.sub & " expected 10") Call ok(testObj.function = 10, "testObj.function = " & testObj.function & " expected 10") Call ok(testObj.get = 10, "testObj.get = " & testObj.get & " expected 10") Call ok(testObj.let = 10, "testObj.let = " & testObj.let & " expected 10") Call ok(testObj.const = 10, "testObj.const = " & testObj.const & " expected 10") Call ok(testObj.if = 10, "testObj.if = " & testObj.if & " expected 10") Call ok(testObj.else = 10, "testObj.else = " & testObj.else & " expected 10") Call ok(testObj.elseif = 10, "testObj.elseif = " & testObj.elseif & " expected 10") Call ok(testObj.end = 10, "testObj.end = " & testObj.end & " expected 10") Call ok(testObj.then = 10, "testObj.then = " & testObj.then & " expected 10") Call ok(testObj.exit = 10, "testObj.exit = " & testObj.exit & " expected 10") Call ok(testObj.while = 10, "testObj.while = " & testObj.while & " expected 10") Call ok(testObj.wend = 10, "testObj.wend = " & testObj.wend & " expected 10") Call ok(testObj.do = 10, "testObj.do = " & testObj.do & " expected 10") Call ok(testObj.loop = 10, "testObj.loop = " & testObj.loop & " expected 10") Call ok(testObj.until = 10, "testObj.until = " & testObj.until & " expected 10") Call ok(testObj.for = 10, "testObj.for = " & testObj.for & " expected 10") Call ok(testObj.to = 10, "testObj.to = " & testObj.to & " expected 10") Call ok(testObj.each = 10, "testObj.each = " & testObj.each & " expected 10") Call ok(testObj.in = 10, "testObj.in = " & testObj.in & " expected 10") Call ok(testObj.select = 10, "testObj.select = " & testObj.select & " expected 10") Call ok(testObj.case = 10, "testObj.case = " & testObj.case & " expected 10") Call ok(testObj.byref = 10, "testObj.byref = " & testObj.byref & " expected 10") Call ok(testObj.byval = 10, "testObj.byval = " & testObj.byval & " expected 10") Call ok(testObj.option = 10, "testObj.option = " & testObj.option & " expected 10") Call ok(testObj.nothing = 10, "testObj.nothing = " & testObj.nothing & " expected 10") Call ok(testObj.empty = 10, "testObj.empty = " & testObj.empty & " expected 10") Call ok(testObj.null = 10, "testObj.null = " & testObj.null & " expected 10") Call ok(testObj.class = 10, "testObj.class = " & testObj.class & " expected 10") Call ok(testObj.set = 10, "testObj.set = " & testObj.set & " expected 10") Call ok(testObj.new = 10, "testObj.new = " & testObj.new & " expected 10") Call ok(testObj.public = 10, "testObj.public = " & testObj.public & " expected 10") Call ok(testObj.private = 10, "testObj.private = " & testObj.private & " expected 10") Call ok(testObj.next = 10, "testObj.next = " & testObj.next & " expected 10") Call ok(testObj.on = 10, "testObj.on = " & testObj.on & " expected 10") Call ok(testObj.resume = 10, "testObj.resume = " & testObj.resume & " expected 10") Call ok(testObj.goto = 10, "testObj.goto = " & testObj.goto & " expected 10") end sub call test_dotIdentifiers reportSuccess()