Commit 106037bb authored by Jan-Hendrik Matthes's avatar Jan-Hendrik Matthes 😄

Adjust the tests for the improved subsumption

parent d18d2539
......@@ -182,6 +182,7 @@ passInfos = map mkPassTest
, "ScottEncoding"
, "SelfExport"
, "SpaceLeak"
, "Subsumption"
, "TermInv"
, "TyConsTest"
, "TypedExpr"
......@@ -296,15 +297,7 @@ failInfos = map (uncurry mkFailTest)
]
)
, ("IncompatibleTypes",
[ "Type error in application"
, "applyFun idBool"
, "Type error in application"
, "applyFun idFun"
, "Type error in application"
, "trueFun False"
, "Type error in application"
, "applyEqFun ((==) :: Bool -> Bool -> Bool)"
, "Type error in equation"
[ "Type error in equation"
, "whereTest = whereTest'"
]
)
......@@ -328,6 +321,19 @@ failInfos = map (uncurry mkFailTest)
, ("RankNTypes", ["Arbitrary-rank types are not supported in standard Curry."])
, ("RecordLabelIDs", ["Multiple declarations of `RecordLabelIDs.id'"])
, ("RecursiveTypeSyn", ["Mutually recursive synonym and/or renaming types A and B (line 12.6)"])
, ("Subsumption",
[ "Type error in application"
, "applyFun idFun"
, "Type error in application"
, "applyFun idBool"
, "Type error in application"
, "applyEqFun ((==) :: Bool -> Bool -> Bool)"
, "Type error in application"
, "trueFun False"
, "Type error in application"
, "fun1 fun2"
]
)
, ("SyntaxError", ["Type error in application"])
, ("TypedFreeVariables",
["Variable x has a polymorphic type", "Type error in equation"]
......
{-# LANGUAGE RankNTypes #-}
idBool :: Bool -> Bool
idBool = id
applyFun :: (forall a. a -> a) -> b -> b
applyFun f x = f x
applyFunBoolTest :: Bool
applyFunBoolTest = applyFun idBool True
idFun :: (a -> a) -> (a -> a)
idFun f = f
applyFunTest :: Bool
applyFunTest = applyFun idFun True
trueFun :: (forall a. Eq a => a) -> Bool
trueFun _ = True
trueFunTest :: Bool
trueFunTest = trueFun False
applyEqFun :: Eq a => (forall a. Eq a => a -> a -> Bool) -> a -> a -> Bool
applyEqFun f x y = x `f` y
applyEqFunTest :: Bool
applyEqFunTest = applyEqFun ((==) :: Bool -> Bool -> Bool) True False
whereTest :: (forall a. a -> a) -> (Char, Bool)
whereTest = whereTest'
where
......
{-# LANGUAGE RankNTypes #-}
applyFun :: (forall a. a -> a) -> b -> b
applyFun f x = f x
idFun :: (a -> a) -> (a -> a)
idFun f = f
applyFunTest :: Bool
applyFunTest = applyFun idFun True
idBool :: Bool -> Bool
idBool = id
applyFunBoolTest :: Bool
applyFunBoolTest = applyFun idBool True
applyEqFun :: Eq a => (forall a. Eq a => a -> a -> Bool) -> a -> a -> Bool
applyEqFun f x y = x `f` y
applyEqFunTest :: Bool
applyEqFunTest = applyEqFun ((==) :: Bool -> Bool -> Bool) True False
trueFun :: (forall a. Eq a => a) -> Bool
trueFun _ = True
trueFunTest :: Bool
trueFunTest = trueFun False
fun1 :: ((forall a b. Eq a => a -> b) -> Bool) -> Bool
fun1 _ = True
fun2 :: (forall a b. a -> b) -> Bool
fun2 _ = True
subsumTest1 :: Bool
subsumTest1 = fun1 fun2
......@@ -8,4 +8,4 @@ funF :: (a -> b) -> a -> b
funF g a = g a
funHTest :: Int
funHTest = funH id 4 4
funHTest = funH (\x -> error "fail") 4 4
{-# LANGUAGE RankNTypes #-}
fun :: ((forall a b. a -> b) -> Bool) -> Bool
fun _ = True
funPred :: ((forall a b. Eq a => a -> b) -> Bool) -> Bool
funPred _ = True
fun1 :: (forall a b. [Maybe a] -> [Maybe b]) -> Bool
fun1 _ = True
fun2 :: (forall a. [Maybe a] -> [Maybe a]) -> Bool
fun2 _ = True
fun3 :: (forall a. Eq a => a -> a) -> Bool
fun3 _ = True
fun4 :: (forall a b. Eq a => a -> b) -> Bool
fun4 _ = True
fun5 :: (forall a b. Ord a => a -> b) -> Bool
fun5 _ = True
fun6 :: (forall a b. (Eq a, Ord b) => a -> b) -> Bool
fun6 _ = True
fun7 :: (forall a. Eq a => a -> Int) -> Bool
fun7 _ = True
fun8 :: (a -> b) -> Bool
fun8 _ = True
subsumTest1 :: Bool
subsumTest1 = fun fun1
subsumTest2 :: Bool
subsumTest2 = fun fun2
subsumTest3 :: Bool
subsumTest3 = fun fun3
subsumTest4 :: Bool
subsumTest4 = fun fun4
subsumTest5 :: Bool
subsumTest5 = funPred fun5
subsumTest6 :: Bool
subsumTest6 = funPred fun6
subsumTest7 :: Bool
subsumTest7 = funPred fun7
subsumTest8 :: Bool
subsumTest8 = fun fun8
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment