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