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 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 if true then x=1 end if
 238
 239 x = false
 240 if false then x = true : x = true
 241 Call ok(x = false, "x <> false")
 242
 243 if false then
 244     ok false, "if false called"
 245 end if
 246
 247 x = true
 248 if x then
 249     x = false
 250 end if
 251 Call ok(not x, "x is false, if not evaluated?")
 252
 253 x = false
 254 If false Then
 255    Call ok(false, "inside if false")
 256 Else
 257    x = true
 258 End If
 259 Call ok(x, "else not called?")
 260
 261 x = false
 262 If false Then
 263    Call ok(false, "inside if false")
 264 ElseIf not True Then
 265    Call ok(false, "inside elseif not true")
 266 Else
 267    x = true
 268 End If
 269 Call ok(x, "else not called?")
 270
 271 x = false
 272 If false Then
 273    Call ok(false, "inside if false")
 274    x = 1
 275    y = 10+x
 276 ElseIf not False Then
 277    x = true
 278 Else
 279    Call ok(false, "inside else not true")
 280 End If
 281 Call ok(x, "elseif not called?")
 282
 283 x = false
 284 If false Then
 285    Call ok(false, "inside if false")
 286 ElseIf not False Then
 287    x = true
 288 End If
 289 Call ok(x, "elseif not called?")
 290
 291 x = false
 292 if 1 then x = true
 293 Call ok(x, "if 1 not run?")
 294
 295 x = false
 296 if &h10000& then x = true
 297 Call ok(x, "if &h10000& not run?")
 298
 299 x = false
 300 y = false
 301 while not (x and y)
 302     if x then
 303         y = true
 304     end if
 305     x = true
 306 wend
 307 call ok((x and y), "x or y is false after while")
 308
 309 if false then
 310 ' empty body
 311 end if
 312
 313 if false then
 314     x = false
 315 elseif true then
 316 ' empty body
 317 end if
 318
 319 if false then
 320     x = false
 321 else
 322 ' empty body
 323 end if
 324
 325 while false
 326 wend
 327
 328 x = 0
 329 WHILE x < 3 : x = x + 1
 330 Wend
 331 Call ok(x = 3, "x not equal to 3")
 332
 333 z = 2
 334 while z > -4 :
 335
 336
 337 z = z -2
 338 wend
 339
 340 x = false
 341 y = false
 342 do while not (x and y)
 343     if x then
 344         y = true
 345     end if
 346     x = true
 347 loop
 348 call ok((x and y), "x or y is false after while")
 349
 350 do while false
 351 loop
 352
 353 do while true
 354     exit do
 355     ok false, "exit do didn't work"
 356 loop
 357
 358 x = 0
 359 Do While x < 2 : x = x + 1
 360 Loop
 361 Call ok(x = 2, "x not equal to 2")
 362
 363 x = 0
 364 Do While x >= -2 :
 365 x = x - 1
 366 Loop
 367 Call ok(x = -3, "x not equal to -3")
 368
 369 x = false
 370 y = false
 371 do until x and y
 372     if x then
 373         y = true
 374     end if
 375     x = true
 376 loop
 377 call ok((x and y), "x or y is false after do until")
 378
 379 do until true
 380 loop
 381
 382 do until false
 383     exit do
 384     ok false, "exit do didn't work"
 385 loop
 386
 387 x = 0
 388 Do: :: x = x + 2
 389 Loop Until x = 4
 390 Call ok(x = 4, "x not equal to 4")
 391
 392 x = 5
 393 Do: :
 394
 395 : x = x * 2
 396 Loop Until x = 40
 397 Call ok(x = 40, "x not equal to 40")
 398
 399
 400 x = false
 401 do
 402     if x then exit do
 403     x = true
 404 loop
 405 call ok(x, "x is false after do..loop?")
 406
 407 x = 0
 408 Do :If x = 6 Then
 409         Exit Do
 410     End If
 411     x = x + 3
 412 Loop
 413 Call ok(x = 6, "x not equal to 6")
 414
 415 x = false
 416 y = false
 417 do
 418     if x then
 419         y = true
 420     end if
 421     x = true
 422 loop until x and y
 423 call ok((x and y), "x or y is false after while")
 424
 425 do
 426 loop until true
 427
 428 do
 429     exit do
 430     ok false, "exit do didn't work"
 431 loop until false
 432
 433 x = false
 434 y = false
 435 do
 436     if x then
 437         y = true
 438     end if
 439     x = true
 440 loop while not (x and y)
 441 call ok((x and y), "x or y is false after while")
 442
 443 do
 444 loop while false
 445
 446 do
 447     exit do
 448     ok false, "exit do didn't work"
 449 loop while true
 450
 451 y = "for1:"
 452 for x = 5 to 8
 453     y = y & " " & x
 454 next
 455 Call ok(y = "for1: 5 6 7 8", "y = " & y)
 456
 457 y = "for2:"
 458 for x = 5 to 8 step 2
 459     y = y & " " & x
 460 next
 461 Call ok(y = "for2: 5 7", "y = " & y)
 462
 463 y = "for3:"
 464 x = 2
 465 for x = x+3 to 8
 466     y = y & " " & x
 467 next
 468 Call ok(y = "for3: 5 6 7 8", "y = " & y)
 469
 470 y = "for4:"
 471 for x = 5 to 4
 472     y = y & " " & x
 473 next
 474 Call ok(y = "for4:", "y = " & y)
 475
 476 y = "for5:"
 477 for x = 5 to 3 step true
 478     y = y & " " & x
 479 next
 480 Call ok(y = "for5: 5 4 3", "y = " & y)
 481
 482 y = "for6:"
 483 z = 4
 484 for x = 5 to z step 3-4
 485     y = y & " " & x
 486     z = 0
 487 next
 488 Call ok(y = "for6: 5 4", "y = " & y)
 489
 490 y = "for7:"
 491 z = 1
 492 for x = 5 to 8 step z
 493     y = y & " " & x
 494     z = 2
 495 next
 496 Call ok(y = "for7: 5 6 7 8", "y = " & y)
 497
 498 z = 0
 499 For x = 10 To 18 Step 2 : : z = z + 1
 500 Next
 501 Call ok(z = 5, "z not equal to 5")
 502
 503 y = "for8:"
 504 for x = 5 to 8
 505     y = y & " " & x
 506     x = x+1
 507 next
 508 Call ok(y = "for8: 5 7", "y = " & y)
 509
 510 for x = 1.5 to 1
 511     Call ok(false, "for..to called when unexpected")
 512 next
 513
 514 for x = 1 to 100
 515     exit for
 516     Call ok(false, "exit for not escaped the loop?")
 517 next
 518
 519 for x = 1 to 5 :
 520 :
 521 :   :exit for
 522     Call ok(false, "exit for not escaped the loop?")
 523 next
 524
 525 do while true
 526     for x = 1 to 100
 527         exit do
 528     next
 529 loop
 530
 531 if null then call ok(false, "if null evaluated")
 532
 533 while null
 534     call ok(false, "while null evaluated")
 535 wend
 536
 537 Call collectionObj.reset()
 538 y = 0
 539 for each x in collectionObj :
 540
 541    :y = y + 3
 542 next
 543 Call ok(y = 9, "y = " & y)
 544
 545 Call collectionObj.reset()
 546 y = 0
 547 x = 10
 548 z = 0
 549 for each x in collectionObj : z = z + 2
 550     y = y+1
 551     Call ok(x = y, "x <> y")
 552 next
 553 Call ok(y = 3, "y = " & y)
 554 Call ok(z = 6, "z = " & z)
 555 Call ok(getVT(x) = "VT_EMPTY*", "getVT(x) = " & getVT(x))
 556
 557 Call collectionObj.reset()
 558 y = false
 559 for each x in collectionObj
 560     if x = 2 then exit for
 561     y = 1
 562 next
 563 Call ok(y = 1, "y = " & y)
 564 Call ok(x = 2, "x = " & x)
 565
 566 Set obj = collectionObj
 567 Call obj.reset()
 568 y = 0
 569 x = 10
 570 for each x in obj
 571     y = y+1
 572     Call ok(x = y, "x <> y")
 573 next
 574 Call ok(y = 3, "y = " & y)
 575 Call ok(getVT(x) = "VT_EMPTY*", "getVT(x) = " & getVT(x))
 576
 577 x = false
 578 select case 3
 579     case 2
 580         Call ok(false, "unexpected case")
 581     case 2
 582         Call ok(false, "unexpected case")
 583     case 4
 584         Call ok(false, "unexpected case")
 585     case "test"
 586     case "another case"
 587         Call ok(false, "unexpected case")
 588     case 0, false, 2+1, 10
 589         x = true
 590     case ok(false, "unexpected case")
 591         Call ok(false, "unexpected case")
 592     case else
 593         Call ok(false, "unexpected case")
 594 end select
 595 Call ok(x, "wrong case")
 596
 597 x = false
 598 select case 3
 599     case 3
 600         x = true
 601 end select
 602 Call ok(x, "wrong case")
 603
 604 x = false
 605 select case 2+2
 606     case 3
 607         Call ok(false, "unexpected case")
 608     case else
 609         x = true
 610 end select
 611 Call ok(x, "wrong case")
 612
 613 y = "3"
 614 x = false
 615 select case y
 616     case "3"
 617         x = true
 618     case 3
 619         Call ok(false, "unexpected case")
 620 end select
 621 Call ok(x, "wrong case")
 622
 623 select case 0
 624     case 1
 625         Call ok(false, "unexpected case")
 626     case "2"
 627         Call ok(false, "unexpected case")
 628 end select
 629
 630 select case 0
 631 end select
 632
 633 x = false
 634 select case 2
 635     case 3,1,2,4: x = true
 636     case 5,6,7
 637         Call ok(false, "unexpected case")
 638 end select
 639 Call ok(x, "wrong case")
 640
 641 x = false
 642 select case 2: case 5,6,7: Call ok(false, "unexpected case")
 643     case 2,1,2,4
 644         x = true
 645     case else: Call ok(false, "unexpected case else")
 646 end select
 647 Call ok(x, "wrong case")
 648
 649 x = False
 650 select case 1  :
 651
 652     :case 3, 4 :
 653
 654
 655     case 5
 656 :
 657         Call ok(false, "unexpected case") :
 658     Case Else:
 659
 660         x = True
 661 end select
 662 Call ok(x, "wrong case")
 663
 664 if false then
 665 Sub testsub
 666     x = true
 667 End Sub
 668 end if
 669
 670 x = false
 671 Call testsub
 672 Call ok(x, "x is false, testsub not called?")
 673
 674 Sub SubSetTrue(v)
 675     Call ok(not v, "v is not true")
 676     v = true
 677 End Sub
 678
 679 x = false
 680 SubSetTrue x
 681 Call ok(x, "x was not set by SubSetTrue")
 682
 683 SubSetTrue false
 684 Call ok(not false, "false is no longer false?")
 685
 686 Sub SubSetTrue2(ByRef v)
 687     Call ok(not v, "v is not true")
 688     v = true
 689 End Sub
 690
 691 x = false
 692 SubSetTrue2 x
 693 Call ok(x, "x was not set by SubSetTrue")
 694
 695 Sub TestSubArgVal(ByVal v)
 696     Call ok(not v, "v is not false")
 697     v = true
 698     Call ok(v, "v is not true?")
 699 End Sub
 700
 701 x = false
 702 Call TestSubArgVal(x)
 703 Call ok(not x, "x is true after TestSubArgVal call?")
 704
 705 Sub TestSubMultiArgs(a,b,c,d,e)
 706     Call ok(a=1, "a = " & a)
 707     Call ok(b=2, "b = " & b)
 708     Call ok(c=3, "c = " & c)
 709     Call ok(d=4, "d = " & d)
 710     Call ok(e=5, "e = " & e)
 711 End Sub
 712
 713 Sub TestSubExit(ByRef a)
 714     If a Then
 715         Exit Sub
 716     End If
 717     Call ok(false, "Exit Sub not called?")
 718 End Sub
 719
 720 Call TestSubExit(true)
 721
 722 Sub TestSubExit2
 723     for x = 1 to 100
 724         Exit Sub
 725     next
 726 End Sub
 727 Call TestSubExit2
 728
 729 TestSubMultiArgs 1, 2, 3, 4, 5
 730 Call TestSubMultiArgs(1, 2, 3, 4, 5)
 731
 732 Sub TestSubLocalVal
 733     x = false
 734     Call ok(not x, "local x is not false?")
 735     Dim x
 736     Dim a,b, c
 737 End Sub
 738
 739 x = true
 740 y = true
 741 Call TestSubLocalVal
 742 Call ok(x, "global x is not true?")
 743
 744 Public Sub TestPublicSub
 745 End Sub
 746 Call TestPublicSub
 747
 748 Private Sub TestPrivateSub
 749 End Sub
 750 Call TestPrivateSub
 751
 752 if false then
 753 Function testfunc
 754     x = true
 755 End Function
 756 end if
 757
 758 x = false
 759 Call TestFunc
 760 Call ok(x, "x is false, testfunc not called?")
 761
 762 Function FuncSetTrue(v)
 763     Call ok(not v, "v is not true")
 764     v = true
 765 End Function
 766
 767 x = false
 768 FuncSetTrue x
 769 Call ok(x, "x was not set by FuncSetTrue")
 770
 771 FuncSetTrue false
 772 Call ok(not false, "false is no longer false?")
 773
 774 Function FuncSetTrue2(ByRef v)
 775     Call ok(not v, "v is not true")
 776     v = true
 777 End Function
 778
 779 x = false
 780 FuncSetTrue2 x
 781 Call ok(x, "x was not set by FuncSetTrue")
 782
 783 Function TestFuncArgVal(ByVal v)
 784     Call ok(not v, "v is not false")
 785     v = true
 786     Call ok(v, "v is not true?")
 787 End Function
 788
 789 x = false
 790 Call TestFuncArgVal(x)
 791 Call ok(not x, "x is true after TestFuncArgVal call?")
 792
 793 Function TestFuncMultiArgs(a,b,c,d,e)
 794     Call ok(a=1, "a = " & a)
 795     Call ok(b=2, "b = " & b)
 796     Call ok(c=3, "c = " & c)
 797     Call ok(d=4, "d = " & d)
 798     Call ok(e=5, "e = " & e)
 799 End Function
 800
 801 TestFuncMultiArgs 1, 2, 3, 4, 5
 802 Call TestFuncMultiArgs(1, 2, 3, 4, 5)
 803
 804 Function TestFuncLocalVal
 805     x = false
 806     Call ok(not x, "local x is not false?")
 807     Dim x
 808 End Function
 809
 810 x = true
 811 y = true
 812 Call TestFuncLocalVal
 813 Call ok(x, "global x is not true?")
 814
 815 Function TestFuncExit(ByRef a)
 816     If a Then
 817         Exit Function
 818     End If
 819     Call ok(false, "Exit Function not called?")
 820 End Function
 821
 822 Call TestFuncExit(true)
 823
 824 Function TestFuncExit2(ByRef a)
 825     For x = 1 to 100
 826         For y = 1 to 100
 827             Exit Function
 828         Next
 829     Next
 830     Call ok(false, "Exit Function not called?")
 831 End Function
 832
 833 Call TestFuncExit2(true)
 834
 835 Sub SubParseTest
 836 End Sub : x = false
 837 Call SubParseTest
 838
 839 Function FuncParseTest
 840 End Function : x = false
 841
 842 Function ReturnTrue
 843      ReturnTrue = false
 844      ReturnTrue = true
 845 End Function
 846
 847 Call ok(ReturnTrue(), "ReturnTrue returned false?")
 848
 849 Function SetVal(ByRef x, ByVal v)
 850     x = v
 851     SetVal = x
 852     Exit Function
 853 End Function
 854
 855 x = false
 856 ok SetVal(x, true), "SetVal returned false?"
 857 Call ok(x, "x is not set to true by SetVal?")
 858
 859 Public Function TestPublicFunc
 860 End Function
 861 Call TestPublicFunc
 862
 863 Private Function TestPrivateFunc
 864 End Function
 865 Call TestPrivateFunc
 866
 867 ' Stop has an effect only in debugging mode
 868 Stop
 869
 870 set x = testObj
 871 Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x=testObj) = " & getVT(x))
 872
 873 Set obj = New EmptyClass
 874 Call ok(getVT(obj) = "VT_DISPATCH*", "getVT(obj) = " & getVT(obj))
 875
 876 Class EmptyClass
 877 End Class
 878
 879 Set x = obj
 880 Call ok(getVT(x) = "VT_DISPATCH*", "getVT(x) = " & getVT(x))
 881
 882 Class TestClass
 883     Public publicProp
 884
 885     Private privateProp
 886
 887     Public Function publicFunction()
 888         privateSub()
 889         publicFunction = 4
 890     End Function
 891
 892     Public Property Get gsProp()
 893         gsProp = privateProp
 894         funcCalled = "gsProp get"
 895         exit property
 896         Call ok(false, "exit property not returned?")
 897     End Property
 898
 899     Public Default Property Get DefValGet
 900         DefValGet = privateProp
 901         funcCalled = "GetDefVal"
 902     End Property
 903
 904     Public Property Let DefValGet(x)
 905     End Property
 906
 907     Public publicProp2
 908
 909     Public Sub publicSub
 910     End Sub
 911
 912     Public Property Let gsProp(val)
 913         privateProp = val
 914         funcCalled = "gsProp let"
 915         exit property
 916         Call ok(false, "exit property not returned?")
 917     End Property
 918
 919     Public Property Set gsProp(val)
 920         funcCalled = "gsProp set"
 921         exit property
 922         Call ok(false, "exit property not returned?")
 923     End Property
 924
 925     Public Sub setPrivateProp(x)
 926         privateProp = x
 927     End Sub
 928
 929     Function getPrivateProp
 930         getPrivateProp = privateProp
 931     End Function
 932
 933     Private Sub privateSub
 934     End Sub
 935
 936     Public Sub Class_Initialize
 937         publicProp2 = 2
 938         privateProp = true
 939         Call ok(getVT(privateProp) = "VT_BOOL*", "getVT(privateProp) = " & getVT(privateProp))
 940         Call ok(getVT(publicProp2) = "VT_I2*", "getVT(publicProp2) = " & getVT(publicProp2))
 941         Call ok(getVT(Me.publicProp2) = "VT_I2", "getVT(Me.publicProp2) = " & getVT(Me.publicProp2))
 942     End Sub
 943
 944     Property Get gsGetProp(x)
 945         gsGetProp = x
 946     End Property
 947 End Class
 948
 949 Call testDisp(new testClass)
 950
 951 Set obj = New TestClass
 952
 953 Call ok(obj.publicFunction = 4, "obj.publicFunction = " & obj.publicFunction)
 954 Call ok(obj.publicFunction() = 4, "obj.publicFunction() = " & obj.publicFunction())
 955
 956 obj.publicSub()
 957 Call obj.publicSub
 958 Call obj.publicFunction()
 959
 960 Call ok(getVT(obj.publicProp) = "VT_EMPTY", "getVT(obj.publicProp) = " & getVT(obj.publicProp))
 961 obj.publicProp = 3
 962 Call ok(getVT(obj.publicProp) = "VT_I2", "getVT(obj.publicProp) = " & getVT(obj.publicProp))
 963 Call ok(obj.publicProp = 3, "obj.publicProp = " & obj.publicProp)
 964 obj.publicProp() = 3
 965
 966 Call ok(obj.getPrivateProp() = true, "obj.getPrivateProp() = " & obj.getPrivateProp())
 967 Call obj.setPrivateProp(6)
 968 Call ok(obj.getPrivateProp = 6, "obj.getPrivateProp = " & obj.getPrivateProp)
 969
 970 Dim funcCalled
 971 funcCalled = ""
 972 Call ok(obj.gsProp = 6, "obj.gsProp = " & obj.gsProp)
 973 Call ok(funcCalled = "gsProp get", "funcCalled = " & funcCalled)
 974 obj.gsProp = 3
 975 Call ok(funcCalled = "gsProp let", "funcCalled = " & funcCalled)
 976 Call ok(obj.getPrivateProp = 3, "obj.getPrivateProp = " & obj.getPrivateProp)
 977 Set obj.gsProp = New testclass
 978 Call ok(funcCalled = "gsProp set", "funcCalled = " & funcCalled)
 979
 980 x = obj
 981 Call ok(x = 3, "(x = obj) = " & x)
 982 Call ok(funcCalled = "GetDefVal", "funcCalled = " & funcCalled)
 983 funcCalled = ""
 984 Call ok(obj = 3, "(x = obj) = " & obj)
 985 Call ok(funcCalled = "GetDefVal", "funcCalled = " & funcCalled)
 986
 987 Call obj.Class_Initialize
 988 Call ok(obj.getPrivateProp() = true, "obj.getPrivateProp() = " & obj.getPrivateProp())
 989
 990 x = (New testclass).publicProp
 991
 992 Class TermTest
 993     Public Sub Class_Terminate()
 994         funcCalled = "terminate"
 995     End Sub
 996 End Class
 997
 998 Set obj = New TermTest
 999 funcCalled = ""
