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