aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/Spec.hs55
-rw-r--r--test/TestUtils.hs9
2 files changed, 55 insertions, 9 deletions
diff --git a/test/Spec.hs b/test/Spec.hs
index 2a1e54c..82b0813 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -2,6 +2,7 @@
import Test.HUnit
import Control.Monad.Except
import qualified Data.Map as M
+import qualified Data.List as L
import Builtins
import Tokenizer ( tokenize )
import Parser ( parse )
@@ -19,11 +20,15 @@ parseTests = testGroup "parse" [
do (got, _) <- expectSuccessL M.empty $ parse (map makeNonsenseToken ["(", "+", "1", "2", ")"])
let expected = [astFunctionCall
[ astSymbol "+", astInteger 1, astInteger 2 ]]
- assertEqual "" got expected
+ assertEqual "" expected got,
- , do got <- expectErrorL M.empty $ parse (map makeNonsenseToken ["(", "+", "1", "2"])
+ do got <- expectErrorL M.empty $ parse (map makeNonsenseToken ["(", "+", "1", "2"])
let expected = "unbalanced function call"
- assertEqual "" got expected
+ assertEqual "" expected got,
+
+ do (got, _) <- expectSuccessL M.empty $ parse (map makeNonsenseToken ["\"1000\n2000\n3000\""])
+ let expected = [astString "1000\n2000\n3000"]
+ assertEqual "" expected got
]
evaluateTests = testGroup "evaluate" [
@@ -32,8 +37,8 @@ evaluateTests = testGroup "evaluate" [
evaluate (astFunctionCall [astSymbol "+", astInteger 1, astInteger 2])
let expectedAST = astInteger 3
- assertEqual "" gotAST expectedAST
- assertEqual "" (M.keys gotEnv) (M.keys env)
+ assertEqual "" expectedAST gotAST
+ assertEqual "" (M.keys env) (M.keys gotEnv)
]
e2eTests = testGroup "e2e" [
@@ -43,8 +48,44 @@ e2eTests = testGroup "e2e" [
runInlineScript "<test>" script1
let expectedEnvKeys = ["-", "sub2"]
- assertEqual "" (M.keys gotEnv) expectedEnvKeys
- assertEqual "" (last gotASTs) (astInteger 1)
+ assertEqual "" expectedEnvKeys (M.keys gotEnv)
+ assertEqual "" (astInteger 1) (last gotASTs),
+
+ do let env = M.empty :: Env
+ let script1 = "(record A foo bar)"
+ (gotASTs, LState { stateEnv = gotEnv }) <- expectSuccessL env $
+ runInlineScript "<test>" script1
+
+ let expectedEnvKeys = L.sort ["A/create", "A/get-foo", "A/set-foo", "A/get-bar", "A/set-bar"]
+ assertEqual "" expectedEnvKeys (L.sort $ M.keys gotEnv)
+ assertEqual "" astUnit (last gotASTs),
+
+ do let env = M.empty :: Env
+ let script1 = "(record A foo)\n(let a (A/create 123))\n(A/get-foo a)"
+ (gotASTs, _) <- expectSuccessL env $
+ runInlineScript "<test>" script1
+
+ let expectedLastAST = ast $ ASTInteger 123
+ assertEqual "" expectedLastAST (last gotASTs),
+
+ do let env = M.fromList [builtinSortByFirst] :: Env
+ let script1 = "(sort-by-first [[2 1] [3 2] [1 3]])"
+ (gotASTs, _) <- expectSuccessL env $
+ runInlineScript "<test>" script1
+
+ let expectedLastAST = astVector $
+ [astVector [astInteger 1, astInteger 3],
+ astVector [astInteger 2, astInteger 1],
+ astVector [astInteger 3, astInteger 2]]
+ assertEqual "" expectedLastAST (last gotASTs),
+
+ do let env = M.fromList [builtinAdd2, builtinMultiply2] :: Env
+ let script1 = "(let f (\\[x] (let y (+ x 1)) (let z (+ 3 y)) (* 2 z)))\n(f 1)"
+ (gotASTs, _) <- expectSuccessL env $
+ runInlineScript "<test>" script1
+
+ let expectedLastAST = astInteger 10
+ assertEqual "" expectedLastAST (last gotASTs)
]
testGroup label xs = TestLabel label $ TestList $ map TestCase xs
diff --git a/test/TestUtils.hs b/test/TestUtils.hs
index 84f95bf..672f801 100644
--- a/test/TestUtils.hs
+++ b/test/TestUtils.hs
@@ -8,13 +8,18 @@ testConfig = Config {
configScriptFileName = Nothing,
configVerboseMode = False,
configShowHelp = False,
- configPrintEvaled = False,
+ configPrintEvaled = PrintEvaledOff,
configPrintCallStack = False,
configUseREPL = False
}
testRunL :: Env -> LContext a -> IO (Either LException (a, LState))
-testRunL env = runL LState { stateConfig = testConfig, stateEnv = env, stateDepth = 0 }
+testRunL env = runL LState {
+ stateConfig = testConfig,
+ stateEnv = env,
+ stateDepth = 0,
+ statePure = Impure
+}
expectSuccessL :: Env -> LContext a -> IO (a, LState)
expectSuccessL env lc =