diff options
author | Paweł Dybiec <pawel.to.malpa@gmail.com> | 2020-01-19 22:59:54 +0100 |
---|---|---|
committer | Paweł Dybiec <pawel.to.malpa@gmail.com> | 2020-01-19 22:59:54 +0100 |
commit | 0c815fa3eb480ae5e05370699cead004d81cf65c (patch) | |
tree | 93d52978256d18d5ab47f1e247fc31539166f3e4 /test | |
parent | More tests (diff) |
Add Except monad, and destructors for records and variants
Diffstat (limited to 'test')
-rw-r--r-- | test/TypecheckTest.hs | 44 |
1 files changed, 26 insertions, 18 deletions
diff --git a/test/TypecheckTest.hs b/test/TypecheckTest.hs index 299c8c0..4e410ed 100644 --- a/test/TypecheckTest.hs +++ b/test/TypecheckTest.hs @@ -2,33 +2,41 @@ module TypecheckTest where import Typecheck import Syntax +import Control.Monad.Except (runExcept) import Test.Hspec + + typecheckTest :: Spec typecheckTest = describe "inferExpr" $ do it "can infer variables" $ do - inferExpr (Var "a") [("a", TInt)] `shouldBe` Just TInt - inferExpr (Var "a") [("a", TRecord [("b",TInt)])] `shouldBe` (Just $ TRecord [("b",TInt)]) - inferExpr (Var "a") [("a", TVariant [("b",TInt)])] `shouldBe` (Just $ TVariant[("b",TInt)]) - inferExpr (Var "a") [("a", TPtr TInt)] `shouldBe` ( Just $ TPtr TInt ) + infer (Var "a") [("a", TInt)] `shouldBe` Just TInt + infer (Var "a") [("a", TRecord [("b",TInt)])] `shouldBe` (Just $ TRecord [("b",TInt)]) + infer (Var "a") [("a", TVariant [("b",TInt)])] `shouldBe` (Just $ TVariant[("b",TInt)]) + infer (Var "a") [("a", TPtr TInt)] `shouldBe` ( Just $ TPtr TInt ) it "shouldn't infer undefined variables" $ do - inferExpr (Var "a") [] `shouldBe` Nothing + infer (Var "a") [] `shouldBe` Nothing it "should be able to infer types of arithmetic expressions" $ do - inferExpr (IntLit 5) [] `shouldBe` (Just TInt) - inferExpr (Add (IntLit 1) (IntLit 3)) [] `shouldBe` (Just TInt) - inferExpr (Mult (IntLit 1) (IntLit 3)) [] `shouldBe` (Just TInt) - inferExpr (Neg (IntLit 3)) [] `shouldBe` (Just TInt) + infer (IntLit 5) [] `shouldBe` (Just TInt) + infer (Add (IntLit 1) (IntLit 3)) [] `shouldBe` (Just TInt) + infer (Mult (IntLit 1) (IntLit 3)) [] `shouldBe` (Just TInt) + infer (Neg (IntLit 3)) [] `shouldBe` (Just TInt) it "shouldn't be able to do arithmetic operations on pointer" $ do - inferExpr (Add (IntLit 1) (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing - inferExpr (Add (Var "a") (IntLit 1)) [("a",(TPtr TInt))] `shouldBe` Nothing - inferExpr (Mult (IntLit 1) (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing - inferExpr (Mult (Var "a") (IntLit 1)) [("a",(TPtr TInt))] `shouldBe` Nothing - inferExpr (Neg (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing + infer (Add (IntLit 1) (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing + infer (Add (Var "a") (IntLit 1)) [("a",(TPtr TInt))] `shouldBe` Nothing + infer (Mult (IntLit 1) (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing + infer (Mult (Var "a") (IntLit 1)) [("a",(TPtr TInt))] `shouldBe` Nothing + infer (Neg (Var "a")) [("a",(TPtr TInt))] `shouldBe` Nothing it "should infer compound types" $ do - inferExpr (Variant (TVariant [("Cons",TInt),("Cons2",TPtr TInt)]) "Cons" (IntLit 5)) [] `shouldBe` (Just $ TVariant [("Cons",TInt),("Cons2",TPtr TInt)]) - inferExpr (Record [("aa",Var "a"),("bb",Var "b")]) [("a",TInt), ("b",TPtr TInt)] `shouldBe` (Just $ TRecord [("aa",TInt),("bb",TPtr TInt)]) + infer (Variant (TVariant [("Cons",TInt),("Cons2",TPtr TInt)]) "Cons" (IntLit 5)) [] `shouldBe` (Just $ TVariant [("Cons",TInt),("Cons2",TPtr TInt)]) + infer (Record [("aa",Var "a"),("bb",Var "b")]) [("a",TInt), ("b",TPtr TInt)] `shouldBe` (Just $ TRecord [("aa",TInt),("bb",TPtr TInt)]) it "should unpack Ptr for every dereference" $ do - inferExpr (Deref (Var "a")) [("a",TPtr TInt)] `shouldBe` (Just TInt) - inferExpr (Deref (Var "a")) [("a",TPtr $ TPtr TInt)] `shouldBe` (Just $ TPtr TInt) + infer (Deref (Var "a")) [("a",TPtr TInt)] `shouldBe` (Just TInt) + infer (Deref (Var "a")) [("a",TPtr $ TPtr TInt)] `shouldBe` (Just $ TPtr TInt) + where + infer :: Expr -> Environment -> Maybe Typ + infer e env= eitherToMaybe $ runExcept $ inferExpr e env + eitherToMaybe (Right a) = Just a + eitherToMaybe (Left _) = Nothing |