########################################################################
# 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
  debug 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)
  
  $1="DOG"
  $2="dog"
  assert(string compare(1,2) == false)
  assert(insensitive string compare(1,2) == true)
  $2="cat"
  assert(insensitive 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"))

  # Case changing
  assert(string equal(string to lower($1="Hello World!"), $2="hello world!"))
  assert(string equal(string to upper($1="Don't Shout!"), $2="DON'T SHOUT!"))

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)
  
  assert(min(10, 20) == 10)
  assert(min(10, -20) == -20)
  assert(min(9, 8, 7, 8, 9) == 7)
  assert(max(10, 20) == 20)
  assert(max(10, -20) == 10)
  assert(max(9, 8, 7, 8, 9) == 9)
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

########################################################################

script, debug tests, begin
  assert(get calling script id(0) == @debug tests)
  assert(get calling script id(1) == @interpreter tests)
  assert(get calling script id    == @interpreter tests)
  assert(get calling script id(5) == 0)

  get script name(1, @debug tests)
  assert(string equal(1, $2="debugtests"))

  subscript, some subscript, begin
    subscript, some subsubscript, begin
      # Reference for subscripts not supported
      #assert(get calling script id(0) == @some subsubscript)
      #assert(get calling script id(1) == @some subscript)

      get script name(1, get calling script id(0))
      assert(string equal(1,$2="somesubsubscript"))

      get script name(1, get calling script id(1))
      assert(string equal(1,$2="somesubscript"))

      assert(get calling script id(2) == @debug tests)
      assert(get calling script id(3) == @interpreter tests)

      get script name(1, get calling script id(0))
      assert(string equal(1,$2="somesubsubscript"))

    end
    some subsubscript
  end
  some subscript
end
