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()