diff options
| -rw-r--r-- | test/Spec.hs | 55 | ||||
| -rw-r--r-- | test/TestUtils.hs | 9 | ||||
| -rw-r--r-- | todo.md | 2 |
3 files changed, 57 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 = @@ -2,6 +2,8 @@ In order of priority +- Fix `let` bug + - Error in: 3:e2e:4 unexpected error: symbol y not defined in environment - Memoize pure top-level let-bindings with `let memo` - Add a `catch` builtin for catching fatal errors - Write function let expressions properly using lookups |