import Test.HUnit import qualified Data.Map as Map import qualified Data.Set as Set import Constraints import Types import Obj import Parsing import Infer import Eval main :: IO () main = do _ <- runTestTT (groupTests "Constraints" testConstraints) return () groupTests :: String -> [Test] -> Test groupTests label testCases = TestList (zipWith TestLabel (map ((\s -> label ++ " Test " ++ s) . show) [1..]) testCases) -- | Helper functions for testing unification of Constraints isUnificationFailure :: Either UnificationFailure TypeMappings -> Bool isUnificationFailure (Left _) = True isUnificationFailure (Right _) = False assertUnificationFailure :: [Constraint] -> Test assertUnificationFailure constraints = TestCase $ assertBool "Failure" (isUnificationFailure (solve constraints)) assertSolution :: [Constraint] -> [(String, Ty)] -> Test assertSolution constraints solution = TestCase $ assertEqual "Solution" (Right (Map.fromList solution)) (solve constraints) -- | A dummy XObj x = XObj (External Nothing) Nothing Nothing -- | Some type variables t0 = VarTy "t0" t1 = VarTy "t1" t2 = VarTy "t2" t3 = VarTy "t3" -- | Test constraints testConstraints = [testConstr1, testConstr2, testConstr3, testConstr4, testConstr5 ,testConstr6, testConstr7, testConstr8, testConstr9, testConstr10 ,testConstr11, testConstr12, testConstr13 ,testConstr20, testConstr21, testConstr22, testConstr23, testConstr24 ,testConstr30, testConstr31, testConstr32, testConstr33 ,testConstr34, testConstr35 ] testConstr1 = assertUnificationFailure [Constraint FloatTy IntTy x x OrdNo] testConstr2 = assertSolution [Constraint IntTy t0 x x OrdNo] [("t0", IntTy)] testConstr3 = assertSolution [Constraint t0 IntTy x x OrdNo] [("t0", IntTy)] testConstr4 = assertSolution [Constraint t0 t1 x x OrdNo, Constraint t0 IntTy x x OrdNo] [("t0", IntTy), ("t1", IntTy)] testConstr5 = assertSolution [Constraint t0 t1 x x OrdNo, Constraint t1 IntTy x x OrdNo] [("t0", IntTy), ("t1", IntTy)] testConstr6 = assertSolution [Constraint t0 t1 x x OrdNo, Constraint t1 t3 x x OrdNo, Constraint t2 IntTy x x OrdNo, Constraint t3 IntTy x x OrdNo] [("t0", IntTy), ("t1", IntTy), ("t2", IntTy), ("t3", IntTy)] testConstr7 = assertUnificationFailure [Constraint t0 IntTy x x OrdNo, Constraint t0 FloatTy x x OrdNo] testConstr8 = assertSolution [Constraint t0 IntTy x x OrdNo, Constraint t0 t0 x x OrdNo] [("t0", IntTy)] testConstr9 = assertSolution [Constraint t0 IntTy x x OrdNo, Constraint t0 t1 x x OrdNo] [("t0", IntTy), ("t1", IntTy)] testConstr10 = assertSolution [Constraint (PointerTy (VarTy "a")) (PointerTy (VarTy "b")) x x OrdNo] [("a", (VarTy "a")), ("b", (VarTy "a"))] testConstr11 = assertSolution [Constraint (PointerTy (VarTy "a")) (PointerTy (StructTy "Monkey" [])) x x OrdNo] [("a", (StructTy "Monkey" []))] testConstr12 = assertSolution [Constraint t1 (PointerTy (StructTy "Array" [IntTy])) x x OrdNo ,Constraint t1 (PointerTy t2) x x OrdNo] [("t1", (PointerTy (StructTy "Array" [IntTy]))) ,("t2", (StructTy "Array" [IntTy]))] testConstr13 = assertSolution [Constraint t1 CharTy x x OrdNo ,Constraint t1 CharTy x x OrdNo] [("t1", CharTy)] -- -- Should collapse type variables into minimal set: -- testConstr10 = assertSolution -- [Constraint t0 t1 x x, Constraint t1 t2 x x, Constraint t2 t3 x x OrdNo] -- [("t0", VarTy "t0"), ("t1", VarTy "t0"), ("t2", VarTy "t0")] -- m7 = solve ([Constraint t1 t2 x x, Constraint t0 t1 x x OrdNo]) -- Struct types testConstr20 = assertSolution [Constraint t0 (StructTy "Vector" [t1]) x x OrdNo ,Constraint t0 (StructTy "Vector" [IntTy]) x x OrdNo] [("t0", (StructTy "Vector" [IntTy])), ("t1", IntTy)] testConstr21 = assertSolution [Constraint t1 (StructTy "Array" [t2]) x x OrdNo ,Constraint t1 (StructTy "Array" [t3]) x x OrdNo ,Constraint t3 BoolTy x x OrdNo] [("t1", (StructTy "Array" [BoolTy])) ,("t2", BoolTy) ,("t3", BoolTy)] testConstr22 = assertSolution [Constraint t1 (StructTy "Array" [t2]) x x OrdNo ,Constraint t2 (StructTy "Array" [t3]) x x OrdNo ,Constraint t3 FloatTy x x OrdNo] [("t1", (StructTy "Array" [(StructTy "Array" [FloatTy])])) ,("t2", (StructTy "Array" [FloatTy])) ,("t3", FloatTy)] testConstr23 = assertUnificationFailure [Constraint (StructTy "Array" [t1]) (StructTy "Array" [t2]) x x OrdNo ,Constraint t1 IntTy x x OrdNo ,Constraint t2 FloatTy x x OrdNo] testConstr24 = assertUnificationFailure [Constraint t2 FloatTy x x OrdNo ,Constraint t1 IntTy x x OrdNo ,Constraint (StructTy "Array" [t1]) (StructTy "Array" [t2]) x x OrdNo] -- m9 = solve [Constraint (StructTy "Vector" [IntTy]) (StructTy "Vector" [t1]) x x OrdNo] -- m10 = solve [Constraint (StructTy "Vector" [t1]) (StructTy "Vector" [t2]) x x OrdNo] -- Func types testConstr30 = assertSolution [Constraint t2 (FuncTy [t0] t1) x x OrdNo ,Constraint t2 (FuncTy [IntTy] BoolTy) x x OrdNo] [("t0", IntTy), ("t1", BoolTy), ("t2", (FuncTy [IntTy] BoolTy))] testConstr31 = assertSolution [Constraint (FuncTy [t0] t1) (FuncTy [IntTy] BoolTy) x x OrdNo] [("t0", IntTy), ("t1", BoolTy)] testConstr32 = assertSolution [Constraint t0 (FuncTy [IntTy] BoolTy) x x OrdNo] [("t0", (FuncTy [IntTy] BoolTy))] testConstr33 = assertSolution [Constraint t1 (FuncTy [t2] IntTy) x x OrdNo ,Constraint t1 (FuncTy [t3] IntTy) x x OrdNo ,Constraint t3 BoolTy x x OrdNo] [("t1", (FuncTy [BoolTy] IntTy)) ,("t2", BoolTy) ,("t3", BoolTy)] testConstr34 = assertSolution [Constraint (VarTy "a") (StructTy "Pair" [(VarTy "x0"), (VarTy "y0")]) x x OrdNo ,Constraint (StructTy "Array" [(VarTy "a")]) (StructTy "Array" [(StructTy "Pair" [(VarTy "x1"), (VarTy "y1")])]) x x OrdNo] [("a", (StructTy "Pair" [(VarTy "x0"), (VarTy "y0")])) ,("x0", (VarTy "x0")) ,("y0", (VarTy "y0")) ,("x1", (VarTy "x0")) ,("y1", (VarTy "y0")) ] -- Same as testConstr34, except everything is wrapped in refs testConstr35 = assertSolution [Constraint (RefTy (VarTy "a")) (RefTy (StructTy "Pair" [(VarTy "x0"), (VarTy "y0")])) x x OrdNo ,Constraint (RefTy (StructTy "Array" [(VarTy "a")])) (RefTy (StructTy "Array" [(StructTy "Pair" [(VarTy "x1"), (VarTy "y1")])])) x x OrdNo] [("a", (StructTy "Pair" [(VarTy "x0"), (VarTy "y0")])) ,("x0", (VarTy "x0")) ,("y0", (VarTy "y0")) ,("x1", (VarTy "x0")) ,("y1", (VarTy "y0")) ]