1000 Set obj = Nothing
1001 Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled)
1002
1003 Set obj = New TermTest
1004 funcCalled = ""
1005 Call obj.Class_Terminate
1006 Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled)
1007 funcCalled = ""
1008 Set obj = Nothing
1009 Call ok(funcCalled = "terminate", "funcCalled = " & funcCalled)
1010
1011 Call (New testclass).publicSub()
1012 Call (New testclass).publicSub
1013
1014 class PropTest
1015     property get prop0()
1016         prop0 = 1
1017     end property
1018
1019     property get prop1(x)
1020         prop1 = x+1
1021     end property
1022
1023     property get prop2(x, y)
1024         prop2 = x+y
1025     end property
1026 end class
1027
1028 set obj = new PropTest
1029
1030 call ok(obj.prop0 = 1, "obj.prop0 = " & obj.prop0)
1031 call ok(obj.prop1(3) = 4, "obj.prop1(3) = " & obj.prop1(3))
1032 call ok(obj.prop2(3,4) = 7, "obj.prop2(3,4) = " & obj.prop2(3,4))
1033 call obj.prop0()
1034 call obj.prop1(2)
1035 call obj.prop2(3,4)
1036
1037 x = "following ':' is correct syntax" :
1038 x = "following ':' is correct syntax" :: :
1039 :: x = "also correct syntax"
1040 rem another ugly way for comments
1041 x = "rem as simplestatement" : rem rem comment
1042 :
1043
1044 Set obj = new EmptyClass
1045 Set x = obj
1046 Set y = new EmptyClass
1047
1048 Call ok(obj is x, "obj is not x")
1049 Call ok(x is obj, "x is not obj")
1050 Call ok(not (obj is y), "obj is not y")
1051 Call ok(not obj is y, "obj is not y")
1052 Call ok(not (x is Nothing), "x is 1")
1053 Call ok(Nothing is Nothing, "Nothing is not Nothing")
1054 Call ok(x is obj and true, "x is obj and true is false")
1055
1056 Class TestMe
1057     Public Sub Test(MyMe)
1058         Call ok(Me is MyMe, "Me is not MyMe")
1059     End Sub
1060 End Class
1061
1062 Set obj = New TestMe
1063 Call obj.test(obj)
1064
1065 Call ok(getVT(test) = "VT_DISPATCH", "getVT(test) = " & getVT(test))
1066 Call ok(Me is Test, "Me is not Test")
1067
1068 Const c1 = 1, c2 = 2, c3 = -3
1069 Call ok(c1 = 1, "c1 = " & c1)
1070 Call ok(getVT(c1) = "VT_I2", "getVT(c1) = " & getVT(c1))
1071 Call ok(c3 = -3, "c3 = " & c3)
1072 Call ok(getVT(c3) = "VT_I2", "getVT(c3) = " & getVT(c3))
1073
1074 Const cb = True, cs = "test", cnull = null
1075 Call ok(cb, "cb = " & cb)
1076 Call ok(getVT(cb) = "VT_BOOL", "getVT(cb) = " & getVT(cb))
1077 Call ok(cs = "test", "cs = " & cs)
1078 Call ok(getVT(cs) = "VT_BSTR", "getVT(cs) = " & getVT(cs))
1079 Call ok(isNull(cnull), "cnull = " & cnull)
1080 Call ok(getVT(cnull) = "VT_NULL", "getVT(cnull) = " & getVT(cnull))
1081
1082 if false then Const conststr = "str"
1083 Call ok(conststr = "str", "conststr = " & conststr)
1084 Call ok(getVT(conststr) = "VT_BSTR", "getVT(conststr) = " & getVT(conststr))
1085 Call ok(conststr = "str", "conststr = " & conststr)
1086
1087 Sub ConstTestSub
1088     Const funcconst = 1
1089     Call ok(c1 = 1, "c1 = " & c1)
1090     Call ok(funcconst = 1, "funcconst = " & funcconst)
1091 End Sub
1092
1093 Call ConstTestSub
1094 Dim funcconst
1095
1096 ' Property may be used as an identifier (although it's a keyword)
1097 Sub TestProperty
1098     Dim Property
1099     PROPERTY = true
1100     Call ok(property, "property = " & property)
1101
1102     for property = 1 to 2
1103     next
1104 End Sub
1105
1106 Call TestProperty
1107
1108 Class Property
1109     Public Sub Property()
1110     End Sub
1111
1112     Sub Test(byref property)
1113     End Sub
1114 End Class
1115
1116 Class Property2
1117     Function Property()
1118     End Function
1119
1120     Sub Test(property)
1121     End Sub
1122
1123     Sub Test2(byval property)
1124     End Sub
1125 End Class
1126
1127 ' Array tests
1128
1129 Call ok(getVT(arr) = "VT_EMPTY*", "getVT(arr) = " & getVT(arr))
1130
1131 Dim arr(3)
1132 Dim arr2(4,3), arr3(5,4,3), arr0(0), noarr()
1133
1134 Call ok(getVT(arr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr) = " & getVT(arr))
1135 Call ok(getVT(arr2) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr2) = " & getVT(arr2))
1136 Call ok(getVT(arr0) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(arr0) = " & getVT(arr0))
1137 Call ok(getVT(noarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(noarr) = " & getVT(noarr))
1138
1139 Call testArray(1, arr)
1140 Call testArray(2, arr2)
1141 Call testArray(3, arr3)
1142 Call testArray(0, arr0)
1143 Call testArray(-1, noarr)
1144
1145 Call ok(getVT(arr(1)) = "VT_EMPTY*", "getVT(arr(1)) = " & getVT(arr(1)))
1146 Call ok(getVT(arr2(1,2)) = "VT_EMPTY*", "getVT(arr2(1,2)) = " & getVT(arr2(1,2)))
1147 Call ok(getVT(arr3(1,2,2)) = "VT_EMPTY*", "getVT(arr3(1,2,3)) = " & getVT(arr3(1,2,2)))
1148 Call ok(getVT(arr(0)) = "VT_EMPTY*", "getVT(arr(0)) = " & getVT(arr(0)))
1149 Call ok(getVT(arr(3)) = "VT_EMPTY*", "getVT(arr(3)) = " & getVT(arr(3)))
1150 Call ok(getVT(arr0(0)) = "VT_EMPTY*", "getVT(arr0(0)) = " & getVT(arr0(0)))
1151
1152 arr(2) = 3
1153 Call ok(arr(2) = 3, "arr(2) = " & arr(2))
1154 Call ok(getVT(arr(2)) = "VT_I2*", "getVT(arr(2)) = " & getVT(arr(2)))
1155
1156 arr3(3,2,1) = 1
1157 arr3(1,2,3) = 2
1158 Call ok(arr3(3,2,1) = 1, "arr3(3,2,1) = " & arr3(3,2,1))
1159 Call ok(arr3(1,2,3) = 2, "arr3(1,2,3) = " & arr3(1,2,3))
1160
1161 x = arr3
1162 Call ok(x(3,2,1) = 1, "x(3,2,1) = " & x(3,2,1))
1163
1164 Function getarr()
1165     Dim arr(3)
1166     arr(2) = 2
1167     getarr = arr
1168     arr(3) = 3
1169 End Function
1170
1171 x = getarr()
1172 Call ok(getVT(x) = "VT_ARRAY|VT_VARIANT*", "getVT(x) = " & getVT(x))
1173 Call ok(x(2) = 2, "x(2) = " & x(2))
1174 Call ok(getVT(x(3)) = "VT_EMPTY*", "getVT(x(3)) = " & getVT(x(3)))
1175
1176 x(1) = 1
1177 Call ok(x(1) = 1, "x(1) = " & x(1))
1178 x = getarr()
1179 Call ok(getVT(x(1)) = "VT_EMPTY*", "getVT(x(1)) = " & getVT(x(1)))
1180 Call ok(x(2) = 2, "x(2) = " & x(2))
1181
1182 x(1) = 1
1183 y = x
1184 x(1) = 2
1185 Call ok(y(1) = 1, "y(1) = " & y(1))
1186
1187 for x=1 to 1
1188     Dim forarr(3)
1189     if x=1 then
1190         Call ok(getVT(forarr(1)) = "VT_EMPTY*", "getVT(forarr(1)) = " & getVT(forarr(1)))
1191     else
1192         Call ok(forarr(1) = x, "forarr(1) = " & forarr(1))
1193     end if
1194     forarr(1) = x+1
1195 next
1196
1197 x=1
1198 Call ok(forarr(x) = 2, "forarr(x) = " & forarr(x))
1199
1200 Class ArrClass
1201     Dim classarr(3)
1202     Dim classnoarr()
1203     Dim var
1204
1205     Private Sub Class_Initialize
1206         Call ok(getVT(classarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(classarr) = " & getVT(classarr))
1207         Call testArray(-1, classnoarr)
1208         classarr(0) = 1
1209         classarr(1) = 2
1210         classarr(2) = 3
1211         classarr(3) = 4
1212     End Sub
1213
1214     Public Sub testVarVT
1215         Call ok(getVT(var) = "VT_ARRAY|VT_VARIANT*", "getVT(var) = " & getVT(var))
1216     End Sub
1217 End Class
1218
1219 Set obj = new ArrClass
1220 Call ok(getVT(obj.classarr) = "VT_ARRAY|VT_VARIANT", "getVT(obj.classarr) = " & getVT(obj.classarr))
1221 'todo_wine Call ok(obj.classarr(1) = 2, "obj.classarr(1) = " & obj.classarr(1))
1222
1223 obj.var = arr
1224 Call ok(getVT(obj.var) = "VT_ARRAY|VT_VARIANT", "getVT(obj.var) = " & getVT(obj.var))
1225 Call obj.testVarVT
1226
1227 Sub arrarg(byref refarr, byval valarr, byref refarr2, byval valarr2)
1228     Call ok(getVT(refarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(refarr) = " & getVT(refarr))
1229     Call ok(getVT(valarr) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr) = " & getVT(valarr))
1230     Call ok(getVT(refarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(refarr2) = " & getVT(refarr2))
1231     Call ok(getVT(valarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr2) = " & getVT(valarr2))
1232 End Sub
1233
1234 Call arrarg(arr, arr, obj.classarr, obj.classarr)
1235
1236 Sub arrarg2(byref refarr(), byval valarr(), byref refarr2(), byval valarr2())
1237     Call ok(getVT(refarr) = "VT_ARRAY|VT_BYREF|VT_VARIANT*", "getVT(refarr) = " & getVT(refarr))
1238     Call ok(getVT(valarr) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr) = " & getVT(valarr))
1239     Call ok(getVT(refarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(refarr2) = " & getVT(refarr2))
1240     Call ok(getVT(valarr2) = "VT_ARRAY|VT_VARIANT*", "getVT(valarr2) = " & getVT(valarr2))
1241 End Sub
1242
1243 Call arrarg2(arr, arr, obj.classarr, obj.classarr)
1244
1245 Sub testarrarg(arg(), vt)
1246     Call ok(getVT(arg) = vt, "getVT() = " & getVT(arg) & " expected " & vt)
1247 End Sub
1248
1249 Call testarrarg(1, "VT_I2*")
1250 Call testarrarg(false, "VT_BOOL*")
1251 Call testarrarg(Empty, "VT_EMPTY*")
1252
1253 Sub modifyarr(arr)
1254     'Following test crashes on wine
1255     'Call ok(arr(0) = "not modified", "arr(0) = " & arr(0))
1256     arr(0) = "modified"
1257 End Sub
1258
1259 arr(0) = "not modified"
1260 Call modifyarr(arr)
1261 Call ok(arr(0) = "modified", "arr(0) = " & arr(0))
1262
1263 arr(0) = "not modified"
1264 modifyarr(arr)
1265 Call todo_wine_ok(arr(0) = "not modified", "arr(0) = " & arr(0))
1266
1267 ' It's allowed to declare non-builtin RegExp class...
1268 class RegExp
1269      public property get Global()
1270          Call ok(false, "Global called")
1271          Global = "fail"
1272      end property
1273 end class
1274
1275 ' ...but there is no way to use it because builtin instance is always created
1276 set x = new RegExp
1277 Call ok(x.Global = false, "x.Global = " & x.Global)
1278
1279 reportSuccess()