Refactor expectError

We expect a specific error in a list of errors.

Added case for call on non callable symbol.

1 files changed, 43 insertions, 48 deletions

diff --git a/test/Language.hs b/test/Language.hs
index 247318f..7d814a7 100644
--- a/test/Language.hs
+++ b/test/Language.hs
@@ -3,6 +3,7 @@ module Language where
 import qualified Ast as A
 import Compiler
 import Control.Monad.State (evalState)
+import Data.Foldable (find)
 import qualified Error as E
 import Lexer (scan)
 import Parser (parse)
@@ -17,16 +18,18 @@ assertAst input expected = do
     Left e -> assertFailure $ show e
     Right ast -> assertEqual "" expected ast
 
-expectError :: String -> IO (Maybe E.Error)
-expectError input = do
+expectError :: String -> E.ErrorType -> Assertion
+expectError input etyp = do
   r <- return $ runParser (scan parse) () "test" input
   case r of
     Left e -> assertFailure $ show e
     Right ast -> do
       res <- return $ evalState (compileAll ast) startState
       case res of
-        Left (e : _) -> return $ Just e
-        Right _ -> return $ Nothing
+        Left e -> case (find (\(E.Error t _ _) -> t == etyp) e) of
+          Just _ -> return ()
+          Nothing -> assertFailure $ "expected " ++ show etyp ++ " didn't happen"
+        Right _ -> assertFailure "expected error, didn't happen"
 
 testCase1 =
   TestLabel "parse module" $
@@ -176,61 +179,52 @@ testCase11 =
 
 testCase12 =
   TestLabel "invalid return value (empty return)" $
-    TestCase $ do
-      e <-
-        expectError
-          "module main\n\
-          \def fn(): u8 { return; }"
-      case e of
-        Nothing -> assertFailure "expected error, didn't happen"
-        Just (E.Error E.TypeError _ _) -> return $ ()
+    TestCase $
+      expectError
+        "module main\n\
+        \def fn(): u8 { return; }"
+        E.TypeError
 
 testCase13 =
   TestLabel "invalid return value" $
-    TestCase $ do
-      e <-
-        expectError
-          "module main\n\
-          \def fn(): u16 { return 1; }"
-      case e of
-        Nothing -> assertFailure "expected error, didn't happen"
-        Just (E.Error E.TypeError _ _) -> return $ ()
+    TestCase $
+      expectError
+        "module main\n\
+        \def fn(): u16 { return 1; }"
+        E.TypeError
 
 testCase14 =
   TestLabel "return without function" $
-    TestCase $ do
-      e <-
-        expectError
-          "module main\n\
-          \return;"
-      case e of
-        Nothing -> assertFailure "expected error, didn't happen"
-        Just (E.Error E.UnexpectedReturn _ _) -> return $ ()
+    TestCase $
+      expectError
+        "module main\n\
+        \return;"
+        E.UnexpectedReturn
 
 testCase15 =
   TestLabel "symbol already defined" $
-    TestCase $ do
-      e <-
-        expectError
-          "module main\n\
-          \def fn() { }\n\
-          \def fn() { }"
-      case e of
-        Nothing -> assertFailure "expected error, didn't happen"
-        Just (E.Error E.AlreadyDefined _ pos) ->
-          if pos /= (newPos "test" 3 1) then assertFailure ("error position didn't match: " ++ show pos) else return $ ()
+    TestCase $
+      expectError
+        "module main\n\
+        \def fn() { }\n\
+        \def fn() { }"
+        E.AlreadyDefined
 
 testCase16 =
   TestLabel "parameter already defined" $
-    TestCase $ do
-      e <-
-        expectError
-          "module main\n\
-          \def fn(a: u8, a: u8) { }\n"
-      case e of
-        Nothing -> assertFailure "expected error, didn't happen"
-        Just (E.Error E.AlreadyDefined _ pos) ->
-          if pos /= (newPos "test" 2 15) then assertFailure ("error position didn't match: " ++ show pos) else return $ ()
+    TestCase $
+      expectError
+        "module main\n\
+        \def fn(a: u8, a: u8) { }\n"
+        E.AlreadyDefined
+
+testCase17 =
+  TestLabel "call on non callable" $
+    TestCase $
+      expectError
+        "module main\n\
+        \def fn(a: u8): u8 { return a(); }\n"
+        E.NonCallable
 
 language =
   [ testCase1,
@@ -248,5 +242,6 @@ language =
     testCase13,
     testCase14,
     testCase15,
-    testCase16
+    testCase16,
+    testCase17
   ]