1'
2' Copyright 2011 Jacek Caban for CodeWeavers
3'
4' This library is free software; you can redistribute it and/or
5' modify it under the terms of the GNU Lesser General Public
6' License as published by the Free Software Foundation; either
7' version 2.1 of the License, or (at your option) any later version.
8'
9' This library is distributed in the hope that it will be useful,
10' but WITHOUT ANY WARRANTY; without even the implied warranty of
11' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12' Lesser General Public License for more details.
13'
14' You should have received a copy of the GNU Lesser General Public
15' License along with this library; if not, write to the Free Software
16' Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17'
18
19OPTION EXPLICIT  : : DIM W
20
21dim x, y, z
22Dim obj
23
24call ok(true, "true is not true?")
25ok true, "true is not true?"
26call ok((true), "true is not true?")
27
28ok not false, "not false but not true?"
29ok not not true, "not not true but not true?"
30
31Call ok(true = true, "true = true is false")
32Call ok(false = false, "false = false is false")
33Call ok(not (true = false), "true = false is true")
34Call ok("x" = "x", """x"" = ""x"" is false")
35Call ok(empty = empty, "empty = empty is false")
36Call ok(empty = "", "empty = """" is false")
37Call ok(0 = 0.0, "0 <> 0.0")
38Call ok(16 = &h10&, "16 <> &h10&")
39Call ok(010 = 10, "010 <> 10")
40Call ok(10. = 10, "10. <> 10")
41Call ok(&hffFFffFF& = -1, "&hffFFffFF& <> -1")
42Call ok(&hffFFffFF& = -1, "&hffFFffFF& <> -1")
43Call ok(34e5 = 3400000, "34e5 <> 3400000")
44Call ok(56.789e5 = 5678900, "56.789e5 = 5678900")
45Call ok(56.789e-2 = 0.56789, "56.789e-2 <> 0.56789")
46Call ok(1e-94938484 = 0, "1e-... <> 0")
47Call ok(34e0 = 34, "34e0 <> 34")
48Call ok(34E1 = 340, "34E0 <> 340")
49Call ok(--1 = 1, "--1 = " & --1)
50Call ok(-empty = 0, "-empty = " & (-empty))
51Call ok(true = -1, "! true = -1")
52Call ok(false = 0, "false <> 0")
53Call ok(&hff = 255, "&hff <> 255")
54Call ok(&Hff = 255, "&Hff <> 255")
55
56W = 5
57Call ok(W = 5, "W = " & W & " expected " & 5)
58
59x = "xx"
60Call ok(x = "xx", "x = " & x & " expected ""xx""")
61
62Call ok(true <> false, "true <> false is false")
63Call ok(not (true <> true), "true <> true is true")
64Call ok(not ("x" <> "x"), """x"" <> ""x"" is true")
65Call ok(not (empty <> empty), "empty <> empty is true")
66Call ok(x <> "x", "x = ""x""")
67Call ok("true" <> true, """true"" = true is true")
68
69Call ok("" = true = false, """"" = true = false is false")
70Call ok(not(false = true = ""), "false = true = """" is true")
71Call ok(not (false = false <> false = false), "false = false <> false = false is true")
72Call ok(not ("" <> false = false), """"" <> false = false is true")
73
74Call ok(getVT(false) = "VT_BOOL", "getVT(false) is not VT_BOOL")
75Call ok(getVT(true) = "VT_BOOL", "getVT(true) is not VT_BOOL")
76Call ok(getVT("") = "VT_BSTR", "getVT("""") is not VT_BSTR")
77Call ok(getVT("test") = "VT_BSTR", "getVT(""test"") is not VT_BSTR")
78Call ok(getVT(Empty) = "VT_EMPTY", "getVT(Empty) is not VT_EMPTY")
79Call ok(getVT(null) = "VT_NULL", "getVT(null) is not VT_NULL")
80Call ok(getVT(0) = "VT_I2", "getVT(0) is not VT_I2")
81Call ok(getVT(1) = "VT_I2", "getVT(1) is not VT_I2")
82Call ok(getVT(0.5) = "VT_R8", "getVT(0.5) is not VT_R8")
83Call ok(getVT(0.0) = "VT_R8", "getVT(0.0) is not VT_R8")
84Call ok(getVT(2147483647) = "VT_I4", "getVT(2147483647) is not VT_I4")
85Call ok(getVT(2147483648) = "VT_R8", "getVT(2147483648) is not VT_R8")
86Call ok(getVT(&h10&) = "VT_I2", "getVT(&h10&) is not VT_I2")
87Call ok(getVT(&h10000&) = "VT_I4", "getVT(&h10000&) is not VT_I4")
88Call ok(getVT(&H10000&) = "VT_I4", "getVT(&H10000&) is not VT_I4")
89Call ok(getVT(&hffFFffFF&) = "VT_I2", "getVT(&hffFFffFF&) is not VT_I2")
90Call ok(getVT(1e2) = "VT_R8", "getVT(1e2) is not VT_R8")
91Call ok(getVT(1e0) = "VT_R8", "getVT(1e0) is not VT_R8")
92Call ok(getVT(0.1e2) = "VT_R8", "getVT(0.1e2) is not VT_R8")
93Call ok(getVT(1 & 100000) = "VT_BSTR", "getVT(1 & 100000) is not VT_BSTR")
94Call ok(getVT(-empty) = "VT_I2", "getVT(-empty) = " & getVT(-empty))
95Call ok(getVT(-null) = "VT_NULL", "getVT(-null) = " & getVT(-null))
96Call ok(getVT(y) = "VT_EMPTY*", "getVT(y) = " & getVT(y))
97Call ok(getVT(nothing) = "VT_DISPATCH", "getVT(nothing) = " & getVT(nothing))
98set x = nothing
99Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x=nothing) = " & getVT(x))
100x = true
101Call ok(getVT(x) = "VT_BOOL*", "getVT(x) = " & getVT(x))
102Call ok(getVT(false or true) = "VT_BOOL", "getVT(false) is not VT_BOOL")
103x = "x"
104Call ok(getVT(x) = "VT_BSTR*", "getVT(x) is not VT_BSTR*")
105x = 0.0
106Call ok(getVT(x) = "VT_R8*", "getVT(x) = " & getVT(x))
107
108Call ok(isNullDisp(nothing), "nothing is not nulldisp?")
109
110x = "xx"
111Call ok("ab" & "cd" = "abcd", """ab"" & ""cd"" <> ""abcd""")
112Call ok("ab " & null = "ab ", """ab"" & null = " & ("ab " & null))
113Call ok("ab " & empty = "ab ", """ab"" & empty = " & ("ab " & empty))
114Call ok(1 & 100000 = "1100000", "1 & 100000 = " & (1 & 100000))
115Call ok("ab" & x = "abxx", """ab"" & x = " & ("ab"&x))
116
117if(isEnglishLang) then
118    Call ok("" & true = "True", """"" & true = " & true)
119    Call ok(true & false = "TrueFalse", "true & false = " & (true & false))
120end if
121
122call ok(true and true, "true and true is not true")
123call ok(true and not false, "true and not false is not true")
124call ok(not (false and true), "not (false and true) is not true")
125call ok(getVT(null and true) = "VT_NULL", "getVT(null and true) = " & getVT(null and true))
126
127call ok(false or true, "false or uie is false?")
128call ok(not (false or false), "false or false is not false?")
129call ok(false and false or true, "false and false or true is false?")
130call ok(true or false and false, "true or false and false is false?")
131call ok(null or true, "null or true is false")
132
133call ok(true xor false, "true xor false is false?")
134call ok(not (false xor false), "false xor false is true?")
135call ok(not (true or false xor true), "true or false xor true is true?")
136call ok(not (true xor false or true), "true xor false or true is true?")
137
138call ok(false eqv false, "false does not equal false?")
139call ok(not (false eqv true), "false equals true?")
140call ok(getVT(false eqv null) = "VT_NULL", "getVT(false eqv null) = " & getVT(false eqv null))
141
142call ok(true imp true, "true does not imp true?")
143call ok(false imp false, "false does not imp false?")
144call ok(not (true imp false), "true imp false?")
145call ok(false imp null, "false imp null is false?")
146
147Call ok(2 >= 1, "! 2 >= 1")
148Call ok(2 >= 2, "! 2 >= 2")
149Call ok(not(true >= 2), "true >= 2 ?")
150Call ok(2 > 1, "! 2 > 1")
151Call ok(false > true, "! false < true")
152Call ok(0 > true, "! 0 > true")
153Call ok(not (true > 0), "true > 0")
154Call ok(not (0 > 1 = 1), "0 > 1 = 1")
155Call ok(1 < 2, "! 1 < 2")
156Call ok(1 = 1 < 0, "! 1 = 1 < 0")
157Call ok(1 <= 2, "! 1 <= 2")
158Call ok(2 <= 2, "! 2 <= 2")
159
160Call ok(isNull(0 = null), "'(0 = null)' is not null")
161Call ok(isNull(null = 1), "'(null = 1)' is not null")
162Call ok(isNull(0 > null), "'(0 > null)' is not null")
163Call ok(isNull(null > 1), "'(null > 1)' is not null")
164Call ok(isNull(0 < null), "'(0 < null)' is not null")
165Call ok(isNull(null < 1), "'(null < 1)' is not null")
166Call ok(isNull(0 <> null), "'(0 <> null)' is not null")
167Call ok(isNull(null <> 1), "'(null <> 1)' is not null")
168Call ok(isNull(0 >= null), "'(0 >= null)' is not null")
169Call ok(isNull(null >= 1), "'(null >= 1)' is not null")
170Call ok(isNull(0 <= null), "'(0 <= null)' is not null")
171Call ok(isNull(null <= 1), "'(null <= 1)' is not null")
172
173x = 3
174Call ok(2+2 = 4, "2+2 = " & (2+2))
175Call ok(false + 6 + true = 5, "false + 6 + true <> 5")
176Call ok(getVT(2+null) = "VT_NULL", "getVT(2+null) = " & getVT(2+null))
177Call ok(2+empty = 2, "2+empty = " & (2+empty))
178Call ok(x+x = 6, "x+x = " & (x+x))
179
180Call ok(5-1 = 4, "5-1 = " & (5-1))
181Call ok(3+5-true = 9, "3+5-true <> 9")
182Call ok(getVT(2-null) = "VT_NULL", "getVT(2-null) = " & getVT(2-null))
183Call ok(2-empty = 2, "2-empty = " & (2-empty))
184Call ok(2-x = -1, "2-x = " & (2-x))
185
186Call ok(9 Mod 6 = 3, "9 Mod 6 = " & (9 Mod 6))
187Call ok(11.6 Mod 5.5 = False, "11.6 Mod 5.5 = " & (11.6 Mod 5.5 = 0.6))
188Call ok(7 Mod 4+2 = 5, "7 Mod 4+2 <> 5")
189Call ok(getVT(2 mod null) = "VT_NULL", "getVT(2 mod null) = " & getVT(2 mod null))
190Call ok(getVT(null mod 2) = "VT_NULL", "getVT(null mod 2) = " & getVT(null mod 2))
191'FIXME: Call ok(empty mod 2 = 0, "empty mod 2 = " & (empty mod 2))
192
193Call ok(5 \ 2 = 2, "5 \ 2 = " & (5\2))
194Call ok(4.6 \ 1.5 = 2, "4.6 \ 1.5 = " & (4.6\1.5))
195Call ok(4.6 \ 1.49 = 5, "4.6 \ 1.49 = " & (4.6\1.49))
196Call ok(2+3\4 = 2, "2+3\4 = " & (2+3\4))
197
198Call ok(2*3 = 6, "2*3 = " & (2*3))
199Call ok(3/2 = 1.5, "3/2 = " & (3/2))
200Call ok(5\4/2 = 2, "5\4/2 = " & (5\2/1))
201Call ok(12/3\2 = 2, "12/3\2 = " & (12/3\2))
202Call ok(5/1000000 = 0.000005, "5/1000000 = " & (5/1000000))
203
204Call ok(2^3 = 8, "2^3 = " & (2^3))
205Call ok(2^3^2 = 64, "2^3^2 = " & (2^3^2))
206Call ok(-3^2 = 9, "-3^2 = " & (-3^2))
207Call ok(2*3^2 = 18, "2*3^2 = " & (2*3^2))
208
209x =_
210    3
211x _
212    = 3
213
214x = 3
215
216if true then y = true : x = y
217ok x, "x is false"
218
219x = true : if false then x = false
220ok x, "x is false, if false called?"
221
222if not false then x = true
223ok x, "x is false, if not false not called?"
224
225if not false then x = "test" : x = true
226ok x, "x is false, if not false not called?"
227
228if false then x = y : call ok(false, "if false .. : called")
229
230if false then x = y : call ok(false, "if false .. : called") else x = "else"
231Call ok(x = "else", "else not called?")
232
233if true then x = y else y = x : Call ok(false, "in else?")
234
235if false then :
236
237if false then x = y : if true then call ok(false, "embedded if called")
238
239if false then x=1 else x=2 end if
240if true then x=1 end if
241
242x = false
243if false then x = true : x = true
244Call ok(x = false, "x <> false")
245
246if false then
247    ok false, "if false called"
248end if
249
250x = true
251if x then
252    x = false
253end if
254Call ok(not x, "x is false, if not evaluated?")
255
256x = false
257If false Then
258   Call ok(false, "inside if false")
259Else
260   x = true
261End If
262Call ok(x, "else not called?")
263
264x = false
265If false Then
266   Call ok(false, "inside if false")
267ElseIf not True Then
268   Call ok(false, "inside elseif not true")
269Else
270   x = true
271End If
272Call ok(x, "else not called?")
273
274x = false
275If false Then
276   Call ok(false, "inside if false")
277   x = 1
278   y = 10+x
279ElseIf not False Then
280   x = true
281Else
282   Call ok(false, "inside else not true")
283End If
284Call ok(x, "elseif not called?")
285
286x = false
287If false Then
288   Call ok(false, "inside if false")
289ElseIf not False Then
290   x = true
291End If
292Call ok(x, "elseif not called?")
293
294x = false
295if 1 then x = true
296Call ok(x, "if 1 not run?")
297
298x = false
299if &h10000& then x = true
300Call ok(x, "if &h10000& not run?")
301
302x = false
303y = false
304while not (x and y)
305    if x then
306        y = true
307    end if
308    x = true
309wend
310call ok((x and y), "x or y is false after while")
311
312if false then
313' empty body
314end if
315
316if false then
317    x = false
318elseif true then
319' empty body
320end if
321
322if false then
323    x = false
324else
325' empty body
326end if
327
328while false
329wend
330
331x = 0
332WHILE x < 3 : x = x + 1
333Wend
334Call ok(x = 3, "x not equal to 3")
335
336z = 2
337while z > -4 :
338
339
340z = z -2
341wend
342
343x = false
344y = false
345do while not (x and y)
346    if x then
347        y = true
348    end if
349    x = true
350loop
351call ok((x and y), "x or y is false after while")
352
353do while false
354loop
355
356do while true
357    exit do
358    ok false, "exit do didn't work"
359loop
360
361x = 0
362Do While x < 2 : x = x + 1
363Loop
364Call ok(x = 2, "x not equal to 2")
365
366x = 0
367Do While x >= -2 :
368x = x - 1
369Loop
370Call ok(x = -3, "x not equal to -3")
371
372x = false
373y = false
374do until x and y
375    if x then
376        y = true
377    end if
378    x = true
379loop
380call ok((x and y), "x or y is false after do until")
381
382do until true
383loop
384
385do until false
386    exit do
387    ok false, "exit do didn't work"
388loop
389
390x = 0
391Do: :: x = x + 2
392Loop Until x = 4
393Call ok(x = 4, "x not equal to 4")
394
395x = 5
396Do: :
397
398: x = x * 2
399Loop Until x = 40
400Call ok(x = 40, "x not equal to 40")
401
402
403x = false
404do
405    if x then exit do
406    x = true
407loop
408call ok(x, "x is false after do..loop?")
409
410x = 0
411Do :If x = 6 Then
412        Exit Do
413    End If
414    x = x + 3
415Loop
416Call ok(x = 6, "x not equal to 6")
417
418x = false
419y = false
420do
421    if x then
422        y = true
423    end if
424    x = true
425loop until x and y
426call ok((x and y), "x or y is false after while")
427
428do
429loop until true
430
431do
432    exit do
433    ok false, "exit do didn't work"
434loop until false
435
436x = false
437y = false
438do
439    if x then
440        y = true
441    end if
442    x = true
443loop while not (x and y)
444call ok((x and y), "x or y is false after while")
445
446do
447loop while false
448
449do
450    exit do
451    ok false, "exit do didn't work"
452loop while true
453
454y = "for1:"
455for x = 5 to 8
456    y = y & " " & x
457next
458Call ok(y = "for1: 5 6 7 8", "y = " & y)
459
460y = "for2:"
461for x = 5 to 8 step 2
462    y = y & " " & x
463next
464Call ok(y = "for2: 5 7", "y = " & y)
465
466y = "for3:"
467x = 2
468for x = x+3 to 8
469    y = y & " " & x
470next
471Call ok(y = "for3: 5 6 7 8", "y = " & y)
472
473y = "for4:"
474for x = 5 to 4
475    y = y & " " & x
476next
477Call ok(y = "for4:", "y = " & y)
478
479y = "for5:"
480for x = 5 to 3 step true
481    y = y & " " & x
482next
483Call ok(y = "for5: 5 4 3", "y = " & y)
484
485y = "for6:"
486z = 4
487for x = 5 to z step 3-4
488    y = y & " " & x
489    z = 0
490next
491Call ok(y = "for6: 5 4", "y = " & y)
492
493y = "for7:"
494z = 1
495for x = 5 to 8 step z
496    y = y & " " & x
497    z = 2
498next
499Call ok(y = "for7: 5 6 7 8", "y = " & y)
500
501z = 0
502For x = 10 To 18 Step 2 : : z = z + 1
503Next
504Call ok(z = 5, "z not equal to 5")
505
506y = "for8:"
507for x = 5 to 8
508    y = y & " " & x
509    x = x+1
510next
511Call ok(y = "for8: 5 7", "y = " & y)
512
513for x = 1.5 to 1
514    Call ok(false, "for..to called when unexpected")
515next
516
517for x = 1 to 100
518    exit for
519    Call ok(false, "exit for not escaped the loop?")
520next
521
522for x = 1 to 5 :
523:
524:   :exit for
525    Call ok(false, "exit for not escaped the loop?")
526next
527
528do while true
529    for x = 1 to 100
530        exit do
531    next
532loop
533
534if null then call ok(false, "if null evaluated")
535
536while null
537    call ok(false, "while null evaluated")
538wend
539
540Call collectionObj.reset()
541y = 0
542for each x in collectionObj :
543
544   :y = y + 3
545next
546Call ok(y = 9, "y = " & y)
547
548Call collectionObj.reset()
549y = 0
550x = 10
551z = 0
552for each x in collectionObj : z = z + 2
553    y = y+1
554    Call ok(x = y, "x <> y")
555next
556Call ok(y = 3, "y = " & y)
557Call ok(z = 6, "z = " & z)
558Call ok(getVT(x) = "VT_EMPTY*", "getVT(x) = " & getVT(x))
559
560Call collectionObj.reset()
561y = false
562for each x in collectionObj
563    if x = 2 then exit for
564    y = 1
565next
566Call ok(y = 1, "y = " & y)
567Call ok(x = 2, "x = " & x)
568
569Set obj = collectionObj
570Call obj.reset()
571y = 0
572x = 10
573for each x in obj
574    y = y+1
575    Call ok(x = y, "x <> y")
576next
577Call ok(y = 3, "y = " & y)
578Call ok(getVT(x) = "VT_EMPTY*", "getVT(x) = " & getVT(x))
579
580x = false
581select case 3
582    case 2
583        Call ok(false, "unexpected case")
584    case 2
585        Call ok(false, "unexpected case")
586    case 4
587        Call ok(false, "unexpected case")
588    case "test"
589    case "another case"
590        Call ok(false, "unexpected case")
591    case 0, false, 2+1, 10
592        x = true
593    case ok(false, "unexpected case")
594        Call ok(false, "unexpected case")
595    case else
596        Call ok(false, "unexpected case")
597end select
598Call ok(x, "wrong case")
599
600x = false
601select case 3
602    case 3
603        x = true
604end select
605Call ok(x, "wrong case")
606
607x = false
608select case 2+2
609    case 3
610        Call ok(false, "unexpected case")
611    case else
612        x = true
613end select
614Call ok(x, "wrong case")
615
616y = "3"
617x = false
618select case y
619    case "3"
620        x = true
621    case 3
622        Call ok(false, "unexpected case")
623end select
624Call ok(x, "wrong case")
625
626select case 0
627    case 1
628        Call ok(false, "unexpected case")
629    case "2"
630        Call ok(false, "unexpected case")
631end select
632
633select case 0
634end select
635
636x = false
637select case 2
638    case 3,1,2,4: x = true
639    case 5,6,7
640        Call ok(false, "unexpected case")
641end select
642Call ok(x, "wrong case")
643
644x = false
645select case 2: case 5,6,7: Call ok(false, "unexpected case")
646    case 2,1,2,4
647        x = true
648    case else: Call ok(false, "unexpected case else")
649end select
650Call ok(x, "wrong case")
651
652x = False
653select case 1  :
654
655    :case 3, 4 :
656
657
658    case 5
659:
660        Call ok(false, "unexpected case") :
661    Case Else:
662
663        x = True
664end select
665Call ok(x, "wrong case")
666
667if false then
668Sub testsub
669    x = true
670End Sub
671end if
672
673x = false
674Call testsub
675Call ok(x, "x is false, testsub not called?")
676
677Sub SubSetTrue(v)
678    Call ok(not v, "v is not true")
679    v = true
680End Sub
681
682x = false
683SubSetTrue x
684Call ok(x, "x was not set by SubSetTrue")
685
686SubSetTrue false
687Call ok(not false, "false is no longer false?")
688
689Sub SubSetTrue2(ByRef v)
690    Call ok(not v, "v is not true")
691    v = true
692End Sub
693
694x = false
695SubSetTrue2 x
696Call ok(x, "x was not set by SubSetTrue")
697
698Sub TestSubArgVal(ByVal v)
699    Call ok(not v, "v is not false")
700    v = true
701    Call ok(v, "v is not true?")
702End Sub
703
704x = false
705Call TestSubArgVal(x)
706Call ok(not x, "x is true after TestSubArgVal call?")
707
708Sub TestSubMultiArgs(a,b,c,d,e)
709    Call ok(a=1, "a = " & a)
710    Call ok(b=2, "b = " & b)
711    Call ok(c=3, "c = " & c)
712    Call ok(d=4, "d = " & d)
713    Call ok(e=5, "e = " & e)
714End Sub
715
716Sub TestSubExit(ByRef a)
717    If a Then
718        Exit Sub
719    End If
720    Call ok(false, "Exit Sub not called?")
721End Sub
722
723Call TestSubExit(true)
724
725Sub TestSubExit2
726    for x = 1 to 100
727        Exit Sub
728    next
729End Sub
730Call TestSubExit2
731
732TestSubMultiArgs 1, 2, 3, 4, 5
733Call TestSubMultiArgs(1, 2, 3, 4, 5)
734
735Sub TestSubLocalVal
736    x = false
737    Call ok(not x, "local x is not false?")
738    Dim x
739    Dim a,b, c
740End Sub
741
742x = true
743y = true
744Call TestSubLocalVal
745Call ok(x, "global x is not true?")
746
747Public Sub TestPublicSub
748End Sub
749Call TestPublicSub
750
751Private Sub TestPrivateSub
752End Sub
753Call TestPrivateSub
754
755Public Sub TestSeparatorSub : :
756:
757End Sub
758Call TestSeparatorSub
759
760if false then
761Function testfunc
762    x = true
763End Function
764end if
765
766x = false
767Call TestFunc
768Call ok(x, "x is false, testfunc not called?")
769
770Function FuncSetTrue(v)
771    Call ok(not v, "v is not true")
772    v = true
773End Function
774
775x = false
776FuncSetTrue x
777Call ok(x, "x was not set by FuncSetTrue")
778
779FuncSetTrue false
780Call ok(not false, "false is no longer false?")
781
782Function FuncSetTrue2(ByRef v)
783    Call ok(not v, "v is not true")
784    v = true
785End Function
786
787x = false
788FuncSetTrue2 x
789Call ok(x, "x was not set by FuncSetTrue")
790
791Function TestFuncArgVal(ByVal v)
792    Call ok(not v, "v is not false")
793    v = true
794    Call ok(v, "v is not true?")
795End Function
796
797x = false
798Call TestFuncArgVal(x)
799Call ok(not x, "x is true after TestFuncArgVal call?")
800
801Function TestFuncMultiArgs(a,b,c,d,e)
802    Call ok(a=1, "a = " & a)
803    Call ok(b=2, "b = " & b)
804    Call ok(c=3, "c = " & c)
805    Call ok(d=4, "d = " & d)
806    Call ok(e=5, "e = " & e)
807End Function
808
809TestFuncMultiArgs 1, 2, 3, 4, 5
810Call TestFuncMultiArgs(1, 2, 3, 4, 5)
811
812Function TestFuncLocalVal
813    x = false
814    Call ok(not x, "local x is not false?")
815    Dim x
816End Function
817
818x = true
819y = true
820Call TestFuncLocalVal
821Call ok(x, "global x is not true?")
822
823Function TestFuncExit(ByRef a)
824    If a Then
825        Exit Function
826    End If
827    Call ok(false, "Exit Function not called?")
828End Function
829
830Call TestFuncExit(true)
831
832Function TestFuncExit2(ByRef a)
833    For x = 1 to 100
834        For y = 1 to 100
835            Exit Function
836        Next
837    Next
838    Call ok(false, "Exit Function not called?")
839End Function
840
841Call TestFuncExit2(true)
842
843Sub SubParseTest
844End Sub : x = false
845Call SubParseTest
846
847Function FuncParseTest
848End Function : x = false
849
850Function ReturnTrue
851     ReturnTrue = false
852     ReturnTrue = true
853End Function
854
855Call ok(ReturnTrue(), "ReturnTrue returned false?")
856
857Function SetVal(ByRef x, ByVal v)
858    x = v
859    SetVal = x
860    Exit Function
861End Function
862
863x = false
864ok SetVal(x, true), "SetVal returned false?"
865Call ok(x, "x is not set to true by SetVal?")
866
867Public Function TestPublicFunc
868End Function
869Call TestPublicFunc
870
871Private Function TestPrivateFunc
872End Function
873Call TestPrivateFunc
874
875Public Function TestSepFunc(ByVal a) : :
876: TestSepFunc = a
877End Function
878Call ok(TestSepFunc(1) = 1, "Function did not return 1")
879
880
881' Stop has an effect only in debugging mode
882Stop
883
884set x = testObj
885Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x=testObj) = " & getVT(x))
886
887Set obj = New EmptyClass
888Call ok(getVT(obj) = "VT_DISPATCH*", "getVT(obj) = " & getVT(obj))
889
890Class EmptyClass
891End Class
892
893Set x = obj
894Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x) = " & getVT(x))
895
896Class TestClass
897    Public publicProp
898
899    Private privateProp
900
901    Public Function publicFunction()
902        privateSub()
903        publicFunction = 4
904    End Function
905
906    Public Property Get gsProp()
907        gsProp = privateProp
908        funcCalled = "gsProp get"
909        exit property
910        Call ok(false, "exit property not returned?")
911    End Property
912
913    Public Default Property Get DefValGet
914        DefValGet = privateProp
915        funcCalled = "GetDefVal"
916    End Property
917
918    Public Property Let DefValGet(x)
919    End Property
920
921    Public publicProp2
922
923    Public Sub publicSub
924    End Sub
925
926    Public Property Let gsProp(val)
927        privateProp = val
928        funcCalled = "gsProp let"
929        exit property
930        Call ok(false, "exit property not returned?")
931    End Property
932
933    Public Property Set gsProp(val)
934        funcCalled = "gsProp set"
935        exit property
936        Call ok(false, "exit property not returned?")
937    End Property
938
939    Public Sub setPrivateProp(x)
940        privateProp = x
941    End Sub
942
943    Function getPrivateProp
944        getPrivateProp = privateProp
945    End Function
946
947    Private Sub privateSub
948    End Sub
949
950    Public Sub Class_Initialize
951        publicProp2 = 2
952        privateProp = true
953        Call ok(getVT(privateProp) = "VT_BOOL*", "getVT(privateProp) = " & getVT(privateProp))
954        Call ok(getVT(publicProp2) = "VT_I2*", "getVT(publicProp2) = " & getVT(publicProp2))
955        Call ok(getVT(Me.publicProp2) = "VT_I2", "getVT(Me.publicProp2) = " & getVT(Me.publicProp2))
956    End Sub
957
958    Property Get gsGetProp(x)
959        gsGetProp = x
960    End Property
961End Class
962
963Call testDisp(new testClass)
964
965Set obj = New TestClass
966
967Call ok(obj.publicFunction = 4, "obj.publicFunction = " & obj.publicFunction)
968Call ok(obj.publicFunction() = 4, "obj.publicFunction() = " & obj.publicFunction())
969
970obj.publicSub()
971Call obj.publicSub
972Call obj.publicFunction()
973
974Call ok(getVT(obj.publicProp) = "VT_EMPTY", "getVT(obj.publicProp) = " & getVT(obj.publicProp))
975obj.publicProp = 3
976Call ok(getVT(obj.publicProp) = "VT_I2", "getVT(obj.publicProp) = " & getVT(obj.publicProp))
977Call ok(obj.publicProp = 3, "obj.publicProp = " & obj.publicProp)
978obj.publicProp() = 3
979
980Call ok(obj.getPrivateProp() = true, "obj.getPrivateProp() = " & obj.getPrivateProp())
981Call obj.setPrivateProp(6)
982Call ok(obj.getPrivateProp = 6, "obj.getPrivateProp = " & obj.getPrivateProp)
983
984Dim funcCalled
985funcCalled = ""
986Call ok(obj.gsProp = 6, "obj.gsProp = " & obj.gsProp)
987Call ok(funcCalled = "gsProp get", "funcCalled = " & funcCalled)
988obj.gsProp = 3
989Call ok(funcCalled = "gsProp let", "funcCalled = " & funcCalled)
990Call ok(obj.getPrivateProp = 3, "obj.getPrivateProp = " & obj.getPrivateProp)
991Set obj.gsProp = New testclass
992Call ok(funcCalled = "gsProp set", "funcCalled = " & funcCalled)
993
994x = obj
995Call ok(x = 3, "(x = obj) = " & x)
996Call ok(funcCalled = "GetDefVal", "funcCalled = " & funcCalled)
997funcCalled = ""
998Call ok(obj = 3, "(x = obj) = " & obj)
999Call ok(funcCalled = "GetDefVal", "funcCalled = " & funcCalled)
1000
1001Call obj.Class_Initialize
1002Call ok(obj.getPrivateProp() = true, "obj.getPrivateProp() = " & obj.getPrivateProp())
1003
1004x = (New testclass).publicProp
1005
1006Class TermTest
1007    Public Sub Class_Terminate()
1008        funcCalled = "terminate"
1009    End Sub
1010End Class
1011
1012Set obj = New TermTest
1013funcCalled = ""
1014Set obj = Nothing
1015Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled)
1016
1017Set obj = New TermTest
1018funcCalled = ""
1019Call obj.Class_Terminate
1020Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled)
1021funcCalled = ""
1022Set obj = Nothing
1023Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled)
1024
1025Call (New testclass).publicSub()
1026Call (New testclass).publicSub
1027
1028class PropTest
1029    property get prop0()
1030        prop0 = 1
1031    end property
1032
1033    property get prop1(x)
1034        prop1 = x+1
1035    end property
1036
1037    property get prop2(x, y)
1038        prop2 = x+y
1039    end property
1040end class
1041
1042set obj = new PropTest
1043
1044call ok(obj.prop0 = 1, "obj.prop0 = " & obj.prop0)
1045call ok(obj.prop1(3) = 4, "obj.prop1(3) = " & obj.prop1(3))
1046call ok(obj.prop2(3,4) = 7, "obj.prop2(3,4) = " & obj.prop2(3,4))
1047call obj.prop0()
1048call obj.prop1(2)
1049call obj.prop2(3,4)
1050
1051x = "following ':' is correct syntax" :
1052x = "following ':' is correct syntax" :: :
1053:: x = "also correct syntax"
1054rem another ugly way for comments
1055x = "rem as simplestatement" : rem rem comment
1056:
1057
1058Set obj = new EmptyClass
1059Set x = obj
1060Set y = new EmptyClass
1061
1062Call ok(obj is x, "obj is not x")
1063Call ok(x is obj, "x is not obj")
1064Call ok(not (obj is y), "obj is not y")
1065Call ok(not obj is y, "obj is not y")
1066Call ok(not (x is Nothing), "x is 1")
1067Call ok(Nothing is Nothing, "Nothing is not Nothing")
1068Call ok(x is obj and true, "x is obj and true is false")
1069
1070Class TestMe
1071    Public Sub Test(MyMe)
1072        Call ok(Me is MyMe, "Me is not MyMe")
1073    End Sub
1074End Class
1075
1076Set obj = New TestMe
1077Call obj.test(obj)
1078
1079Call ok(getVT(test) = "VT_DISPATCH", "getVT(test) = " & getVT(test))
1080Call ok(Me is Test, "Me is not Test")
1081
1082Const c1 = 1, c2 = 2, c3 = -3
1083Call ok(c1 = 1, "c1 = " & c1)
1084Call ok(getVT(c1) = "VT_I2", "getVT(c1) = " & getVT(c1))
1085Call ok(c3 = -3, "c3 = " & c3)
1086Call ok(getVT(c3) = "VT_I2", "getVT(c3) = " & getVT(c3))
1087
1088Const cb = True, cs = "test", cnull = null
1089Call ok(cb, "cb = " & cb)
1090Call ok(getVT(cb) = "VT_BOOL", "getVT(cb) = " & getVT(cb))
1091Call ok(cs = "test", "cs = " & cs)
1092Call ok(getVT(cs) = "VT_BSTR", "getVT(cs) = " & getVT(cs))
1093Call ok(isNull(cnull), "cnull = " & cnull)
1094Call ok(getVT(cnull) = "VT_NULL", "getVT(cnull) = " & getVT(cnull))
1095
1096if false then Const conststr = "str"
1097Call ok(conststr = "str", "conststr = " & conststr)
1098Call ok(getVT(conststr) = "VT_BSTR", "getVT(conststr) = " & getVT(conststr))
1099Call ok(conststr = "str", "conststr = " & conststr)
1100
1101Sub ConstTestSub
1102    Const funcconst = 1
1103    Call ok(c1 = 1, "c1 = " & c1)
1104    Call ok(funcconst = 1, "funcconst = " & funcconst)
1105End Sub
1106
1107Call ConstTestSub
1108Dim funcconst
1109
1110' Property may be used as an identifier (although it's a keyword)
1111Sub TestProperty
1112    Dim Property
1113    PROPERTY = true
1114    Call ok(property, "property = " & property)
1115
1116    for property = 1 to 2
1117    next
1118End Sub
1119
1120Call TestProperty
1121
1122Class Property
1123    Public Sub Property()
1124    End Sub
1125
1126    Sub Test(byref property)
1127    End Sub
1128End Class
1129
1130Class Property2
1131    Function Property()
1132    End Function
1133
1134    Sub Test(property)
1135    End Sub
1136
1137    Sub Test2(byval property)
1138    End Sub
1139End Class
1140
1141Class SeparatorTest : : Dim varTest1
1142:
1143    Private Sub Class_Initialize : varTest1 = 1
1144    End Sub ::
1145
1146    Property Get Test1() :
1147        Test1 = varTest1
1148    End Property ::
1149: :
1150    Property Let Test1(a) :
1151        varTest1 = a
1152    End Property :
1153
1154    Public Function AddToTest1(ByVal a)  :: :
1155        varTest1 = varTest1 + a
1156        AddToTest1 = varTest1
1157    End Function :    End Class : ::   Set obj = New SeparatorTest
1158
1159Call ok(obj.Test1 = 1, "obj.Test1 is not 1")
1160obj.Test1 = 6
1161Call ok(obj.Test1 = 6, "obj.Test1 is not 6")
1162obj.AddToTest1(5)
1163Call ok(obj.Test1 = 11, "obj.Test1 is not 11")
1164
1165' Array tests
1166
1167Call ok(getVT(arr) = "VT_EMPTY*", "getVT(arr) = " & getVT(arr))
1168
1169Dim arr(3)
1170Dim arr2(4,3), arr3(5,4,3), arr0(0), noarr()
1171
1172Call ok(getVT(arr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr) = " & getVT(arr))
1173Call ok(getVT(arr2) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr2) = " & getVT(arr2))
1174Call ok(getVT(arr0) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr0) = " & getVT(arr0))
1175Call ok(getVT(noarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(noarr) = " & getVT(noarr))
1176
1177Call testArray(1, arr)
1178Call testArray(2, arr2)
1179Call testArray(3, arr3)
1180Call testArray(0, arr0)
1181Call testArray(-1, noarr)
1182
1183Call ok(getVT(arr(1)) = "VT_EMPTY*", "getVT(arr(1)) = " & getVT(arr(1)))
1184Call ok(getVT(arr2(1,2)) = "VT_EMPTY*", "getVT(arr2(1,2)) = " & getVT(arr2(1,2)))
1185Call ok(getVT(arr3(1,2,2)) = "VT_EMPTY*", "getVT(arr3(1,2,3)) = " & getVT(arr3(1,2,2)))
1186Call ok(getVT(arr(0)) = "VT_EMPTY*", "getVT(arr(0)) = " & getVT(arr(0)))
1187Call ok(getVT(arr(3)) = "VT_EMPTY*", "getVT(arr(3)) = " & getVT(arr(3)))
1188Call ok(getVT(arr0(0)) = "VT_EMPTY*", "getVT(arr0(0)) = " & getVT(arr0(0)))
1189
1190arr(2) = 3
1191Call ok(arr(2) = 3, "arr(2) = " & arr(2))
1192Call ok(getVT(arr(2)) = "VT_I2*", "getVT(arr(2)) = " & getVT(arr(2)))
1193
1194arr3(3,2,1) = 1
1195arr3(1,2,3) = 2
1196Call ok(arr3(3,2,1) = 1, "arr3(3,2,1) = " & arr3(3,2,1))
1197Call ok(arr3(1,2,3) = 2, "arr3(1,2,3) = " & arr3(1,2,3))
1198arr2(4,3) = 1
1199Call ok(arr2(4,3) = 1, "arr2(4,3) = " & arr2(4,3))
1200
1201x = arr3
1202Call ok(x(3,2,1) = 1, "x(3,2,1) = " & x(3,2,1))
1203
1204Function getarr()
1205    Dim arr(3)
1206    arr(2) = 2
1207    getarr = arr
1208    arr(3) = 3
1209End Function
1210
1211x = getarr()
1212Call ok(getVT(x) = "VT_ARRAY|VT_VARIANT*", "getVT(x) = " & getVT(x))
1213Call ok(x(2) = 2, "x(2) = " & x(2))
1214Call ok(getVT(x(3)) = "VT_EMPTY*", "getVT(x(3)) = " & getVT(x(3)))
1215
1216x(1) = 1
1217Call ok(x(1) = 1, "x(1) = " & x(1))
1218x = getarr()
1219Call ok(getVT(x(1)) = "VT_EMPTY*", "getVT(x(1)) = " & getVT(x(1)))
1220Call ok(x(2) = 2, "x(2) = " & x(2))
1221
1222x(1) = 1
1223y = x
1224x(1) = 2
1225Call ok(y(1) = 1, "y(1) = " & y(1))
1226
1227for x=1 to 1
1228    Dim forarr(3)
1229    if x=1 then
1230        Call ok(getVT(forarr(1)) = "VT_EMPTY*", "getVT(forarr(1)) = " & getVT(forarr(1)))
1231    else
1232        Call ok(forarr(1) = x, "forarr(1) = " & forarr(1))
1233    end if
1234    forarr(1) = x+1
1235next
1236
1237x=1
1238Call ok(forarr(x) = 2, "forarr(x) = " & forarr(x))
1239
1240Class ArrClass
1241    Dim classarr(3)
1242    Dim classnoarr()
1243    Dim var
1244
1245    Private Sub Class_Initialize
1246        Call ok(getVT(classarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(classarr) = " & getVT(classarr))
1247        Call testArray(-1, classnoarr)
1248        classarr(0) = 1
1249        classarr(1) = 2
1250        classarr(2) = 3
1251        classarr(3) = 4
1252    End Sub
1253
1254    Public Sub testVarVT
1255        Call ok(getVT(var) = "VT_ARRAY|VT_VARIANT*", "getVT(var) = " & getVT(var))
1256    End Sub
1257End Class
1258
1259Set obj = new ArrClass
1260Call ok(getVT(obj.classarr) = "VT_ARRAY|VT_VARIANT", "getVT(obj.classarr) = " & getVT(obj.classarr))
1261'todo_wine Call ok(obj.classarr(1) = 2, "obj.classarr(1) = " & obj.classarr(1))
1262
1263obj.var = arr
1264Call ok(getVT(obj.var) = "VT_ARRAY|VT_VARIANT", "getVT(obj.var) = " & getVT(obj.var))
1265Call obj.testVarVT
1266
1267Sub arrarg(byref refarr, byval valarr, byref refarr2, byval valarr2)
1268    Call ok(getVT(refarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(refarr) = " & getVT(refarr))
1269    Call ok(getVT(valarr) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr) = " & getVT(valarr))
1270    Call ok(getVT(refarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(refarr2) = " & getVT(refarr2))
1271    Call ok(getVT(valarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr2) = " & getVT(valarr2))
1272End Sub
1273
1274Call arrarg(arr, arr, obj.classarr, obj.classarr)
1275
1276Sub arrarg2(byref refarr(), byval valarr(), byref refarr2(), byval valarr2())
1277    Call ok(getVT(refarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(refarr) = " & getVT(refarr))
1278    Call ok(getVT(valarr) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr) = " & getVT(valarr))
1279    Call ok(getVT(refarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(refarr2) = " & getVT(refarr2))
1280    Call ok(getVT(valarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr2) = " & getVT(valarr2))
1281End Sub
1282
1283Call arrarg2(arr, arr, obj.classarr, obj.classarr)
1284
1285Sub testarrarg(arg(), vt)
1286    Call ok(getVT(arg) = vt, "getVT() = " & getVT(arg) & " expected " & vt)
1287End Sub
1288
1289Call testarrarg(1, "VT_I2*")
1290Call testarrarg(false, "VT_BOOL*")
1291Call testarrarg(Empty, "VT_EMPTY*")
1292
1293Sub modifyarr(arr)
1294    'Following test crashes on wine
1295    'Call ok(arr(0) = "not modified", "arr(0) = " & arr(0))
1296    arr(0) = "modified"
1297End Sub
1298
1299arr(0) = "not modified"
1300Call modifyarr(arr)
1301Call ok(arr(0) = "modified", "arr(0) = " & arr(0))
1302
1303arr(0) = "not modified"
1304modifyarr(arr)
1305Call todo_wine_ok(arr(0) = "not modified", "arr(0) = " & arr(0))
1306
1307for x = 0 to UBound(arr)
1308    arr(x) = x
1309next
1310y = 0
1311for each x in arr
1312    Call ok(x = y, "x = " & x & ", expected " & y)
1313    Call ok(arr(y) = y, "arr(" & y & ") = " & arr(y))
1314    arr(y) = 1
1315    x = 1
1316    y = y+1
1317next
1318Call ok(y = 4, "y = " & y & " after array enumeration")
1319
1320for x=0 to UBound(arr2, 1)
1321    for y=0 to UBound(arr2, 2)
1322        arr2(x, y) = x + y*(UBound(arr2, 1)+1)
1323    next
1324next
1325y = 0
1326for each x in arr2
1327    Call ok(x = y, "x = " & x & ", expected " & y)
1328    y = y+1
1329next
1330Call ok(y = 20, "y = " & y & " after array enumeration")
1331
1332for each x in noarr
1333    Call ok(false, "Empty array contains: " & x)
1334next
1335
1336' It's allowed to declare non-builtin RegExp class...
1337class RegExp
1338     public property get Global()
1339         Call ok(false, "Global called")
1340         Global = "fail"
1341     end property
1342end class
1343
1344' ...but there is no way to use it because builtin instance is always created
1345set x = new RegExp
1346Call ok(x.Global = false, "x.Global = " & x.Global)
1347
1348reportSuccess()
1349