-- Tests for TCL Subset.
-- Copyright 2011 Henry Strickland.
-- MIT License.

module Main
  where
import Control.Monad.Trans.Either
import Control.Monad.State
import Text.ParserCombinators.Parsec hiding (State)
import qualified Char(ord)
import qualified Data.Map as M
import qualified Numeric(readDec)
import qualified Debug.Trace(trace)
import qualified Picol501 as Tcl
import qualified System.Exit

main :: IO ()
main = do
  runTests
  putStrLn "ALL OK."

assert :: String -> Bool -> IO ()
assert name True = do
  putStrLn $ "#good# " ++ name
  return ()
assert name False = do
  error $ "FAILED: " ++ name
  return ()

goodScript expected script = do
  (result, terp) <- runStateT (Tcl.evalProcBody [] script []) Tcl.freshTerp
  case result of
    Left x -> error $ "FAILED: " ++ script ++ " ==>> " ++ show x
    Right x -> if x == expected
      then putStrLn $ "good: " ++ script ++ " ==>> " ++ show x
      else error $ "FAILED: " ++ script ++ " ==>> " ++ show x ++ " <<== Expected " ++ show expected

runTests = do
  assert "foo" $ 1 == 1
  assert "bar" $ 1 == 1
  goodScript "3" "+ 1 2"
  goodScript "0" "catch {+ 0}"
  goodScript "0" "catch {+ 1 2 3}"
  goodScript "1" "catch {foo 1 2 3}"
  goodScript "15" "+ 1 2 [+ 3 4 5]"
  goodScript "42" "if [== 3 3] {+ 42} else {+ 13}"
  goodScript "42" "if [< 2 3] {+ 42} else {+ 13}"
  goodScript "42" "if [> 4 3] {+ 42} else {+ 13}"
  goodScript "42" "proc plus {a b} { + $a $b } ; plus 38 4"
  goodScript "42" "proc plus \"a b\" { + $a $b } ; plus 38 4"
  goodScript "0" "proc zero {a} {if [< $a 1] {+ $a} else {zero [+ -1 $a]}} ; zero 3"
