mfplat: Read queue subscriber within the critical section.
[wine/zf.git] / dlls / vbscript / tests / lang.vbs
bloba716cdbc65f23a44b0bb342118b294fcc7ad5c5b
2 ' Copyright 2011 Jacek Caban for CodeWeavers
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.
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.
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
19 OPTION EXPLICIT : : DIM W
21 dim x, y, z, e
22 Dim obj
24 call ok(true, "true is not true?")
25 ok true, "true is not true?"
26 call ok((true), "true is not true?")
28 ok not false, "not false but not true?"
29 ok not not true, "not not true but not true?"
31 Call ok(true = true, "true = true is false")
32 Call ok(false = false, "false = false is false")
33 Call ok(not (true = false), "true = false is true")
34 Call ok("x" = "x", """x"" = ""x"" is false")
35 Call ok(empty = empty, "empty = empty is false")
36 Call ok(empty = "", "empty = """" is false")
37 Call ok(0 = 0.0, "0 <> 0.0")
38 Call ok(16 = &h10&, "16 <> &h10&")
39 Call ok(010 = 10, "010 <> 10")
40 Call ok(10. = 10, "10. <> 10")
41 Call ok(&hffFFffFF& = -1, "&hffFFffFF& <> -1")
42 Call ok(&hffFFffFF& = -1, "&hffFFffFF& <> -1")
43 Call ok(34e5 = 3400000, "34e5 <> 3400000")
44 Call ok(34e+5 = 3400000, "34e+5 <> 3400000")
45 Call ok(56.789e5 = 5678900, "56.789e5 = 5678900")
46 Call ok(56.789e-2 = 0.56789, "56.789e-2 <> 0.56789")
47 Call ok(1e-94938484 = 0, "1e-... <> 0")
48 Call ok(34e0 = 34, "34e0 <> 34")
49 Call ok(34E1 = 340, "34E0 <> 340")
50 Call ok(.5 = 0.5, ".5 <> 0.5")
51 Call ok(.5e1 = 5, ".5e1 <> 5")
52 Call ok(--1 = 1, "--1 = " & --1)
53 Call ok(-empty = 0, "-empty = " & (-empty))
54 Call ok(true = -1, "! true = -1")
55 Call ok(false = 0, "false <> 0")
56 Call ok(&hff = 255, "&hff <> 255")
57 Call ok(&Hff = 255, "&Hff <> 255")
58 Call ok(&hffff = -1, "&hffff <> -1")
59 Call ok(&hfffe = -2, "&hfffe <> -2")
60 Call ok(&hffff& = 65535, "&hffff& <> -1")
61 Call ok(&hfffe& = 65534, "&hfffe& <> -2")
62 Call ok(&hffffffff& = -1, "&hffffffff& <> -1")
63 Call ok((&h01or&h02)=3,"&h01or&h02 <> 3")
65 W = 5
66 Call ok(W = 5, "W = " & W & " expected " & 5)
68 x = "xx"
69 Call ok(x = "xx", "x = " & x & " expected ""xx""")
71 Dim public1 : public1 = 42
72 Call ok(public1 = 42, "public1=" & public1 & " expected & " & 42)
73 Private priv1 : priv1 = 43
74 Call ok(priv1 = 43, "priv1=" & priv1 & " expected & " & 43)
75 Public pub1 : pub1 = 44
76 Call ok(pub1 = 44, "pub1=" & pub1 & " expected & " & 44)
78 Call ok(true <> false, "true <> false is false")
79 Call ok(not (true <> true), "true <> true is true")
80 Call ok(not ("x" <> "x"), """x"" <> ""x"" is true")
81 Call ok(not (empty <> empty), "empty <> empty is true")
82 Call ok(x <> "x", "x = ""x""")
83 Call ok("true" <> true, """true"" = true is true")
85 Call ok("" = true = false, """"" = true = false is false")
86 Call ok(not(false = true = ""), "false = true = """" is true")
87 Call ok(not (false = false <> false = false), "false = false <> false = false is true")
88 Call ok(not ("" <> false = false), """"" <> false = false is true")
90 Call ok(getVT(false) = "VT_BOOL", "getVT(false) is not VT_BOOL")
91 Call ok(getVT(true) = "VT_BOOL", "getVT(true) is not VT_BOOL")
92 Call ok(getVT("") = "VT_BSTR", "getVT("""") is not VT_BSTR")
93 Call ok(getVT("test") = "VT_BSTR", "getVT(""test"") is not VT_BSTR")
94 Call ok(getVT(Empty) = "VT_EMPTY", "getVT(Empty) is not VT_EMPTY")
95 Call ok(getVT(null) = "VT_NULL", "getVT(null) is not VT_NULL")
96 Call ok(getVT(0) = "VT_I2", "getVT(0) is not VT_I2")
97 Call ok(getVT(1) = "VT_I2", "getVT(1) is not VT_I2")
98 Call ok(getVT(0.5) = "VT_R8", "getVT(0.5) is not VT_R8")
99 Call ok(getVT(.5) = "VT_R8", "getVT(.5) is not VT_R8")
100 Call ok(getVT(0.0) = "VT_R8", "getVT(0.0) is not VT_R8")
101 Call ok(getVT(2147483647) = "VT_I4", "getVT(2147483647) is not VT_I4")
102 Call ok(getVT(2147483648) = "VT_R8", "getVT(2147483648) is not VT_R8")
103 Call ok(getVT(&h10&) = "VT_I2", "getVT(&h10&) is not VT_I2")
104 Call ok(getVT(&h10000&) = "VT_I4", "getVT(&h10000&) is not VT_I4")
105 Call ok(getVT(&H10000&) = "VT_I4", "getVT(&H10000&) is not VT_I4")
106 Call ok(getVT(&hffFFffFF&) = "VT_I2", "getVT(&hffFFffFF&) is not VT_I2")
107 Call ok(getVT(&hffFFffFE&) = "VT_I2", "getVT(&hffFFffFE &) is not VT_I2")
108 Call ok(getVT(&hffF&) = "VT_I2", "getVT(&hffFF&) is not VT_I2")
109 Call ok(getVT(&hffFF&) = "VT_I4", "getVT(&hffFF&) is not VT_I4")
110 Call ok(getVT(1e2) = "VT_R8", "getVT(1e2) is not VT_R8")
111 Call ok(getVT(1e0) = "VT_R8", "getVT(1e0) is not VT_R8")
112 Call ok(getVT(0.1e2) = "VT_R8", "getVT(0.1e2) is not VT_R8")
113 Call ok(getVT(1 & 100000) = "VT_BSTR", "getVT(1 & 100000) is not VT_BSTR")
114 Call ok(getVT(-empty) = "VT_I2", "getVT(-empty) = " & getVT(-empty))
115 Call ok(getVT(-null) = "VT_NULL", "getVT(-null) = " & getVT(-null))
116 Call ok(getVT(y) = "VT_EMPTY*", "getVT(y) = " & getVT(y))
117 Call ok(getVT(nothing) = "VT_DISPATCH", "getVT(nothing) = " & getVT(nothing))
118 set x = nothing
119 Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x=nothing) = " & getVT(x))
120 x = true
121 Call ok(getVT(x) = "VT_BOOL*", "getVT(x) = " & getVT(x))
122 Call ok(getVT(false or true) = "VT_BOOL", "getVT(false) is not VT_BOOL")
123 x = "x"
124 Call ok(getVT(x) = "VT_BSTR*", "getVT(x) is not VT_BSTR*")
125 x = 0.0
126 Call ok(getVT(x) = "VT_R8*", "getVT(x) = " & getVT(x))
128 Call ok(isNullDisp(nothing), "nothing is not nulldisp?")
130 x = "xx"
131 Call ok("ab" & "cd" = "abcd", """ab"" & ""cd"" <> ""abcd""")
132 Call ok("ab " & null = "ab ", """ab"" & null = " & ("ab " & null))
133 Call ok("ab " & empty = "ab ", """ab"" & empty = " & ("ab " & empty))
134 Call ok(1 & 100000 = "1100000", "1 & 100000 = " & (1 & 100000))
135 Call ok("ab" & x = "abxx", """ab"" & x = " & ("ab"&x))
137 if(isEnglishLang) then
138 Call ok("" & true = "True", """"" & true = " & true)
139 Call ok(true & false = "TrueFalse", "true & false = " & (true & false))
140 end if
142 call ok(true and true, "true and true is not true")
143 call ok(true and not false, "true and not false is not true")
144 call ok(not (false and true), "not (false and true) is not true")
145 call ok(getVT(null and true) = "VT_NULL", "getVT(null and true) = " & getVT(null and true))
147 call ok(false or true, "false or uie is false?")
148 call ok(not (false or false), "false or false is not false?")
149 call ok(false and false or true, "false and false or true is false?")
150 call ok(true or false and false, "true or false and false is false?")
151 call ok(null or true, "null or true is false")
153 call ok(true xor false, "true xor false is false?")
154 call ok(not (false xor false), "false xor false is true?")
155 call ok(not (true or false xor true), "true or false xor true is true?")
156 call ok(not (true xor false or true), "true xor false or true is true?")
158 call ok(false eqv false, "false does not equal false?")
159 call ok(not (false eqv true), "false equals true?")
160 call ok(getVT(false eqv null) = "VT_NULL", "getVT(false eqv null) = " & getVT(false eqv null))
162 call ok(true imp true, "true does not imp true?")
163 call ok(false imp false, "false does not imp false?")
164 call ok(not (true imp false), "true imp false?")
165 call ok(false imp null, "false imp null is false?")
167 Call ok(2 >= 1, "! 2 >= 1")
168 Call ok(2 >= 2, "! 2 >= 2")
169 Call ok(not(true >= 2), "true >= 2 ?")
170 Call ok(2 > 1, "! 2 > 1")
171 Call ok(false > true, "! false < true")
172 Call ok(0 > true, "! 0 > true")
173 Call ok(not (true > 0), "true > 0")
174 Call ok(not (0 > 1 = 1), "0 > 1 = 1")
175 Call ok(1 < 2, "! 1 < 2")
176 Call ok(1 = 1 < 0, "! 1 = 1 < 0")
177 Call ok(1 <= 2, "! 1 <= 2")
178 Call ok(2 <= 2, "! 2 <= 2")
180 Call ok(isNull(0 = null), "'(0 = null)' is not null")
181 Call ok(isNull(null = 1), "'(null = 1)' is not null")
182 Call ok(isNull(0 > null), "'(0 > null)' is not null")
183 Call ok(isNull(null > 1), "'(null > 1)' is not null")
184 Call ok(isNull(0 < null), "'(0 < null)' is not null")
185 Call ok(isNull(null < 1), "'(null < 1)' is not null")
186 Call ok(isNull(0 <> null), "'(0 <> null)' is not null")
187 Call ok(isNull(null <> 1), "'(null <> 1)' is not null")
188 Call ok(isNull(0 >= null), "'(0 >= null)' is not null")
189 Call ok(isNull(null >= 1), "'(null >= 1)' is not null")
190 Call ok(isNull(0 <= null), "'(0 <= null)' is not null")
191 Call ok(isNull(null <= 1), "'(null <= 1)' is not null")
193 x = 3
194 Call ok(2+2 = 4, "2+2 = " & (2+2))
195 Call ok(false + 6 + true = 5, "false + 6 + true <> 5")
196 Call ok(getVT(2+null) = "VT_NULL", "getVT(2+null) = " & getVT(2+null))
197 Call ok(2+empty = 2, "2+empty = " & (2+empty))
198 Call ok(x+x = 6, "x+x = " & (x+x))
200 Call ok(5-1 = 4, "5-1 = " & (5-1))
201 Call ok(3+5-true = 9, "3+5-true <> 9")
202 Call ok(getVT(2-null) = "VT_NULL", "getVT(2-null) = " & getVT(2-null))
203 Call ok(2-empty = 2, "2-empty = " & (2-empty))
204 Call ok(2-x = -1, "2-x = " & (2-x))
206 Call ok(9 Mod 6 = 3, "9 Mod 6 = " & (9 Mod 6))
207 Call ok(11.6 Mod 5.5 = False, "11.6 Mod 5.5 = " & (11.6 Mod 5.5 = 0.6))
208 Call ok(7 Mod 4+2 = 5, "7 Mod 4+2 <> 5")
209 Call ok(getVT(2 mod null) = "VT_NULL", "getVT(2 mod null) = " & getVT(2 mod null))
210 Call ok(getVT(null mod 2) = "VT_NULL", "getVT(null mod 2) = " & getVT(null mod 2))
211 'FIXME: Call ok(empty mod 2 = 0, "empty mod 2 = " & (empty mod 2))
213 Call ok(5 \ 2 = 2, "5 \ 2 = " & (5\2))
214 Call ok(4.6 \ 1.5 = 2, "4.6 \ 1.5 = " & (4.6\1.5))
215 Call ok(4.6 \ 1.49 = 5, "4.6 \ 1.49 = " & (4.6\1.49))
216 Call ok(2+3\4 = 2, "2+3\4 = " & (2+3\4))
218 Call ok(2*3 = 6, "2*3 = " & (2*3))
219 Call ok(3/2 = 1.5, "3/2 = " & (3/2))
220 Call ok(5\4/2 = 2, "5\4/2 = " & (5\2/1))
221 Call ok(12/3\2 = 2, "12/3\2 = " & (12/3\2))
222 Call ok(5/1000000 = 0.000005, "5/1000000 = " & (5/1000000))
224 Call ok(2^3 = 8, "2^3 = " & (2^3))
225 Call ok(2^3^2 = 64, "2^3^2 = " & (2^3^2))
226 Call ok(-3^2 = 9, "-3^2 = " & (-3^2))
227 Call ok(2*3^2 = 18, "2*3^2 = " & (2*3^2))
229 x =_
234 x = 3
236 if true then y = true : x = y
237 ok x, "x is false"
239 x = true : if false then x = false
240 ok x, "x is false, if false called?"
242 if not false then x = true
243 ok x, "x is false, if not false not called?"
245 if not false then x = "test" : x = true
246 ok x, "x is false, if not false not called?"
248 if false then x = y : call ok(false, "if false .. : called")
250 if false then x = y : call ok(false, "if false .. : called") else x = "else"
251 Call ok(x = "else", "else not called?")
253 if true then x = y else y = x : Call ok(false, "in else?")
255 if false then :
257 if false then x = y : if true then call ok(false, "embedded if called")
259 if false then x=1 else x=2 end if
260 if true then x=1 end if
262 x = false
263 if false then x = true : x = true
264 Call ok(x = false, "x <> false")
266 if false then
267 ok false, "if false called"
268 end if
270 x = true
271 if x then
272 x = false
273 end if
274 Call ok(not x, "x is false, if not evaluated?")
276 x = false
277 If false Then
278 Call ok(false, "inside if false")
279 Else
280 x = true
281 End If
282 Call ok(x, "else not called?")
284 x = false
285 If false Then
286 Call ok(false, "inside if false")
287 ElseIf not True Then
288 Call ok(false, "inside elseif not true")
289 Else
290 x = true
291 End If
292 Call ok(x, "else not called?")
294 x = false
295 If false Then
296 Call ok(false, "inside if false")
297 x = 1
298 y = 10+x
299 ElseIf not False Then
300 x = true
301 Else
302 Call ok(false, "inside else not true")
303 End If
304 Call ok(x, "elseif not called?")
306 x = false
307 If false Then
308 Call ok(false, "inside if false")
309 ElseIf not False Then
310 x = true
311 End If
312 Call ok(x, "elseif not called?")
314 x = false
315 if 1 then x = true
316 Call ok(x, "if 1 not run?")
318 x = false
319 if &h10000& then x = true
320 Call ok(x, "if &h10000& not run?")
322 x = false
323 y = false
324 while not (x and y)
325 if x then
326 y = true
327 end if
328 x = true
329 wend
330 call ok((x and y), "x or y is false after while")
332 if false then
333 ' empty body
334 end if
336 if false then
337 x = false
338 elseif true then
339 ' empty body
340 end if
342 if false then
343 x = false
344 else
345 ' empty body
346 end if
348 while false
349 wend
351 if empty then
352 ok false, "if empty executed"
353 end if
355 while empty
356 ok false, "while empty executed"
357 wend
359 x = 0
360 WHILE x < 3 : x = x + 1 : Wend
361 Call ok(x = 3, "x not equal to 3")
363 x = 0
364 WHILE x < 3 : x = x + 1
365 Wend
366 Call ok(x = 3, "x not equal to 3")
368 z = 2
369 while z > -4 :
372 z = z -2
373 wend
375 x = false
376 y = false
377 do while not (x and y)
378 if x then
379 y = true
380 end if
381 x = true
382 loop
383 call ok((x and y), "x or y is false after while")
385 do while false
386 loop
388 do while false : loop
390 do while true
391 exit do
392 ok false, "exit do didn't work"
393 loop
395 x = 0
396 Do While x < 2 : x = x + 1
397 Loop
398 Call ok(x = 2, "x not equal to 2")
400 x = 0
401 Do While x < 2 : x = x + 1: Loop
402 Call ok(x = 2, "x not equal to 2")
404 x = 0
405 Do While x >= -2 :
406 x = x - 1
407 Loop
408 Call ok(x = -3, "x not equal to -3")
410 x = false
411 y = false
412 do until x and y
413 if x then
414 y = true
415 end if
416 x = true
417 loop
418 call ok((x and y), "x or y is false after do until")
420 do until true
421 loop
423 do until false
424 exit do
425 ok false, "exit do didn't work"
426 loop
428 x = 0
429 Do: :: x = x + 2
430 Loop Until x = 4
431 Call ok(x = 4, "x not equal to 4")
433 x = 0
434 Do: :: x = x + 2 ::: : Loop Until x = 4
435 Call ok(x = 4, "x not equal to 4")
437 x = 5
438 Do: :
440 : x = x * 2
441 Loop Until x = 40
442 Call ok(x = 40, "x not equal to 40")
445 x = false
447 if x then exit do
448 x = true
449 loop
450 call ok(x, "x is false after do..loop?")
452 x = 0
453 Do :If x = 6 Then
454 Exit Do
455 End If
456 x = x + 3
457 Loop
458 Call ok(x = 6, "x not equal to 6")
460 x = false
461 y = false
463 if x then
464 y = true
465 end if
466 x = true
467 loop until x and y
468 call ok((x and y), "x or y is false after while")
471 loop until true
474 exit do
475 ok false, "exit do didn't work"
476 loop until false
478 x = false
479 y = false
481 if x then
482 y = true
483 end if
484 x = true
485 loop while not (x and y)
486 call ok((x and y), "x or y is false after while")
489 loop while false
492 exit do
493 ok false, "exit do didn't work"
494 loop while true
496 y = "for1:"
497 for x = 5 to 8
498 y = y & " " & x
499 next
500 Call ok(y = "for1: 5 6 7 8", "y = " & y)
502 y = "for2:"
503 for x = 5 to 8 step 2
504 y = y & " " & x
505 next
506 Call ok(y = "for2: 5 7", "y = " & y)
508 y = "for3:"
509 x = 2
510 for x = x+3 to 8
511 y = y & " " & x
512 next
513 Call ok(y = "for3: 5 6 7 8", "y = " & y)
515 y = "for4:"
516 for x = 5 to 4
517 y = y & " " & x
518 next
519 Call ok(y = "for4:", "y = " & y)
521 y = "for5:"
522 for x = 5 to 3 step true
523 y = y & " " & x
524 next
525 Call ok(y = "for5: 5 4 3", "y = " & y)
527 y = "for6:"
528 z = 4
529 for x = 5 to z step 3-4
530 y = y & " " & x
531 z = 0
532 next
533 Call ok(y = "for6: 5 4", "y = " & y)
535 y = "for7:"
536 z = 1
537 for x = 5 to 8 step z
538 y = y & " " & x
539 z = 2
540 next
541 Call ok(y = "for7: 5 6 7 8", "y = " & y)
543 z = 0
544 For x = 10 To 18 Step 2 : : z = z + 1
545 Next
546 Call ok(z = 5, "z not equal to 5")
548 y = "for8:"
549 for x = 5 to 8
550 y = y & " " & x
551 x = x+1
552 next
553 Call ok(y = "for8: 5 7", "y = " & y)
555 for x = 1.5 to 1
556 Call ok(false, "for..to called when unexpected")
557 next
559 for x = 1 to 100
560 exit for
561 Call ok(false, "exit for not escaped the loop?")
562 next
564 for x = 1 to 5 :
566 : :exit for
567 Call ok(false, "exit for not escaped the loop?")
568 next
570 dim a1(8)
571 a1(6)=8
572 for x=1 to 8:a1(x)=x-1:next
573 Call ok(a1(6) = 5, "colon used in for loop")
575 a1(6)=8
576 for x=1 to 8:y=1
577 a1(x)=x-2:next
578 Call ok(a1(6) = 4, "colon used in for loop")
580 do while true
581 for x = 1 to 100
582 exit do
583 next
584 loop
586 if null then call ok(false, "if null evaluated")
588 while null
589 call ok(false, "while null evaluated")
590 wend
592 Call collectionObj.reset()
593 y = 0
594 for each x in collectionObj :
596 :y = y + 3
597 next
598 Call ok(y = 9, "y = " & y)
600 Call collectionObj.reset()
601 y = 0
602 x = 10
603 z = 0
604 for each x in collectionObj : z = z + 2
605 y = y+1
606 Call ok(x = y, "x <> y")
607 next
608 Call ok(y = 3, "y = " & y)
609 Call ok(z = 6, "z = " & z)
610 Call ok(getVT(x) = "VT_EMPTY*", "getVT(x) = " & getVT(x))
612 Call collectionObj.reset()
613 y = 0
614 x = 10
615 z = 0
616 for each x in collectionObj : z = z + 2 : y = y+1 ::
617 Call ok(x = y, "x <> y") : next
618 Call ok(y = 3, "y = " & y)
619 Call ok(z = 6, "z = " & z)
621 Call collectionObj.reset()
622 y = false
623 for each x in collectionObj
624 if x = 2 then exit for
625 y = 1
626 next
627 Call ok(y = 1, "y = " & y)
628 Call ok(x = 2, "x = " & x)
630 Set obj = collectionObj
631 Call obj.reset()
632 y = 0
633 x = 10
634 for each x in obj
635 y = y+1
636 Call ok(x = y, "x <> y")
637 next
638 Call ok(y = 3, "y = " & y)
639 Call ok(getVT(x) = "VT_EMPTY*", "getVT(x) = " & getVT(x))
641 x = false
642 select case 3
643 case 2
644 Call ok(false, "unexpected case")
645 case 2
646 Call ok(false, "unexpected case")
647 case 4
648 Call ok(false, "unexpected case")
649 case "test"
650 case "another case"
651 Call ok(false, "unexpected case")
652 case 0, false, 2+1, 10
653 x = true
654 case ok(false, "unexpected case")
655 Call ok(false, "unexpected case")
656 case else
657 Call ok(false, "unexpected case")
658 end select
659 Call ok(x, "wrong case")
661 x = false
662 select case 3
663 case 3
664 x = true
665 end select
666 Call ok(x, "wrong case")
668 x = false
669 select case 2+2
670 case 3
671 Call ok(false, "unexpected case")
672 case else
673 x = true
674 end select
675 Call ok(x, "wrong case")
677 y = "3"
678 x = false
679 select case y
680 case "3"
681 x = true
682 case 3
683 Call ok(false, "unexpected case")
684 end select
685 Call ok(x, "wrong case")
687 select case 0
688 case 1
689 Call ok(false, "unexpected case")
690 case "2"
691 Call ok(false, "unexpected case")
692 end select
694 select case 0
695 end select
697 x = false
698 select case 2
699 case 3,1,2,4: x = true
700 case 5,6,7
701 Call ok(false, "unexpected case")
702 end select
703 Call ok(x, "wrong case")
705 x = false
706 select case 2: case 5,6,7: Call ok(false, "unexpected case")
707 case 2,1,2,4
708 x = true
709 case else: Call ok(false, "unexpected case else")
710 end select
711 Call ok(x, "wrong case")
713 x = False
714 select case 1 :
716 :case 3, 4 :
719 case 5
721 Call ok(false, "unexpected case") :
722 Case Else:
724 x = True
725 end select
726 Call ok(x, "wrong case")
728 select case 0
729 case 1
730 case else
731 'empty else with comment test
732 end select
734 select case 0 : case 1 : case else : end select
736 if false then
737 Sub testsub
738 x = true
739 End Sub
740 end if
742 x = false
743 Call testsub
744 Call ok(x, "x is false, testsub not called?")
746 Sub SubSetTrue(v)
747 Call ok(not v, "v is not true")
748 v = true
749 End Sub
751 x = false
752 SubSetTrue x
753 Call ok(x, "x was not set by SubSetTrue")
755 SubSetTrue false
756 Call ok(not false, "false is no longer false?")
758 Sub SubSetTrue2(ByRef v)
759 Call ok(not v, "v is not true")
760 v = true
761 End Sub
763 x = false
764 SubSetTrue2 x
765 Call ok(x, "x was not set by SubSetTrue")
767 Sub TestSubArgVal(ByVal v)
768 Call ok(not v, "v is not false")
769 v = true
770 Call ok(v, "v is not true?")
771 End Sub
773 x = false
774 Call TestSubArgVal(x)
775 Call ok(not x, "x is true after TestSubArgVal call?")
777 Sub TestSubMultiArgs(a,b,c,d,e)
778 Call ok(a=1, "a = " & a)
779 Call ok(b=2, "b = " & b)
780 Call ok(c=3, "c = " & c)
781 Call ok(d=4, "d = " & d)
782 Call ok(e=5, "e = " & e)
783 End Sub
785 Sub TestSubExit(ByRef a)
786 If a Then
787 Exit Sub
788 End If
789 Call ok(false, "Exit Sub not called?")
790 End Sub
792 Call TestSubExit(true)
794 Sub TestSubExit2
795 for x = 1 to 100
796 Exit Sub
797 next
798 End Sub
799 Call TestSubExit2
801 TestSubMultiArgs 1, 2, 3, 4, 5
802 Call TestSubMultiArgs(1, 2, 3, 4, 5)
804 Sub TestSubLocalVal
805 x = false
806 Call ok(not x, "local x is not false?")
807 Dim x
808 Dim a,b, c
809 End Sub
811 x = true
812 y = true
813 Call TestSubLocalVal
814 Call ok(x, "global x is not true?")
816 Public Sub TestPublicSub
817 End Sub
818 Call TestPublicSub
820 Private Sub TestPrivateSub
821 End Sub
822 Call TestPrivateSub
824 Public Sub TestSeparatorSub : :
826 End Sub
827 Call TestSeparatorSub
829 if false then
830 Function testfunc
831 x = true
832 End Function
833 end if
835 x = false
836 Call TestFunc
837 Call ok(x, "x is false, testfunc not called?")
839 Function FuncSetTrue(v)
840 Call ok(not v, "v is not true")
841 v = true
842 End Function
844 x = false
845 FuncSetTrue x
846 Call ok(x, "x was not set by FuncSetTrue")
848 FuncSetTrue false
849 Call ok(not false, "false is no longer false?")
851 Function FuncSetTrue2(ByRef v)
852 Call ok(not v, "v is not true")
853 v = true
854 End Function
856 x = false
857 FuncSetTrue2 x
858 Call ok(x, "x was not set by FuncSetTrue")
860 Function TestFuncArgVal(ByVal v)
861 Call ok(not v, "v is not false")
862 v = true
863 Call ok(v, "v is not true?")
864 End Function
866 x = false
867 Call TestFuncArgVal(x)
868 Call ok(not x, "x is true after TestFuncArgVal call?")
870 Function TestFuncMultiArgs(a,b,c,d,e)
871 Call ok(a=1, "a = " & a)
872 Call ok(b=2, "b = " & b)
873 Call ok(c=3, "c = " & c)
874 Call ok(d=4, "d = " & d)
875 Call ok(e=5, "e = " & e)
876 End Function
878 TestFuncMultiArgs 1, 2, 3, 4, 5
879 Call TestFuncMultiArgs(1, 2, 3, 4, 5)
881 Function TestFuncLocalVal
882 x = false
883 Call ok(not x, "local x is not false?")
884 Dim x
885 End Function
887 x = true
888 y = true
889 Call TestFuncLocalVal
890 Call ok(x, "global x is not true?")
892 Function TestFuncExit(ByRef a)
893 If a Then
894 Exit Function
895 End If
896 Call ok(false, "Exit Function not called?")
897 End Function
899 Call TestFuncExit(true)
901 Function TestFuncExit2(ByRef a)
902 For x = 1 to 100
903 For y = 1 to 100
904 Exit Function
905 Next
906 Next
907 Call ok(false, "Exit Function not called?")
908 End Function
910 Call TestFuncExit2(true)
912 Sub SubParseTest
913 End Sub : x = false
914 Call SubParseTest
916 Function FuncParseTest
917 End Function : x = false
919 Function ReturnTrue
920 ReturnTrue = false
921 ReturnTrue = true
922 End Function
924 Call ok(ReturnTrue(), "ReturnTrue returned false?")
926 Function SetVal(ByRef x, ByVal v)
927 x = v
928 SetVal = x
929 Exit Function
930 End Function
932 x = false
933 ok SetVal(x, true), "SetVal returned false?"
934 Call ok(x, "x is not set to true by SetVal?")
936 Public Function TestPublicFunc
937 End Function
938 Call TestPublicFunc
940 Private Function TestPrivateFunc
941 End Function
942 Call TestPrivateFunc
944 Public Function TestSepFunc(ByVal a) : :
945 : TestSepFunc = a
946 End Function
947 Call ok(TestSepFunc(1) = 1, "Function did not return 1")
949 ok duplicatedfunc() = 2, "duplicatedfunc = " & duplicatedfunc()
951 function duplicatedfunc
952 ok false, "duplicatedfunc called"
953 end function
955 sub duplicatedfunc
956 ok false, "duplicatedfunc called"
957 end sub
959 function duplicatedfunc
960 duplicatedfunc = 2
961 end function
963 ok duplicatedfunc() = 2, "duplicatedfunc = " & duplicatedfunc()
965 ' Stop has an effect only in debugging mode
966 Stop
968 set x = testObj
969 Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x=testObj) = " & getVT(x))
971 Set obj = New EmptyClass
972 Call ok(getVT(obj) = "VT_DISPATCH*", "getVT(obj) = " & getVT(obj))
974 Class EmptyClass
975 End Class
977 Set x = obj
978 Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x) = " & getVT(x))
980 Class TestClass
981 Public publicProp
983 Private privateProp
985 Public Function publicFunction()
986 privateSub()
987 publicFunction = 4
988 End Function
990 Public Property Get gsProp()
991 gsProp = privateProp
992 funcCalled = "gsProp get"
993 exit property
994 Call ok(false, "exit property not returned?")
995 End Property
997 Public Default Property Get DefValGet
998 DefValGet = privateProp
999 funcCalled = "GetDefVal"
1000 End Property
1002 Public Property Let DefValGet(x)
1003 End Property
1005 Public publicProp2
1007 Public Sub publicSub
1008 End Sub
1010 Public Property Let gsProp(val)
1011 privateProp = val
1012 funcCalled = "gsProp let"
1013 exit property
1014 Call ok(false, "exit property not returned?")
1015 End Property
1017 Public Property Set gsProp(val)
1018 funcCalled = "gsProp set"
1019 exit property
1020 Call ok(false, "exit property not returned?")
1021 End Property
1023 Public Sub setPrivateProp(x)
1024 privateProp = x
1025 End Sub
1027 Function getPrivateProp
1028 getPrivateProp = privateProp
1029 End Function
1031 Private Sub privateSub
1032 End Sub
1034 Public Sub Class_Initialize
1035 publicProp2 = 2
1036 privateProp = true
1037 Call ok(getVT(privateProp) = "VT_BOOL*", "getVT(privateProp) = " & getVT(privateProp))
1038 Call ok(getVT(publicProp2) = "VT_I2*", "getVT(publicProp2) = " & getVT(publicProp2))
1039 Call ok(getVT(Me.publicProp2) = "VT_I2", "getVT(Me.publicProp2) = " & getVT(Me.publicProp2))
1040 End Sub
1042 Property Get gsGetProp(x)
1043 gsGetProp = x
1044 End Property
1045 End Class
1047 Call testDisp(new testClass)
1049 Set obj = New TestClass
1051 Call ok(obj.publicFunction = 4, "obj.publicFunction = " & obj.publicFunction)
1052 Call ok(obj.publicFunction() = 4, "obj.publicFunction() = " & obj.publicFunction())
1054 obj.publicSub()
1055 Call obj.publicSub
1056 Call obj.publicFunction()
1058 Call ok(getVT(obj.publicProp) = "VT_EMPTY", "getVT(obj.publicProp) = " & getVT(obj.publicProp))
1059 obj.publicProp = 3
1060 Call ok(getVT(obj.publicProp) = "VT_I2", "getVT(obj.publicProp) = " & getVT(obj.publicProp))
1061 Call ok(obj.publicProp = 3, "obj.publicProp = " & obj.publicProp)
1062 obj.publicProp() = 3
1064 Call ok(obj.getPrivateProp() = true, "obj.getPrivateProp() = " & obj.getPrivateProp())
1065 Call obj.setPrivateProp(6)
1066 Call ok(obj.getPrivateProp = 6, "obj.getPrivateProp = " & obj.getPrivateProp)
1068 Dim funcCalled
1069 funcCalled = ""
1070 Call ok(obj.gsProp = 6, "obj.gsProp = " & obj.gsProp)
1071 Call ok(funcCalled = "gsProp get", "funcCalled = " & funcCalled)
1072 obj.gsProp = 3
1073 Call ok(funcCalled = "gsProp let", "funcCalled = " & funcCalled)
1074 Call ok(obj.getPrivateProp = 3, "obj.getPrivateProp = " & obj.getPrivateProp)
1075 Set obj.gsProp = New testclass
1076 Call ok(funcCalled = "gsProp set", "funcCalled = " & funcCalled)
1078 x = obj
1079 Call ok(x = 3, "(x = obj) = " & x)
1080 Call ok(funcCalled = "GetDefVal", "funcCalled = " & funcCalled)
1081 funcCalled = ""
1082 Call ok(obj = 3, "(x = obj) = " & obj)
1083 Call ok(funcCalled = "GetDefVal", "funcCalled = " & funcCalled)
1085 Call obj.Class_Initialize
1086 Call ok(obj.getPrivateProp() = true, "obj.getPrivateProp() = " & obj.getPrivateProp())
1088 x = (New testclass).publicProp
1090 Class TermTest
1091 Public Sub Class_Terminate()
1092 funcCalled = "terminate"
1093 End Sub
1094 End Class
1096 Set obj = New TermTest
1097 funcCalled = ""
1098 Set obj = Nothing
1099 Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled)
1101 Set obj = New TermTest
1102 funcCalled = ""
1103 Call obj.Class_Terminate
1104 Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled)
1105 funcCalled = ""
1106 Set obj = Nothing
1107 Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled)
1109 Call (New testclass).publicSub()
1110 Call (New testclass).publicSub
1112 class PropTest
1113 property get prop0()
1114 prop0 = 1
1115 end property
1117 property get prop1(x)
1118 prop1 = x+1
1119 end property
1121 property get prop2(x, y)
1122 prop2 = x+y
1123 end property
1124 end class
1126 set obj = new PropTest
1128 call ok(obj.prop0 = 1, "obj.prop0 = " & obj.prop0)
1129 call ok(obj.prop1(3) = 4, "obj.prop1(3) = " & obj.prop1(3))
1130 call ok(obj.prop2(3,4) = 7, "obj.prop2(3,4) = " & obj.prop2(3,4))
1131 call obj.prop0()
1132 call obj.prop1(2)
1133 call obj.prop2(3,4)
1135 x = "following ':' is correct syntax" :
1136 x = "following ':' is correct syntax" :: :
1137 :: x = "also correct syntax"
1138 rem another ugly way for comments
1139 x = "rem as simplestatement" : rem rem comment
1142 Set obj = new EmptyClass
1143 Set x = obj
1144 Set y = new EmptyClass
1146 Call ok(obj is x, "obj is not x")
1147 Call ok(x is obj, "x is not obj")
1148 Call ok(not (obj is y), "obj is not y")
1149 Call ok(not obj is y, "obj is not y")
1150 Call ok(not (x is Nothing), "x is 1")
1151 Call ok(Nothing is Nothing, "Nothing is not Nothing")
1152 Call ok(x is obj and true, "x is obj and true is false")
1154 Class TestMe
1155 Public Sub Test(MyMe)
1156 Call ok(Me is MyMe, "Me is not MyMe")
1157 End Sub
1158 End Class
1160 Set obj = New TestMe
1161 Call obj.test(obj)
1163 Call ok(getVT(test) = "VT_DISPATCH", "getVT(test) = " & getVT(test))
1164 Call ok(Me is Test, "Me is not Test")
1166 Const c1 = 1, c2 = 2, c3 = -3
1167 Call ok(c1 = 1, "c1 = " & c1)
1168 Call ok(getVT(c1) = "VT_I2", "getVT(c1) = " & getVT(c1))
1169 Call ok(c3 = -3, "c3 = " & c3)
1170 Call ok(getVT(c3) = "VT_I2", "getVT(c3) = " & getVT(c3))
1172 Const cb = True, cs = "test", cnull = null
1173 Call ok(cb, "cb = " & cb)
1174 Call ok(getVT(cb) = "VT_BOOL", "getVT(cb) = " & getVT(cb))
1175 Call ok(cs = "test", "cs = " & cs)
1176 Call ok(getVT(cs) = "VT_BSTR", "getVT(cs) = " & getVT(cs))
1177 Call ok(isNull(cnull), "cnull = " & cnull)
1178 Call ok(getVT(cnull) = "VT_NULL", "getVT(cnull) = " & getVT(cnull))
1180 Call ok(+1 = 1, "+1 != 1")
1181 Call ok(+true = true, "+1 != 1")
1182 Call ok(getVT(+true) = "VT_BOOL", "getVT(+true) = " & getVT(+true))
1183 Call ok(+"true" = "true", """+true"" != true")
1184 Call ok(getVT(+"true") = "VT_BSTR", "getVT(+""true"") = " & getVT(+"true"))
1185 Call ok(+obj is obj, "+obj != obj")
1186 Call ok(+--+-+1 = -1, "+--+-+1 != -1")
1188 if false then Const conststr = "str"
1189 Call ok(conststr = "str", "conststr = " & conststr)
1190 Call ok(getVT(conststr) = "VT_BSTR", "getVT(conststr) = " & getVT(conststr))
1191 Call ok(conststr = "str", "conststr = " & conststr)
1193 Sub ConstTestSub
1194 Const funcconst = 1
1195 Call ok(c1 = 1, "c1 = " & c1)
1196 Call ok(funcconst = 1, "funcconst = " & funcconst)
1197 End Sub
1199 Call ConstTestSub
1200 Dim funcconst
1202 ' Property may be used as an identifier (although it's a keyword)
1203 Sub TestProperty
1204 Dim Property
1205 PROPERTY = true
1206 Call ok(property, "property = " & property)
1208 for property = 1 to 2
1209 next
1210 End Sub
1212 Call TestProperty
1214 Class Property
1215 Public Sub Property()
1216 End Sub
1218 Sub Test(byref property)
1219 End Sub
1220 End Class
1222 Class Property2
1223 Function Property()
1224 End Function
1226 Sub Test(property)
1227 End Sub
1229 Sub Test2(byval property)
1230 End Sub
1231 End Class
1233 Class SeparatorTest : : Dim varTest1
1235 Private Sub Class_Initialize : varTest1 = 1
1236 End Sub ::
1238 Property Get Test1() :
1239 Test1 = varTest1
1240 End Property ::
1242 Property Let Test1(a) :
1243 varTest1 = a
1244 End Property :
1246 Public Function AddToTest1(ByVal a) :: :
1247 varTest1 = varTest1 + a
1248 AddToTest1 = varTest1
1249 End Function : End Class : :: Set obj = New SeparatorTest
1251 Call ok(obj.Test1 = 1, "obj.Test1 is not 1")
1252 obj.Test1 = 6
1253 Call ok(obj.Test1 = 6, "obj.Test1 is not 6")
1254 obj.AddToTest1(5)
1255 Call ok(obj.Test1 = 11, "obj.Test1 is not 11")
1257 set obj = unkObj
1258 set x = obj
1259 call ok(getVT(obj) = "VT_UNKNOWN*", "getVT(obj) = " & getVT(obj))
1260 call ok(getVT(x) = "VT_UNKNOWN*", "getVT(x) = " & getVT(x))
1261 call ok(getVT(unkObj) = "VT_UNKNOWN", "getVT(unkObj) = " & getVT(unkObj))
1262 call ok(obj is unkObj, "obj is not unkObj")
1264 ' Array tests
1266 Call ok(getVT(arr) = "VT_EMPTY*", "getVT(arr) = " & getVT(arr))
1268 Dim arr(3)
1269 Dim arr2(4,3), arr3(5,4,3), arr0(0), noarr()
1271 Call ok(getVT(arr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr) = " & getVT(arr))
1272 Call ok(getVT(arr2) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr2) = " & getVT(arr2))
1273 Call ok(getVT(arr0) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr0) = " & getVT(arr0))
1274 Call ok(getVT(noarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(noarr) = " & getVT(noarr))
1276 Call testArray(1, arr)
1277 Call testArray(2, arr2)
1278 Call testArray(3, arr3)
1279 Call testArray(0, arr0)
1280 Call testArray(-1, noarr)
1282 Call ok(getVT(arr(1)) = "VT_EMPTY*", "getVT(arr(1)) = " & getVT(arr(1)))
1283 Call ok(getVT(arr2(1,2)) = "VT_EMPTY*", "getVT(arr2(1,2)) = " & getVT(arr2(1,2)))
1284 Call ok(getVT(arr3(1,2,2)) = "VT_EMPTY*", "getVT(arr3(1,2,3)) = " & getVT(arr3(1,2,2)))
1285 Call ok(getVT(arr(0)) = "VT_EMPTY*", "getVT(arr(0)) = " & getVT(arr(0)))
1286 Call ok(getVT(arr(3)) = "VT_EMPTY*", "getVT(arr(3)) = " & getVT(arr(3)))
1287 Call ok(getVT(arr0(0)) = "VT_EMPTY*", "getVT(arr0(0)) = " & getVT(arr0(0)))
1289 arr(2) = 3
1290 Call ok(arr(2) = 3, "arr(2) = " & arr(2))
1291 Call ok(getVT(arr(2)) = "VT_I2*", "getVT(arr(2)) = " & getVT(arr(2)))
1293 arr3(3,2,1) = 1
1294 arr3(1,2,3) = 2
1295 Call ok(arr3(3,2,1) = 1, "arr3(3,2,1) = " & arr3(3,2,1))
1296 Call ok(arr3(1,2,3) = 2, "arr3(1,2,3) = " & arr3(1,2,3))
1297 arr2(4,3) = 1
1298 Call ok(arr2(4,3) = 1, "arr2(4,3) = " & arr2(4,3))
1300 x = arr3
1301 Call ok(x(3,2,1) = 1, "x(3,2,1) = " & x(3,2,1))
1303 Function getarr()
1304 Dim arr(3)
1305 arr(2) = 2
1306 getarr = arr
1307 arr(3) = 3
1308 End Function
1310 x = getarr()
1311 Call ok(getVT(x) = "VT_ARRAY|VT_VARIANT*", "getVT(x) = " & getVT(x))
1312 Call ok(x(2) = 2, "x(2) = " & x(2))
1313 Call ok(getVT(x(3)) = "VT_EMPTY*", "getVT(x(3)) = " & getVT(x(3)))
1315 x(1) = 1
1316 Call ok(x(1) = 1, "x(1) = " & x(1))
1317 x = getarr()
1318 Call ok(getVT(x(1)) = "VT_EMPTY*", "getVT(x(1)) = " & getVT(x(1)))
1319 Call ok(x(2) = 2, "x(2) = " & x(2))
1321 x(1) = 1
1322 y = x
1323 x(1) = 2
1324 Call ok(y(1) = 1, "y(1) = " & y(1))
1326 for x=1 to 1
1327 Dim forarr(3)
1328 if x=1 then
1329 Call ok(getVT(forarr(1)) = "VT_EMPTY*", "getVT(forarr(1)) = " & getVT(forarr(1)))
1330 else
1331 Call ok(forarr(1) = x, "forarr(1) = " & forarr(1))
1332 end if
1333 forarr(1) = x+1
1334 next
1337 Call ok(forarr(x) = 2, "forarr(x) = " & forarr(x))
1339 sub accessArr()
1340 ok arr(1) = 1, "arr(1) = " & arr(1)
1341 arr(1) = 2
1342 end sub
1343 arr(1) = 1
1344 call accessArr
1345 ok arr(1) = 2, "arr(1) = " & arr(1)
1347 sub accessArr2(x,y)
1348 ok arr2(x,y) = 1, "arr2(x,y) = " & arr2(x,y)
1349 x = arr2(x,y)
1350 arr2(x,y) = 2
1351 end sub
1352 arr2(1,2) = 1
1353 call accessArr2(1, 2)
1354 ok arr2(1,2) = 2, "arr2(1,2) = " & arr2(1,2)
1356 x = Array(Array(3))
1357 call ok(x(0)(0) = 3, "x(0)(0) = " & x(0)(0))
1359 function seta0(arr)
1360 arr(0) = 2
1361 seta0 = 1
1362 end function
1364 x = Array(1)
1365 seta0 x
1366 ok x(0) = 2, "x(0) = " & x(0)
1368 x = Array(1)
1369 seta0 (x)
1370 ok x(0) = 1, "x(0) = " & x(0)
1372 x = Array(1)
1373 call (((seta0))) ((x))
1374 ok x(0) = 1, "x(0) = " & x(0)
1376 x = Array(1)
1377 call (((seta0))) (x)
1378 ok x(0) = 2, "x(0) = " & x(0)
1380 x = Array(Array(3))
1381 seta0 x(0)
1382 call ok(x(0)(0) = 2, "x(0)(0) = " & x(0)(0))
1384 x = Array(Array(3))
1385 seta0 (x(0))
1386 call ok(x(0)(0) = 3, "x(0)(0) = " & x(0)(0))
1388 y = (seta0)(x)
1389 ok y = 1, "y = " & y
1391 y = ((x))(0)
1392 ok y = 2, "y = " & y
1394 sub changearg(x)
1395 x = 2
1396 end sub
1398 x = Array(1)
1399 changearg x(0)
1400 ok x(0) = 2, "x(0) = " & x(0)
1401 ok getVT(x) = "VT_ARRAY|VT_VARIANT*", "getVT(x) after redim = " & getVT(x)
1403 x = Array(1)
1404 changearg (x(0))
1405 ok x(0) = 1, "x(0) = " & x(0)
1407 x = Array(1)
1408 redim x(4)
1409 ok ubound(x) = 4, "ubound(x) = " & ubound(x)
1410 ok x(0) = empty, "x(0) = " & x(0)
1412 x = 1
1413 redim x(3)
1414 ok ubound(x) = 3, "ubound(x) = " & ubound(x)
1416 x(0) = 1
1417 x(1) = 2
1418 x(2) = 3
1419 x(2) = 4
1421 redim preserve x(1)
1422 ok ubound(x) = 1, "ubound(x) = " & ubound(x)
1423 ok x(0) = 1, "x(0) = " & x(1)
1424 ok x(1) = 2, "x(1) = " & x(1)
1426 redim preserve x(2)
1427 ok ubound(x) = 2, "ubound(x) = " & ubound(x)
1428 ok x(0) = 1, "x(0) = " & x(0)
1429 ok x(1) = 2, "x(1) = " & x(1)
1430 ok x(2) = vbEmpty, "x(2) = " & x(2)
1432 on error resume next
1433 redim preserve x(2,2)
1434 e = err.number
1435 on error goto 0
1436 ok e = 9, "e = " & e ' VBSE_OUT_OF_BOUNDS, cannot change cDims
1438 x = Array(1, 2)
1439 redim x(-1)
1440 ok lbound(x) = 0, "lbound(x) = " & lbound(x)
1441 ok ubound(x) = -1, "ubound(x) = " & ubound(x)
1443 redim x(3, 2)
1444 ok ubound(x) = 3, "ubound(x) = " & ubound(x)
1445 ok ubound(x, 1) = 3, "ubound(x, 1) = " & ubound(x, 1)
1446 ok ubound(x, 2) = 2, "ubound(x, 2) = " & ubound(x, 2) & " expected 2"
1448 redim x(1, 3)
1449 x(0,0) = 1.1
1450 x(0,1) = 1.2
1451 x(0,2) = 1.3
1452 x(0,3) = 1.4
1453 x(1,0) = 2.1
1454 x(1,1) = 2.2
1455 x(1,2) = 2.3
1456 x(1,3) = 2.4
1458 redim preserve x(1,1)
1459 ok ubound(x, 1) = 1, "ubound(x, 1) = " & ubound(x, 1)
1460 ok ubound(x, 2) = 1, "ubound(x, 2) = " & ubound(x, 2)
1461 ok x(0,0) = 1.1, "x(0,0) = " & x(0,0)
1462 ok x(0,1) = 1.2, "x(0,1) = " & x(0,1)
1463 ok x(1,0) = 2.1, "x(1,0) = " & x(1,0)
1464 ok x(1,1) = 2.2, "x(1,1) = " & x(1,1)
1466 redim preserve x(1,2)
1467 ok ubound(x, 1) = 1, "ubound(x, 1) = " & ubound(x, 1)
1468 ok ubound(x, 2) = 2, "ubound(x, 2) = " & ubound(x, 2)
1469 ok x(0,0) = 1.1, "x(0,0) = " & x(0,0)
1470 ok x(0,1) = 1.2, "x(0,1) = " & x(0,1)
1471 ok x(1,0) = 2.1, "x(1,0) = " & x(1,0)
1472 ok x(1,1) = 2.2, "x(1,1) = " & x(1,1)
1473 ok x(0,2) = vbEmpty, "x(0,2) = " & x(0,2)
1474 ok x(1,2) = vbEmpty, "x(1,2) = " & x(1,1)
1476 on error resume next
1477 redim preserve x(2,2)
1478 e = err.number
1479 on error goto 0
1480 ok e = 9, "e = " & e ' VBSE_OUT_OF_BOUNDS, can only change rightmost dimension
1482 dim staticarray(4)
1483 on error resume next
1484 redim staticarray(3)
1485 e = err.number
1486 on error goto 0
1487 todo_wine_ok e = 10, "e = " & e
1489 Class ArrClass
1490 Dim classarr(3)
1491 Dim classnoarr()
1492 Dim var
1494 Private Sub Class_Initialize
1495 Call ok(getVT(classarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(classarr) = " & getVT(classarr))
1496 Call testArray(-1, classnoarr)
1497 classarr(0) = 1
1498 classarr(1) = 2
1499 classarr(2) = 3
1500 classarr(3) = 4
1501 End Sub
1503 Public Sub testVarVT
1504 Call ok(getVT(var) = "VT_ARRAY|VT_VARIANT*", "getVT(var) = " & getVT(var))
1505 End Sub
1506 End Class
1508 Set obj = new ArrClass
1509 Call ok(getVT(obj.classarr) = "VT_ARRAY|VT_VARIANT", "getVT(obj.classarr) = " & getVT(obj.classarr))
1510 'todo_wine Call ok(obj.classarr(1) = 2, "obj.classarr(1) = " & obj.classarr(1))
1512 obj.var = arr
1513 Call ok(getVT(obj.var) = "VT_ARRAY|VT_VARIANT", "getVT(obj.var) = " & getVT(obj.var))
1514 Call obj.testVarVT
1516 Sub arrarg(byref refarr, byval valarr, byref refarr2, byval valarr2)
1517 Call ok(getVT(refarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(refarr) = " & getVT(refarr))
1518 Call ok(getVT(valarr) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr) = " & getVT(valarr))
1519 Call ok(getVT(refarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(refarr2) = " & getVT(refarr2))
1520 Call ok(getVT(valarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr2) = " & getVT(valarr2))
1521 End Sub
1523 Call arrarg(arr, arr, obj.classarr, obj.classarr)
1525 Sub arrarg2(byref refarr(), byval valarr(), byref refarr2(), byval valarr2())
1526 Call ok(getVT(refarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(refarr) = " & getVT(refarr))
1527 Call ok(getVT(valarr) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr) = " & getVT(valarr))
1528 Call ok(getVT(refarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(refarr2) = " & getVT(refarr2))
1529 Call ok(getVT(valarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr2) = " & getVT(valarr2))
1530 End Sub
1532 Call arrarg2(arr, arr, obj.classarr, obj.classarr)
1534 Sub testarrarg(arg(), vt)
1535 Call ok(getVT(arg) = vt, "getVT() = " & getVT(arg) & " expected " & vt)
1536 End Sub
1538 Call testarrarg(1, "VT_I2*")
1539 Call testarrarg(false, "VT_BOOL*")
1540 Call testarrarg(Empty, "VT_EMPTY*")
1542 Sub modifyarr(arr)
1543 Call ok(arr(0) = "not modified", "arr(0) = " & arr(0))
1544 arr(0) = "modified"
1545 End Sub
1547 arr(0) = "not modified"
1548 Call modifyarr(arr)
1549 Call ok(arr(0) = "modified", "arr(0) = " & arr(0))
1551 arr(0) = "not modified"
1552 modifyarr(arr)
1553 Call ok(arr(0) = "not modified", "arr(0) = " & arr(0))
1555 for x = 0 to UBound(arr)
1556 arr(x) = x
1557 next
1558 y = 0
1559 for each x in arr
1560 Call ok(x = y, "x = " & x & ", expected " & y)
1561 Call ok(arr(y) = y, "arr(" & y & ") = " & arr(y))
1562 arr(y) = 1
1563 x = 1
1564 y = y+1
1565 next
1566 Call ok(y = 4, "y = " & y & " after array enumeration")
1568 for x=0 to UBound(arr2, 1)
1569 for y=0 to UBound(arr2, 2)
1570 arr2(x, y) = x + y*(UBound(arr2, 1)+1)
1571 next
1572 next
1573 y = 0
1574 for each x in arr2
1575 Call ok(x = y, "x = " & x & ", expected " & y)
1576 y = y+1
1577 next
1578 Call ok(y = 20, "y = " & y & " after array enumeration")
1580 for each x in noarr
1581 Call ok(false, "Empty array contains: " & x)
1582 next
1584 ' It's allowed to declare non-builtin RegExp class...
1585 class RegExp
1586 public property get Global()
1587 Call ok(false, "Global called")
1588 Global = "fail"
1589 end property
1590 end class
1592 ' ...but there is no way to use it because builtin instance is always created
1593 set x = new RegExp
1594 Call ok(x.Global = false, "x.Global = " & x.Global)
1596 sub test_nothing_errors
1597 dim x
1598 on error resume next
1600 x = 1
1601 err.clear
1602 x = nothing
1603 call ok(err.number = 91, "err.number = " & err.number)
1604 call ok(x = 1, "x = " & x)
1606 err.clear
1607 x = not nothing
1608 call ok(err.number = 91, "err.number = " & err.number)
1609 call ok(x = 1, "x = " & x)
1611 err.clear
1612 x = "" & nothing
1613 call ok(err.number = 91, "err.number = " & err.number)
1614 call ok(x = 1, "x = " & x)
1615 end sub
1616 call test_nothing_errors()
1618 sub test_identifiers
1619 ' test keywords that can also be a declared identifier
1620 Dim default
1621 default = "xx"
1622 Call ok(default = "xx", "default = " & default & " expected ""xx""")
1624 Dim error
1625 error = "xx"
1626 Call ok(error = "xx", "error = " & error & " expected ""xx""")
1628 Dim explicit
1629 explicit = "xx"
1630 Call ok(explicit = "xx", "explicit = " & explicit & " expected ""xx""")
1632 Dim step
1633 step = "xx"
1634 Call ok(step = "xx", "step = " & step & " expected ""xx""")
1636 Dim property
1637 property = "xx"
1638 Call ok(property = "xx", "property = " & property & " expected ""xx""")
1639 end sub
1640 call test_identifiers()
1642 Class class_test_identifiers_as_function_name
1643 Sub Property ( par )
1644 End Sub
1646 Function Error( par )
1647 End Function
1649 Sub Default ()
1650 End Sub
1652 Function Explicit (par)
1653 Explicit = par
1654 End Function
1656 Sub Step ( default )
1657 End Sub
1658 End Class
1660 Class class_test_identifiers_as_property_name
1661 Public Property Get Property()
1662 End Property
1664 Public Property Let Error(par)
1665 Error = par
1666 End Property
1668 Public Property Set Default(par)
1669 Set Default = par
1670 End Property
1671 End Class
1673 sub test_dotIdentifiers
1674 ' test keywords that can also be an identifier after a dot
1675 Call ok(testObj.rem = 10, "testObj.rem = " & testObj.rem & " expected 10")
1676 Call ok(testObj.true = 10, "testObj.true = " & testObj.true & " expected 10")
1677 Call ok(testObj.false = 10, "testObj.false = " & testObj.false & " expected 10")
1678 Call ok(testObj.not = 10, "testObj.not = " & testObj.not & " expected 10")
1679 Call ok(testObj.and = 10, "testObj.and = " & testObj.and & " expected 10")
1680 Call ok(testObj.or = 10, "testObj.or = " & testObj.or & " expected 10")
1681 Call ok(testObj.xor = 10, "testObj.xor = " & testObj.xor & " expected 10")
1682 Call ok(testObj.eqv = 10, "testObj.eqv = " & testObj.eqv & " expected 10")
1683 Call ok(testObj.imp = 10, "testObj.imp = " & testObj.imp & " expected 10")
1684 Call ok(testObj.is = 10, "testObj.is = " & testObj.is & " expected 10")
1685 Call ok(testObj.mod = 10, "testObj.mod = " & testObj.mod & " expected 10")
1686 Call ok(testObj.call = 10, "testObj.call = " & testObj.call & " expected 10")
1687 Call ok(testObj.dim = 10, "testObj.dim = " & testObj.dim & " expected 10")
1688 Call ok(testObj.sub = 10, "testObj.sub = " & testObj.sub & " expected 10")
1689 Call ok(testObj.function = 10, "testObj.function = " & testObj.function & " expected 10")
1690 Call ok(testObj.get = 10, "testObj.get = " & testObj.get & " expected 10")
1691 Call ok(testObj.let = 10, "testObj.let = " & testObj.let & " expected 10")
1692 Call ok(testObj.const = 10, "testObj.const = " & testObj.const & " expected 10")
1693 Call ok(testObj.if = 10, "testObj.if = " & testObj.if & " expected 10")
1694 Call ok(testObj.else = 10, "testObj.else = " & testObj.else & " expected 10")
1695 Call ok(testObj.elseif = 10, "testObj.elseif = " & testObj.elseif & " expected 10")
1696 Call ok(testObj.end = 10, "testObj.end = " & testObj.end & " expected 10")
1697 Call ok(testObj.then = 10, "testObj.then = " & testObj.then & " expected 10")
1698 Call ok(testObj.exit = 10, "testObj.exit = " & testObj.exit & " expected 10")
1699 Call ok(testObj.while = 10, "testObj.while = " & testObj.while & " expected 10")
1700 Call ok(testObj.wend = 10, "testObj.wend = " & testObj.wend & " expected 10")
1701 Call ok(testObj.do = 10, "testObj.do = " & testObj.do & " expected 10")
1702 Call ok(testObj.loop = 10, "testObj.loop = " & testObj.loop & " expected 10")
1703 Call ok(testObj.until = 10, "testObj.until = " & testObj.until & " expected 10")
1704 Call ok(testObj.for = 10, "testObj.for = " & testObj.for & " expected 10")
1705 Call ok(testObj.to = 10, "testObj.to = " & testObj.to & " expected 10")
1706 Call ok(testObj.each = 10, "testObj.each = " & testObj.each & " expected 10")
1707 Call ok(testObj.in = 10, "testObj.in = " & testObj.in & " expected 10")
1708 Call ok(testObj.select = 10, "testObj.select = " & testObj.select & " expected 10")
1709 Call ok(testObj.case = 10, "testObj.case = " & testObj.case & " expected 10")
1710 Call ok(testObj.byref = 10, "testObj.byref = " & testObj.byref & " expected 10")
1711 Call ok(testObj.byval = 10, "testObj.byval = " & testObj.byval & " expected 10")
1712 Call ok(testObj.option = 10, "testObj.option = " & testObj.option & " expected 10")
1713 Call ok(testObj.nothing = 10, "testObj.nothing = " & testObj.nothing & " expected 10")
1714 Call ok(testObj.empty = 10, "testObj.empty = " & testObj.empty & " expected 10")
1715 Call ok(testObj.null = 10, "testObj.null = " & testObj.null & " expected 10")
1716 Call ok(testObj.class = 10, "testObj.class = " & testObj.class & " expected 10")
1717 Call ok(testObj.set = 10, "testObj.set = " & testObj.set & " expected 10")
1718 Call ok(testObj.new = 10, "testObj.new = " & testObj.new & " expected 10")
1719 Call ok(testObj.public = 10, "testObj.public = " & testObj.public & " expected 10")
1720 Call ok(testObj.private = 10, "testObj.private = " & testObj.private & " expected 10")
1721 Call ok(testObj.next = 10, "testObj.next = " & testObj.next & " expected 10")
1722 Call ok(testObj.on = 10, "testObj.on = " & testObj.on & " expected 10")
1723 Call ok(testObj.resume = 10, "testObj.resume = " & testObj.resume & " expected 10")
1724 Call ok(testObj.goto = 10, "testObj.goto = " & testObj.goto & " expected 10")
1725 Call ok(testObj.with = 10, "testObj.with = " & testObj.with & " expected 10")
1726 Call ok(testObj.redim = 10, "testObj.redim = " & testObj.redim & " expected 10")
1727 Call ok(testObj.preserve = 10, "testObj.preserve = " & testObj.preserve & " expected 10")
1728 Call ok(testObj.property = 10, "testObj.property = " & testObj.property & " expected 10")
1729 Call ok(testObj.me = 10, "testObj.me = " & testObj.me & " expected 10")
1730 Call ok(testObj.stop = 10, "testObj.stop = " & testObj.stop & " expected 10")
1731 end sub
1732 call test_dotIdentifiers
1734 ' Test End statements not required to be preceded by a newline or separator
1735 Sub EndTestSub
1736 x = 1 End Sub
1738 Sub EndTestSubWithCall
1739 x = 1
1740 Call ok(x = 1, "x = " & x)End Sub
1741 Call EndTestSubWithCall()
1743 Function EndTestFunc(x)
1744 Call ok(x > 0, "x = " & x)End Function
1745 EndTestFunc(1)
1747 Class EndTestClassWithStorageId
1748 Public x End Class
1750 Class EndTestClassWithDim
1751 Dim x End Class
1753 Class EndTestClassWithFunc
1754 Function test(ByVal x)
1755 x = 0 End Function End Class
1757 Class EndTestClassWithProperty
1758 Public x
1759 Public default Property Get defprop
1760 defprop = x End Property End Class
1762 class TestPropSyntax
1763 public prop
1765 function getProp()
1766 set getProp = prop
1767 end function
1769 public default property get def()
1770 def = ""
1771 end property
1772 end class
1774 Class TestPropParam
1775 Public oDict
1776 Public gotNothing
1777 Public m_obj
1779 Public Property Set bar(obj)
1780 Set m_obj = obj
1781 End Property
1782 Public Property Set foo(par,obj)
1783 Set m_obj = obj
1784 if obj is Nothing Then gotNothing = True
1785 oDict = par
1786 End Property
1787 Public Property Let Key(oldKey,newKey)
1788 oDict = oldKey & newKey
1789 End Property
1790 Public Property Let three(uno,due,tre)
1791 oDict = uno & due & tre
1792 End Property
1793 Public Property Let ten(a,b,c,d,e,f,g,h,i,j)
1794 oDict = a & b & c & d & e & f & g & h & i & j
1795 End Property
1796 End Class
1798 Set x = new TestPropParam
1799 x.key("old") = "new"
1800 call ok(x.oDict = "oldnew","x.oDict = " & x.oDict & " expected oldnew")
1801 x.three(1,2) = 3
1802 call ok(x.oDict = "123","x.oDict = " & x.oDict & " expected 123")
1803 x.ten(1,2,3,4,5,6,7,8,9) = 0
1804 call ok(x.oDict = "1234567890","x.oDict = " & x.oDict & " expected 1234567890")
1805 Set x.bar = Nothing
1806 call ok(x.gotNothing=Empty,"x.gotNothing = " & x.gotNothing & " expected Empty")
1807 Set x.foo("123") = Nothing
1808 call ok(x.oDict = "123","x.oDict = " & x.oDict & " expected 123")
1809 call ok(x.gotNothing=True,"x.gotNothing = " & x.gotNothing & " expected true")
1811 set x = new TestPropSyntax
1812 set x.prop = new TestPropSyntax
1813 set x.prop.prop = new TestPropSyntax
1814 x.prop.prop.prop = 2
1815 call ok(x.getProp().getProp.prop = 2, "x.getProp().getProp.prop = " & x.getProp().getProp.prop)
1816 x.getprop.getprop().prop = 3
1817 call ok(x.getProp.prop.prop = 3, "x.getProp.prop.prop = " & x.getProp.prop.prop)
1818 set x.getprop.getprop().prop = new emptyclass
1819 set obj = new emptyclass
1820 set x.getprop.getprop().prop = obj
1821 call ok(x.getprop.getprop().prop is obj, "x.getprop.getprop().prop is not obj (emptyclass)")
1823 ok getVT(x) = "VT_DISPATCH*", "getVT(x) = " & getVT(x)
1824 todo_wine_ok getVT(x()) = "VT_BSTR", "getVT(x()) = " & getVT(x())
1826 funcCalled = ""
1827 class DefaultSubTest1
1828 Public default Sub init(a)
1829 funcCalled = "init" & a
1830 end sub
1831 end class
1833 Set obj = New DefaultSubTest1
1834 obj.init(1)
1835 call ok(funcCalled = "init1","funcCalled=" & funcCalled)
1836 funcCalled = ""
1837 obj(2)
1838 call ok(funcCalled = "init2","funcCalled=" & funcCalled)
1840 class DefaultSubTest2
1841 Public Default Function init
1842 funcCalled = "init"
1843 end function
1844 end class
1846 Set obj = New DefaultSubTest2
1847 funcCalled = ""
1848 obj.init()
1849 call ok(funcCalled = "init","funcCalled=" & funcCalled)
1850 funcCalled = ""
1851 ' todo this is not yet supported
1852 'funcCalled = ""
1853 'obj()
1854 'call ok(funcCalled = "init","funcCalled=" & funcCalled)
1856 with nothing
1857 end with
1859 set x = new TestPropSyntax
1860 with x
1861 .prop = 1
1862 ok .prop = 1, ".prop = "&.prop
1863 end with
1864 ok x.prop = 1, "x.prop = " & x.prop
1866 with new TestPropSyntax
1867 .prop = 1
1868 ok .prop = 1, ".prop = "&.prop
1869 end with
1871 function testsetresult(x, y)
1872 set testsetresult = new TestPropSyntax
1873 testsetresult.prop = x
1874 y = testsetresult.prop + 1
1875 end function
1877 set x = testsetresult(1, 2)
1878 ok x.prop = 1, "x.prop = " & x.prop
1880 set arr(0) = new TestPropSyntax
1881 arr(0).prop = 1
1882 ok arr(0).prop = 1, "arr(0) = " & arr(0).prop
1884 function f2(x,y)
1885 end function
1887 f2 1 = 1, 2
1889 function f1(x)
1890 ok x = true, "x = " & x
1891 end function
1893 f1 1 = 1
1894 f1 1 = (1)
1895 f1 not 1 = 0
1897 arr (0) = 2 xor -2
1899 reportSuccess()