######################################################################## # This file contains testcases for the script interpreter and HSpeak. # It can compiled either as part of autotest.hss (run by autotest.rpg) # or independently, but compiling hstests_standalone.hss. # # These tests are very incomplete! # include a file with UTF-16 encoding include, "utf16 encoding test.hss" include, mixed line endings.hss ######################################################################## # Only use globals between 200-300 and 5000-6000 here. Others are used # in autotest.hss. global variable(200, ticker 0) global variable(201, ticker 1) global variable(202, ticker 2) global variable(203, expected ticker 0) global variable(204, expected ticker 1) global variable(205, tick counter slice) global variable(206, a global) global variable(207, another global) global variable(5000, global 5000) #Array of 20 globals starting at 5000 ######################################################################## script, interpreter tests, begin encoding tests lexer tests string tests math tests parser tests flow tests subscript tests random tests end ######################################################################## script, elseif A, x, begin if(x == 0) then( return(1) ) elseif(x == 1) then( return(2) ) else( return(3) ) end script, elseif B, x, begin if(x == 0) elseif(x == 1) then( return(2) ) end script, elseif C, x, begin if(x == 0) elseif(x == 1) else( return(3) ) end script, elseif tests, begin $0="elseif tests" assert(elseif A(0) == 1) assert(elseif A(1) == 2) assert(elseif A(2) == 3) assert(elseif B(0) == 0) assert(elseif B(1) == 2) assert(elseif B(2) == 0) assert(elseif C(0) == 0) assert(elseif C(1) == 0) assert(elseif C(2) == 3) end ######################################################################## script, switch A, x, begin return(1) switch (x) do( case(5) do() case(zero) case(2) return(100) return(101) case(7) return(-1) while(1) do(continue(2)) return(-1) case(1) return(102) case(3, 4, 2) return(103) break return(104) case(6, else) return(99) ) end script, switch B, x, begin return(1) switch(x) do( case(5) do() case(10) continue case(7) do(continue) case(2) do( return(100) break return(101) ) case(1) return(102) case((2+1), 2*2, zero) if(x) then(return(103)) else(return(104)) case(9) continue case(8) continue else(return(99)) ) end script, switch tests, begin $0="switch tests" assert(switch A(0) == 101) assert(switch A(1) == 102) assert(switch A(2) == 101) assert(switch A(3) == 103) assert(switch A(4) == 103) assert(switch A(5) == 1) assert(switch A(6) == 99) assert(switch A(7) == 102) assert(switch A(8) == 99) assert(switch B(0) == 104) assert(switch B(1) == 102) assert(switch B(2) == 100) assert(switch B(3) == 103) assert(switch B(4) == 103) assert(switch B(5) == 1) assert(switch B(6) == 99) assert(switch B(7) == 100) assert(switch B(8) == 99) assert(switch B(9) == 99) assert(switch B(10) == 100) end ######################################################################## script, bad break, begin break(1) end script, bad continue, begin continue(1) end # HSpeak used to allow orphaned then/else blocks, which act like do(), # except for the purpose of break/continue. # This can't actually be compiled without commenting out the # '{then/else} should follow an if' checks in normalize_flow_control script, orphaned blocks, begin # variable(dummytrue, dummyfalse, happened) # dummytrue := true # if(dummytrue) then (assert(true), happened += 1) # else (assert(false)) # else (happened += 10) # assert(happened == 11) # if(dummyfalse) then (assert(false)) # else (happened += 100) # else (happened += 1000) # then(happened += 10000) # assert(happened == 11111) end script, exit tests, begin subscript, return 0, begin exit() end subscript, return 1, begin exit(1) end subscript, return 2, begin return(2) exit end assert(return 0 == 0) assert(return 1 == 1) assert(return 2 == 2) variable(ctr1, ctr2, ctr3, ctr4) subscript, nesting exit, begin variable(i, j) for (i, 1, 3) do ( for (j, 1, 3) do ( ctr1 += i if (i == 2) then (exit) ctr2 += 1 ) ctr3 += 1 ) ctr4 += 1 end nesting exit assert(ctr1 == 5) assert(ctr2 == 3) assert(ctr3 == 1) assert(ctr4 == 0) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 end # This script does quite a bit more testing of continue than break. script, continue break tests, begin variable(ctr1, ctr2, ctr3, ctr4) subscript, simple continue test, begin variable(i) for (i, 1, 4) do ( continue ctr1 += 1 ) ctr2 := i end simple continue test assert(ctr1 == 0) assert(ctr2 == 5) ctr1 := 0 ctr2 := 0 subscript, simple break test, begin variable(i) for (i, 1, 4) do ( ctr1 += 1 break ctr1 += 1 ) ctr2 := i end simple break test assert(ctr1 == 1) assert(ctr2 == 1) ctr1 := 0 ctr2 := 0 subscript, conditional continue test, begin variable(i) for (i, 1, 4) do ( if (i == 3) then (continue (1)) ctr1 += i ) ctr2 := i end conditional continue test assert(ctr1 == 7) assert(ctr2 == 5) ctr1 := 0 ctr2 := 0 # Check only the topmost loop is exited subscript, basic nesting continue test, begin variable(i, j) for (i, 1, 3) do ( for (j, 2, 4) do ( ctr1 += 1 if (j > i) then (continue) ctr2 += 1 ) ctr3 += 10 ) end basic nesting continue test assert(ctr1 == 9) assert(ctr2 == 3) assert(ctr3 == 30) ctr1 := 0 ctr2 := 0 ctr3 := 0 subscript, continue 2 test, begin variable(i, j) for (i, 1, 4) do ( for (j, 1, 4) do ( if (j > i) then (continue (2)) ctr1 += 1 ) ctr2 += 1 ) end continue 2 test assert(ctr1 == 10) assert(ctr2 == 1) ctr1 := 0 ctr2 := 0 subscript, continue while test, begin variable(i, j) i := 10 while (i -= 1) do ( ctr1 += 1 if (i > 4) then (continue (1)) ctr2 += i ) end continue while test assert(ctr1 == 9) assert(ctr2 == 10) ctr1 := 0 ctr2 := 0 subscript, break while test, begin variable(i, j) i := 4 while (i -= 1) do ( ctr1 += 1 if (i == 1) then (break (1)) ctr2 += i ) end break while test assert(ctr1 == 3) assert(ctr2 == 5) ctr1 := 0 ctr2 := 0 subscript, while for continue 2 test, begin variable(i, j) i := 5 while (i) do ( i -= 1 ctr1 += 1 for (j, 0, 3) do ( ctr2 += 1 continue (2) ctr3 += 1 ) ctr4 += 1 ) end while for continue 2 test assert(ctr1 == 5) assert(ctr2 == 5) assert(ctr3 == 0) assert(ctr4 == 0) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 subscript, nested while for continue test 2, begin variable(i, j) i := 10 while (i) do ( ctr1 += 1 for (j, -2, 0) do ( ctr2 += 1 if (j) then (i -= 1) else (continue (2)) ctr3 += 1 continue ) ctr4 += 1 ) end nested while for continue test 2 assert(ctr1 == 5) assert(ctr2 == 15) assert(ctr3 == 10) assert(ctr4 == 0) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 subscript, continue break do test, begin variable(i) i := 0 ctr1 += 1 do ( i += 1 ctr2 += i if (i == 3) then (break) continue ctr3 += 1 ) ctr4 += 1 end continue break do test assert(ctr1 == 1) assert(ctr2 == 6) assert(ctr3 == 0) assert(ctr4 == 1) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 subscript, continue break nested do test, begin variable(i, j) i := 0 do ( i += 1 ctr1 += i j := 0 do ( j += 1 ctr2 += j if (i == 1) then (continue (2)) if (i == 3) then (break (2)) if (j < 2) then (continue) ctr3 += 1 ) ctr4 += 1 continue ) end continue break nested do test assert(ctr1 == 6) assert(ctr2 == 5) assert(ctr3 == 1) assert(ctr4 == 1) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 # continue(0) is illegal, but if you ignore it it does nothing subscript, continue 0 test, begin do ( ctr1 += 1 continue(0) ctr2 += 1 break ) end write general(205, 0) # genCurrentDebugMode, hide errors (release mode) continue 0 test write general(205, 1) # show errors (debug mode) assert(ctr1 == 1) assert(ctr2 == 1) ctr1 := 0 ctr2 := 0 # break(0) is illegal, but if you ignore it it does nothing subscript, break 0 test, begin do ( ctr1 += 10 break(0) ctr2 += 10 break ) end write general(205, 0) # genCurrentDebugMode, hide errors (release mode) break 0 test write general(205, 1) # show errors (debug mode) assert(ctr1 == 10) assert(ctr2 == 10) ctr1 := 0 ctr2 := 0 # Regular continue/break inside switch is tested in switch tests subscript, for switch continue 2 test, begin variable(i, j) for (i, 0, 3) do ( ctr1 += i switch (i) do ( case (1) do ( ctr2 += 1 continue ctr2 += 1 ) case (3) do ( ctr1 += 10 continue (2) ) case (else) do ( ctr3 += 1 continue ctr3 += 1 ) ) ctr4 += 1 ) ctr4 += 10 end for switch continue 2 test assert(ctr1 == 26) assert(ctr2 == 1) assert(ctr3 == 2) assert(ctr4 == 12) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 subscript, for switch break 2 test, begin variable(i, j) for (i, 0, 3) do ( ctr1 += i switch (i) do ( case (1) do ( ctr2 += 1 break ctr2 += 1 ) case (3) do ( ctr1 += 10 break (2) ) case (else) do ( ctr3 += 1 break ctr3 += 1 ) ) ctr4 += 1 ) ctr4 += 10 end for switch break 2 test assert(ctr1 == 16) assert(ctr2 == 1) assert(ctr3 == 2) assert(ctr4 == 13) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 # Test that breaking/continuing through if/then/else works subscript, much nesting test, begin variable(i, j, t, f) t := true for (i, 1, 4) do ( # i=1: ctr1 += 1, ctr2 += 2, ctr3 += 122 # i=2: ctr1 += 2, ctr2 += 8, ctr3 += 200 # i=3: ctr1 += 3, ctr2 += 9 # i=4: ctr1 += 4, ctr2 += 16 if (t) then ( ctr1 += i for (j, 1, 2) do ( if (f) then (ctr4 += 1) else ( ctr2 += i^2 switch (i) do ( case (2) continue (2) case (5) ctr4 += 1 case (3) continue (3) case (4) break (3) ) ctr3 += i ) ctr3 += i * 10 ) ctr3 += i * 100 ) else ( ctr4 += 1 ) ) end much nesting test assert(ctr1 == 10) assert(ctr2 == 35) assert(ctr3 == 322) assert(ctr4 == 0) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 subscript, variable continue test, begin variable(i, j) for (i, 1, 2) do ( ctr1 += 1 for (j, 1, 5) do ( ctr2 += 1 continue (j) ctr3 += 1 ) ctr4 += 1 ) end variable continue test assert(ctr1 == 2) assert(ctr2 == 4) assert(ctr3 == 0) assert(ctr4 == 0) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 subscript, variable break test, begin variable(i, j) for (i, 1, 3) do ( ctr1 += 1 for (j, 1, 5) do ( ctr2 += 1 break (i) ctr3 += 1 ) ctr4 += 1 ) end variable break test assert(ctr1 == 2) assert(ctr2 == 2) assert(ctr3 == 0) assert(ctr4 == 1) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 subscript, variable continue test 2, begin variable(i, j, k, n) n := -1 for (i, 1, 2) do ( for (j, 1, 2) do ( n += 1 # n==0: ctr1 += 2, ctr2 += 2, ctr3 += 1 # n==1: ctr1 += 2, ctr3 += 1 # after n==1: ctr4 += 1 # n==2, n==3: ctr1 += 1 for (k, 1, 2) do ( ctr1 += 1 if (n) then (continue (n)) ctr2 += 1 ) ctr3 += 1 ) ctr4 += 1 ) end variable continue test 2 assert(ctr1 == 6) assert(ctr2 == 2) assert(ctr3 == 2) assert(ctr4 == 1) ctr1 := 0 ctr2 := 0 ctr3 := 0 ctr4 := 0 end ######################################################################## script, flow tests, begin variable(var1) # for loop creates some state which can be corrupted for (var1, 0, 6) do ( bad break # Causes an error #bad continue ) elseif tests switch tests continue break tests orphaned blocks exit tests end ######################################################################## # These are in addition to the tests in parser_tests.hss, which are only compiled, not executed. script, parser tests, begin variable (x) (((x := true))) (assert(x)) ($1="42") assert(string compare(1, $2="42")) end ######################################################################## plotscript, ¿ƒüñÑÿ sÇ®¡ÞΤ ηªɱE, begin return (42) end script, encoding tests, begin $0="encoding tests" variable (Über) Über := 12 for (über, über, über + 4) do () assert(Über == 17) # Lowercase form in Latin-1, uppercase not variable (Ÿve) ÿve := 0 assert(¿ƒüñÑÿ sÇ®¡ÞΤ ηªɱE == 42) end ######################################################################## script, lexer tests, begin # Check number parsing # We don't actually care that any of this is done at runtime # instead of compile time; id is only avoid "always false" warnings subscript, id, x (return (x)) assert(1 000 == id(1000)) assert(- 1 000 == id(0 -- 1000)) # tab assert(0x0 == id(0)) assert(0x 000 == id(0)) assert(0x 100 == id(256)) assert(0XABc == id(2748)) assert(- 0x 100 == id(-256)) assert(0xffffffff == id(-1)) assert(0x80000000 == id(-2147483648)) assert(-0xabcedf0 == id(-180153840)) assert(-0xffffffff == id(1)) assert(0x 100 == id(256)) assert(0b1 == id(1)) assert(0b1001010110011010011011111110101 == id(1254963189)) assert(0b11001010110011010011011111110101 == id(-892520459)) assert(0o1777 == id(1023)) assert(-0o1777 == id(-1023)) end ######################################################################## script, string tests, begin # This tests only pure string manipulation stuff. # plotstring-specific stuff is tested in "plotstr tests", while loading strings # from the game is in "string load tests" # Still many untested including: searchstring, numberfromstring, globalstostring $0="String tests", trace(0) $1="" $2="" assert(string compare(1,2)) $1="a" $2="A" assert(string compare(1,2) == false) $1=" .~fooy" $2=" .~fooY" assert(string compare(1,2) == false) # Check HSpeak encodes Unicode correctly, replacing unrepresentable characters with '?' $1=" ¡éÖœ£" # tab, space, exclamation $2="‰Œẽñ" # characters above U+00FF $3="???ñ" trace(3) assert(string compare(2, 3)) 3 $= 1 3 $+ 2 trace(3) trace value(string length(3)) assert(string length(3) == 11) assert(ascii from string(3, 1) == 9) assert(ascii from string(3, 2) == 32) assert(ascii from string(3, 3) == 161) assert(ascii from string(3, 4) == 233) assert(ascii from string(3, 10) == 63) assert(ascii from string(3, 11) == 241) assert($1="foo" == 1) assert($1+"bar" == 1) # higher IDs $95="a " $96="" appendascii(96, 97) $96+" " assert(string compare(95, 96)) # string sprintf string sprintf(1, $2=" test ") assert(string compare(1, 2)) $2="%%" $3="%" string sprintf(1, 2) assert(string compare(1, 3)) $2=" test %d " $3=" test -24 " string sprintf(1, 2, -24) assert(string compare(1, 3)) $2=" test %d%d%d%d%d" $3=" test 1-2-3-4-5" string sprintf(1, 2, 1, -2, -3, -4, -5) assert(string compare(1, 3)) $2="test (%s)" $3="test (test (%s))" string sprintf(1, 2, 2) assert(string compare(1, 3)) $2=" test%c " $3=" testA " string sprintf(1, 2, 65) assert(string compare(1, 3)) $2=" test %x %x " $3=" test 1abcdef ffffffff " string sprintf(1, 2, 28036591, -1) assert(string compare(1, 3)) # Tests UTF-16 encoding, but uses strings assert(that script in the other file == 91) # appendnumber subscript, check, begin string sprintf(10, $99="'%s' == '%s'", 2, 3) return(string compare(2, 3)) clearstring(2) end $2="existing " append number(2, 42) , $3="existing 42", assert(check()) append number(2, 0) , $3="0", assert(check()) append number(2, 65) , $3="65", assert(check()) append number(2, 2147483647) , $3="2147483647", assert(check()) append number(2, -2147483648) , $3="-2147483648", assert(check()) append number(2, -1, 2) , $3="-1", assert(check()) append number(2, 1234, 3) , $3="1234", assert(check()) append number(2, 65, 4) , $3=" 65", assert(check()) append number(2, 65, 4, true) , $3="0065", assert(check()) append number(2, -65, 4) , $3=" -65", assert(check()) append number(2, -65, 4, true) , $3="-065", assert(check()) append number(2, 65, -4) , $3="65 ", assert(check()) append number(2, 65, -4, true) , $3="65 ", assert(check()) append number(2, -65, -4) , $3="-65 ", assert(check()) append number(2, -65, -4) , $3="-65 ", assert(check()) # trim string $1 = " this silly \nexample \t \n" trim string(1) $2 = "this silly \nexample" assert(string equal(1, 2)) trim string(1, 3, 9) $2 = "is silly " assert(string equal(1, 2)) # Blanking out the string trim string(1, 10, 5) # Start just past end $2 = "" assert(string equal(1, 2)) $1 = "secret" trim string(1, 1, 0) assert(string equal(1, 2)) $1 = "Qux" # A start index = 0 is treated as 1... trim string(1, 0, 2) trace(1) $2 = "Qu" assert(string equal(1, 2)) # ...but start = -1 is equivalent to trimstring(id)! $2 = " a " trim string(2, -1, 2) $1 = "a" assert(string equal(1, 2)) # replace substring $1 = "This is an example of replace substring" assert(replace substring (1, $2="is", $3="iiss") == 2) # Note that although "example" contains "exampl", it isn't replaced again with "examplee" assert(string equal(1, $4="Thiiss iiss an example of replace substring")) $1 = "AAABaaAA" assert(replace substring (1, $2="AA", $3="CA", 2) == 2) # Do only 2 replacements # Again, Aaab becomes CAab but the new Aa isn't replaced, because part of it was a replacement assert(string equal(1, $4="CAABaaCA")) $1 = "AaabaAaa" assert(replace substring (1, $2="AA", $3="CA", -1, true) == 3) # Case insensitive assert(string equal(1, $4="CAabCACA")) end ######################################################################## # Very incomplete # This script tests basic operations work script, math tests, begin $0="math tests" # These tests have to be carefully written to not contain any constant # expressions that HSpeak will optimise out variable(n, m) assert(n == 0) n := 10 assert(n == 10) assert(n + 5 == 15) assert(n -- 15 == -5) assert(n * -1 == -10) assert(abs(-1*n) == 10) assert(abs(n) == 10) assert(sign(n) == 1) assert(sign(n--10) == 0) assert(sign(-1*n) == -1) n += 1 assert(n == 11) n -= 10 assert(n == 1) assert((m := 3) == 3) assert((m -= 6) == -3) # mod and divide n := -9 assert(n / 10 == 0) assert(n, mod, 10 == -9) assert(n / 9 == -1) assert(n, mod, 9 == 0) assert(n / 5 == -1) assert(n, mod, 5 == -4) assert(n / -9 == 1) assert(n, mod, -9 == 0) assert(n / -10 == 0) assert(n, mod, -10 == -9) # This brackets are mandatory, := is left-associative n := (m := 9) assert(m == 9) assert(n == 9) n += (m += 3) assert(m == 12) assert(n == 21) n -= (m -= 1) assert(m == 11) assert(n == 10) assert(another global == 0) another global := 10 assert(another global == 10) assert(read global(@another global) == 10) write global(@another global, 4) assert(another global == 4) logical math tests larger math tests assert(multdiv(10, 20, 30) == 7) assert(multdiv(1, 499, 1000) == 0) assert(multdiv(1, 500, 1000) == 1) assert(multdiv(1, 501, 1000) == 1) assert(multdiv(-1, 500, 1000) == 0) assert(multdiv(1 000 000, 1 000 000, -1 000) == -1 000 000 000) assert(multdiv(1 000 000, 1 000 000, 1) == 2147483647) assert(multdiv(1 000 000, -1 000 000, 1) == -2147483648) end # Return number of bits in an integer. Does NOT work for negative numbers! # Adapted from the "Software Optimization Guide for AMD Athlon 64 and Opteron Processors" script, bitcount, v, begin v := v -- ((v / 2), and, 0x55555555) v := (v, and, 0x33333333) + ((v / 2^2), and, 0x33333333) return (((v + (v / 2^4), and, 0xF0F0F0F) * 0x1010101) / 2^24) end # This script tests that whole routines work correctly script, larger math tests, begin assert(bitcount(0) == 0) assert(bitcount(0x70000000) == 3) assert(bitcount(0x11111111) == 8) assert(bitcount(0x107030ff) == 1+3+2+4+4) end script, logical math tests, begin # These tests are written under the assumption that a future version of HamsterSpeak # might have true/false values which are equal but not identical to 1/0. variable (nz, z, t, f) z := 0 nz := -2 # Equal to 1,xor,-1 t := true f := false assert(t) assert(nz) assert(z == false) assert(f == 0) assert(t == 1) assert(0 == f) assert(1 == t) assert(t <> f) assert(f <> t) assert(t <> -1) assert(t <> nz) assert(2 * f == 0) assert(f * 2 == 0) assert(2 * t == 2) assert(t * 2 == 2) assert(f + t == t) assert(t + t == 2) # not assert(not(f) == true) assert(not(z) == true) assert(not(not(z)) == false) assert(not(t) == false) assert(not(nz) == false) assert(not(not(nz)) == true) # && assert((f && f) == false) assert((z && z) == false) assert((f && z) == false) assert((z && f) == false) assert((t && 0) == false) assert((t && f) == false) assert((0 && t) == false) assert((f && t) == false) assert((nz && t) == true) assert((t && nz) == true) assert((nz && nz) == true) assert((nz && 256) == true) assert((t && t) == true) # || assert((f || f) == false) assert((z || z) == false) assert((f || z) == false) assert((z || f) == false) assert((t || 0) == true) assert((t || f) == true) assert((0 || t) == true) assert((f || t) == true) assert((nz || t) == true) assert((t || nz) == true) assert((nz || nz) == true) assert((nz || 256) == true) assert((t || t) == true) # ^^ assert((f ^^ f) == false) assert((z ^^ z) == false) assert((f ^^ z) == false) assert((z ^^ f) == false) assert((t ^^ 0) == true) assert((t ^^ f) == true) assert((0 ^^ t) == true) assert((f ^^ t) == true) assert((nz ^^ t) == false) assert((t ^^ nz) == false) assert((nz ^^ nz) == false) assert((nz ^^ 256) == false) assert((t ^^ t) == false) # Check hspeak's optimiser assert((0 && 0) == f) assert((2 && 0) == f) assert((0 && 2) == f) assert((2 && 4) == t) assert((0 || 0) == f) assert((4 || 0) == t) assert((0 || 4) == t) assert((2 || 4) == t) assert((0 ^^ 0) == f) assert((2 ^^ 0) == t) assert((0 ^^ 2) == t) assert((2 ^^ 4) == f) assert((false && false) == f) assert((2 && false) == f) assert((false && 2) == f) assert((2 && 4) == t) assert((false || false) == f) assert((4 || false) == t) assert((0 || true) == t) assert((true || true) == t) assert((0 ^^ 0) == f) assert((true ^^ 0) == t) assert((0 ^^ true) == t) assert((true ^^ true) == f) # Test shortcut evaluation variable (calls, failure) subscript, tcall, begin calls += 1 return (true) end subscript, fcall, begin calls += 1 end subscript, nevercalled, begin failure := true end assert((1 || nevercalled) == t) assert((0 && nevercalled) == f) assert((tcall || nevercalled) == t) assert(calls == 1) assert((fcall && nevercalled) == f) assert(calls == 2) assert(failure == false) # Nesting assert(((1 || nevercalled) || nevercalled) == t) assert(((0 && nevercalled) && nevercalled) == f) assert(((1 && (0 && nevercalled)) && nevercalled) == f) assert(((2*t && (f*2 && nevercalled)) && nevercalled) == f) # Testing mixture of math ops that are fast-pathed by the interpreter and logical ops and calls that aren't calls := 0 assert(nz && (1 + (fcall || t))) assert(calls == 1) assert(2 * (nz && (1 + (fcall || t)) && (nz * (t && tcall) * nz)) == 2) assert(calls == 3) assert(not(((t || nevercalled) * 10) * (tcall && 1) -- 10)) assert(calls == 4) assert(failure == false) calls := 0 if (1 && 1 && 1 && 1 && fcall && 1) then (failure := true) else (calls += 1) if (1 && 1 && 1 && tcall || 1 && nevercalled) then (calls += 1) else (failure := true) if (0 || 0 || 0 || 0 || tcall || 0) then (calls += 1) else (failure := true) assert(calls == 6) assert(failure == false) end ######################################################################## script, subscript tests, begin $0="subscript tests" variable(var1, var2) assert(sscript 1 == 2) assert(var1 == 1) subscript, sscript 1, begin var1 := 1 return (2) end subscript, sscript 2, arg=42, begin variable(x) var1 := arg x := var1 + 1 var1 += x end sscript 2(2) assert(var1 == 5) sscript 2 assert(var1 == 85) subscript, sscript 3, begin subscript, ssscript 1, arg2, begin x += arg2 + 10 end variable(x) x := 1 ssscript 1 (100) var2 := x end sscript 3 assert(var2 == 111) # test maximum nesting depth (4) a global := -1 subscript, sscript 4, arg1, begin variable(v0,v1) v0 := 5 subscript, ssscript, arg2, begin variable(v2) subscript, sssscript, arg3, begin variable(v3) subscript, ssssscript, arg4, begin # returns arg4 * 10 + 5 assert(a global == -1) a global := -2 assert(arg4 == 1234) variable(v4) #trace value(v4, arg4, v0) v4 += arg4 * 5 + v0 for (v0, v0, 1, -1) do (v4 += arg4) # v4 += 5 * arg4 #tracevalue(v0, v4, arg4 * 10 + 5) assert(v4 == arg4 * 10 + 5) var1 := var2 return(v4) end assert(arg3 == 123) v1 := 1002 return(ssssscript(arg3 * 10 + 4)) end assert(arg2 == 12) return(sssscript(arg2 * 10 + 3)) end assert(read global(@a global) == -1) return (ssscript(arg1 * 10 + 2)) assert(v0 == 0) # 1 past end of for loop (so 1 - 1) assert(v1 == 1002) end assert(sscript4(1) == 12345) assert(var1 == 111) assert(a global == -2) # break stops at a script boundary variable(var3) subscript, break subscript, begin break(4) var3 := 1 end for (var1, 0, 6) do ( break subscript var2 += 1 ) assert(var1 == 7) assert(var2 == 111 + 7) assert(var3 == 0) # Test call patterns other than being called by parent... # Recursion subscript, fib, x, begin variable(ret) if (x <= 2) then (ret += 1) else ( x -= 1 ret += fib(x) x -= 1 ret += fib(x) ) return(ret) end assert(fib(10) == 55) # All 4 directions of call between a script and its subscript assert(inside-outside fib(10) == 55) # Calling a sibling subscript or a sibling of a parent subscript (another fibonacci) var1 := 0 # temporary subscript, sibling 1, n, begin variable(ret) subscript, niece, k, begin if (k <= 2) then ( ret += 1 ) elseif (k, mod, 2) then ( ret += sibling 1(k -- 1) k -= 1 ret += sibling 2(k -- 1) ) else ( ret += sibling 2(k -- 1) k -= 1 ret += sibling 1(k -- 1) ) end niece(n) return(ret) end subscript, sibling 2, n, begin if (n <= 2) then (var1 += 1) else ( variable(ret) ret += sibling 1(n -- 2) var1 += sibling 1(n -- 1) var1 += ret ) return(var1) var1 := 0 end assert(sibling1(10) == 55) subscript scope tests(1) end # Test that inner variables shadow outer ones script, subscript scope tests, arg, begin variable(v1) v1 := 42 subscript, sub1, arg, begin assert(arg == 2) variable(v1) assert(v1 == 0) v1 := 63 assert(v1 == 63) end assert(arg == 1) sub1(2) assert(arg == 1) assert(v1 == 42) subscript, sub2, arg, begin variable(v1) subscript, sub3, v1, begin v1 += 5 subscript, sub4, arg () assert(arg == 100) for(arg, 0, 32) do () end assert(v1 == 0) sub3(10) assert(v1 == 0) assert(arg == 33) end sub2(100) assert(v1 == 42) end # A very weird way to compute fibonacci numbers script, inside-outside fib, n, begin variable(x) subscript, inside fib, begin variable(y) if (n <= 2) then ( x += 1 ) else ( n -= 1 y += inside fib() #n -- 1) n += 1 x += inside-outside fib(n -- 2) + y ) end if (n <= 2) then (exit returning (1)) n -= 1 inside fib() n -= 1 x += inside-outside fib(n) return(x) end ######################################################################## script, random tests, begin variable(i, x, outliers) # Test random() range for (i, 1, 100) do ( x := random(-3, 10) assert(x >= -3 && x <= 10) x := random(20, 2) assert(x >= 2 && x <= 20) ) # Edge cases for (i, 1, 10) do ( assert(random(0, 0) == 0) # In fact hspeak optimises this to a constant assert(random(-1, -1) == -1) x := random(-2, -1) assert(x >= -2 && x <= -1) x := random(-1, -2) assert(x >= -2 && x <= -1) ) # A simple test that random() is uniform for (i, 1, 10) do ( write global(@global 5000 + i, 0) ) for (i, 1, 500) do ( x := random(1, 10) write global(@global 5000 + x, read global(@global 5000 + x) + 1) ) for (i, 1, 10) do ( x := read global(@global 5000 + i) # 99.995% chance of the value being in this interval assert(x >= 25 && x <= 78) # 99.1% chance of the value being outside this interval outliers += (x < 34 || x > 68) ) assert(outliers <= 2) # "random choice" variable(bin1, bin2, bin3) assert(random choice() == 0) for (i, 1, 100) do ( assert(random choice(-1) == -1) switch(random choice(100, -100, 0)) do ( case(100) bin1 += 1 case(-100) bin2 += 1 case(0) bin3 += 1 case(else) assert(false) ) ) # 99.995% chance of the values being in this interval assert(bin1 >= 16 && bin1 <= 53) assert(bin2 >= 16 && bin2 <= 53) assert(bin3 >= 16 && bin3 <= 53) end ########################################################################