negative tests

src/Juvix/Compiler/Tree/Evaluator.hs

@@ -66,8 +66,12 @@ hEval hout tab = eval' [] mempty
                     IntAdd -> goIntBinop (+) arg1 arg2
                     IntSub -> goIntBinop (-) arg1 arg2
                     IntMul -> goIntBinop (*) arg1 arg2
-                    IntDiv -> goIntBinop quot arg1 arg2
-                    IntMod -> goIntBinop rem arg1 arg2
+                    IntDiv
+                      | arg2 == ValInteger 0 -> evalError "division by zero"
+                      | otherwise -> goIntBinop quot arg1 arg2
+                    IntMod
+                      | arg2 == ValInteger 0 -> evalError "division by zero"
+                      | otherwise -> goIntBinop rem arg1 arg2
                     IntLe -> goIntCmpBinop (<=) arg1 arg2
                     IntLt -> goIntCmpBinop (<) arg1 arg2
                     ValEq

test/Tree/Eval.hs

@@ -1,7 +1,8 @@
 module Tree.Eval where
 
 import Base
+import Tree.Eval.Negative qualified as N
 import Tree.Eval.Positive qualified as P
 
 allTests :: TestTree
-allTests = testGroup "JuvixTree evaluation" [P.allTests]
+allTests = testGroup "JuvixTree evaluation" [P.allTests, N.allTests]

test/Tree/Eval/Base.hs

@@ -73,3 +73,25 @@ doEval ::
   FunctionInfo ->
   IO (Either TreeError Value)
 doEval hout tab funInfo = catchEvalErrorIO (hEvalIO stdin hout tab funInfo)
+
+treeEvalErrorAssertion :: Path Abs File -> (String -> IO ()) -> Assertion
+treeEvalErrorAssertion mainFile step = do
+  step "Parse"
+  s <- readFile (toFilePath mainFile)
+  case runParser (toFilePath mainFile) s of
+    Left err -> assertFailure (show (pretty err))
+    Right tab ->
+      case tab ^. infoMainFunction of
+        Just sym -> do
+          withTempDir'
+            ( \dirPath -> do
+                let outputFile = dirPath <//> $(mkRelFile "out.out")
+                hout <- openFile (toFilePath outputFile) WriteMode
+                step "Evaluate"
+                r' <- doEval hout tab (lookupFunInfo tab sym)
+                hClose hout
+                case r' of
+                  Left _ -> assertBool "" True
+                  Right _ -> assertFailure "no error"
+            )
+        Nothing -> assertFailure "no main function"

test/Tree/Eval/Negative.hs

@@ -0,0 +1,65 @@
+module Tree.Eval.Negative where
+
+import Base
+import Tree.Eval.Base
+
+data NegTest = NegTest
+  { _name :: String,
+    _relDir :: Path Rel Dir,
+    _file :: Path Rel File
+  }
+
+root :: Path Abs Dir
+root = relToProject $(mkRelDir "tests/Tree/negative")
+
+testDescr :: NegTest -> TestDescr
+testDescr NegTest {..} =
+  let tRoot = root <//> _relDir
+      file' = tRoot <//> _file
+   in TestDescr
+        { _testName = _name,
+          _testRoot = tRoot,
+          _testAssertion = Steps $ treeEvalErrorAssertion file'
+        }
+
+allTests :: TestTree
+allTests =
+  testGroup
+    "JuvixTree negative tests"
+    (map (mkTest . testDescr) tests)
+
+tests :: [NegTest]
+tests =
+  [ NegTest
+      "Test001: Division by zero"
+      $(mkRelDir ".")
+      $(mkRelFile "test001.jvt"),
+    NegTest
+      "Test002: Arithmetic operations on non-numbers"
+      $(mkRelDir ".")
+      $(mkRelFile "test002.jvt"),
+    NegTest
+      "Test003: Case on non-data"
+      $(mkRelDir ".")
+      $(mkRelFile "test003.jvt"),
+    NegTest
+      "Test004: If on non-boolean"
+      $(mkRelDir ".")
+      $(mkRelFile "test004.jvt"),
+    NegTest
+      "Test005: No matching case branch"
+      $(mkRelDir ".")
+      $(mkRelFile "test005.jvt"),
+    NegTest
+      "Test006: Invalid closure call"
+      $(mkRelDir ".")
+      $(mkRelFile "test006.jvt"),
+    NegTest
+      "Test007: Call: wrong number of arguments"
+      $(mkRelDir ".")
+      $(mkRelFile "test007.jvt"),
+    NegTest
+      "Test008: Closure call: wrong number of arguments"
+      $(mkRelDir ".")
+      $(mkRelFile "test008.jvt")
+  ]

tests/Tree/negative/test001.jvt

@@ -0,0 +1,9 @@
+-- division by zero
+
+function f(x : integer) : integer {
+  div(2, x)
+}
+
+function main() : * {
+  call[f](0)
+}

tests/Tree/negative/test002.jvt

@@ -0,0 +1,5 @@
+-- arithmetic operations on non-numbers
+
+function main() : * {
+  add(2, calloc[main]())
+}

tests/Tree/negative/test003.jvt

@@ -0,0 +1,13 @@
+-- case on non-data
+
+type list {
+  nil : list;
+  cons : * -> list -> list;
+}
+
+function main() : * {
+  case[list](3) {
+    nil: 0
+    cons: 1
+  }
+}

tests/Tree/negative/test004.jvt

@@ -0,0 +1,8 @@
+-- if on non-boolean
+
+function main() : * {
+  br(3) {
+    true: 0
+    false: 1
+  }
+}

tests/Tree/negative/test005.jvt

@@ -0,0 +1,12 @@
+-- no matching case branch
+
+type list {
+  nil : list;
+  cons : * -> list -> list;
+}
+
+function main() : * {
+  case[list](alloc[nil]()) {
+    cons: 1
+  }
+}

tests/Tree/negative/test006.jvt

@@ -0,0 +1,5 @@
+-- invalid closure call
+
+function main() : * {
+  call(2, 1)
+}

tests/Tree/negative/test007.jvt

@@ -0,0 +1,9 @@
+-- call: wrong number of arguments
+
+function f(x : *) : * {
+  x
+}
+
+function main() : * {
+  call[f](10, 11)
+}

tests/Tree/negative/test008.jvt

@@ -0,0 +1,9 @@
+-- closure call: wrong number of arguments
+
+function f(x : *) : * {
+  x
+}
+
+function main() : * {
+  call(calloc[f](), 10, 11)
+}