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