💕 Adding assignment 2

2024-09-12 13:54:13 +02:00
parent 3722040d09
commit b061522fd1
9 changed files with 321 additions and 0 deletions
--- a/a2/a2-handout/src/APL/Eval_Tests.hs
+++ b/a2/a2-handout/src/APL/Eval_Tests.hs
@ -0,0 +1,84 @@
+module APL.Eval_Tests (tests) where
+
+import APL.AST (Exp (..))
+import APL.Eval (Error, Val (..), eval, runEval)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
+
+eval' :: Exp -> Either Error Val
+eval' = runEval . eval
+
+evalTests :: TestTree
+evalTests =
+  testGroup
+    "EValuation"
+    [ testCase "Add" $
+        eval' (Add (CstInt 2) (CstInt 5))
+          @?= Right (ValInt 7),
+      --
+      testCase "Add (wrong type)" $
+        eval' (Add (CstInt 2) (CstBool True))
+          @?= Left "Non-integer operand",
+      --
+      testCase "Sub" $
+        eval' (Sub (CstInt 2) (CstInt 5))
+          @?= Right (ValInt (-3)),
+      --
+      testCase "Div" $
+        eval' (Div (CstInt 7) (CstInt 3))
+          @?= Right (ValInt 2),
+      --
+      testCase "Div0" $
+        eval' (Div (CstInt 7) (CstInt 0))
+          @?= Left "Division by zero",
+      --
+      testCase "Pow" $
+        eval' (Pow (CstInt 2) (CstInt 3))
+          @?= Right (ValInt 8),
+      --
+      testCase "Pow0" $
+        eval' (Pow (CstInt 2) (CstInt 0))
+          @?= Right (ValInt 1),
+      --
+      testCase "Pow negative" $
+        eval' (Pow (CstInt 2) (CstInt (-1)))
+          @?= Left "Negative exponent",
+      --
+      testCase "Eql (false)" $
+        eval' (Eql (CstInt 2) (CstInt 3))
+          @?= Right (ValBool False),
+      --
+      testCase "Eql (true)" $
+        eval' (Eql (CstInt 2) (CstInt 2))
+          @?= Right (ValBool True),
+      --
+      testCase "If" $
+        eval' (If (CstBool True) (CstInt 2) (Div (CstInt 7) (CstInt 0)))
+          @?= Right (ValInt 2),
+      --
+      testCase "Let" $
+        eval' (Let "x" (Add (CstInt 2) (CstInt 3)) (Var "x"))
+          @?= Right (ValInt 5),
+      --
+      testCase "Let (shadowing)" $
+        eval'
+          ( Let
+              "x"
+              (Add (CstInt 2) (CstInt 3))
+              (Let "x" (CstBool True) (Var "x"))
+          )
+          @?= Right (ValBool True),
+      --
+      testCase "Lambda/Apply" $
+        eval'
+          (Apply (Lambda "x" (Mul (Var "x") (Var "x"))) (CstInt 4))
+          @?= Right (ValInt 16),
+      --
+      testCase "TryCatch" $
+        eval'
+          (TryCatch (Div (CstInt 7) (CstInt 0)) (CstBool True))
+          @?= Right (ValBool True)
+    ]
+
+tests :: TestTree
+tests = testGroup "APL" [evalTests]