diff options
| author | Richard Eisenberg <eir@cis.upenn.edu> | 2014-12-12 10:40:18 -0500 |
|---|---|---|
| committer | Richard Eisenberg <eir@cis.upenn.edu> | 2014-12-12 10:40:18 -0500 |
| commit | 5bc717e9374c3d1c5b24fe676696f7a377e0068d (patch) | |
| tree | 24c9071ab19b7ced364c62674edd1c2876e87cee | |
| parent | 2005d52a4028ed78a99fd02e8055da1dc9fba64f (diff) | |
| download | haskell-5bc717e9374c3d1c5b24fe676696f7a377e0068d.tar.gz | |
Bugfixing
| -rw-r--r-- | compiler/typecheck/TcCanonical.hs | 4 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/T9708.hs | 9 | ||||
| -rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 2 |
3 files changed, 12 insertions, 3 deletions
diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index cfb2d8955e..cc1197d748 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -1593,7 +1593,8 @@ unifyWanted loc role orig_ty1 orig_ty2 ; return (mkTcTyConAppCo role funTyCon [co_s,co_t]) } go (TyConApp tc1 tys1) (TyConApp tc2 tys2) | tc1 == tc2, isDecomposableTyCon tc1, tys1 `equalLength` tys2 - , not (isNewTyCon tc1) || role == Nominal -- don't look under newtypes! + , (not (isNewTyCon tc1) && not (isDataFamilyTyCon tc1)) || role == Nominal + -- don't look under newtypes! = do { cos <- zipWith3M (unifyWanted loc) (tyConRolesX role tc1) tys1 tys2 ; return (mkTcTyConAppCo role tc1 cos) } go (TyVarTy tv) ty2 @@ -1637,6 +1638,7 @@ unify_derived loc role orig_ty1 orig_ty2 ; unify_derived loc role t1 t2 } go (TyConApp tc1 tys1) (TyConApp tc2 tys2) | tc1 == tc2, isDecomposableTyCon tc1, tys1 `equalLength` tys2 + , (not (isNewTyCon tc1) && not (isDataFamilyTyCon tc1)) || role == Nominal = unifyDeriveds loc (tyConRolesX role tc1) tys1 tys2 go (TyVarTy tv) ty2 = do { mb_ty <- isFilledMetaTyVar_maybe tv diff --git a/testsuite/tests/typecheck/should_compile/T9708.hs b/testsuite/tests/typecheck/should_compile/T9708.hs index b170ef3b6d..61928d41ad 100644 --- a/testsuite/tests/typecheck/should_compile/T9708.hs +++ b/testsuite/tests/typecheck/should_compile/T9708.hs @@ -7,7 +7,14 @@ import Data.Proxy type family SomeFun (n :: Nat) -- See the Trac ticket; whether this suceeds or fails is distintly random --- Currently it succeeds + +-- upon creation, commit f861fc6ad8e5504a4fecfc9bb0945fe2d313687c, this failed + +-- with Simon's optimization to the flattening algorithm, commit +-- 37b3646c9da4da62ae95aa3a9152335e485b261e, this succeeded + +-- with the change to stop Deriveds from rewriting Deriveds (around Dec. 12, 2014), +-- this failed again ti7 :: (x <= y, y <= x) => Proxy (SomeFun x) -> Proxy y -> () ti7 _ _ = () diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index f2337db848..7d33ad580c 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -425,7 +425,7 @@ test('T9569a', normal, compile, ['']) test('T9117', normal, compile, ['']) test('T9117_2', normal, compile, ['']) test('T9117_3', normal, compile, ['']) -test('T9708', normal, compile, ['']) +test('T9708', expect_broken(9708), compile, ['']) test('T9404', normal, compile, ['']) test('T9404b', normal, compile, ['']) test('T7220', normal, compile, ['']) |