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