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


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

script, interpreter tests, begin
  encoding tests
  lexer tests
  string tests
  math tests
  flow tests
  subscript 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(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))
    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)
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, 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
  orphaned blocks
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)
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)

  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, 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


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