From 16514f272fb42af6e9c7674a9bd6c9dce369231f Mon Sep 17 00:00:00 2001 From: David Terei Date: Wed, 20 Jul 2011 11:09:03 -0700 Subject: Move tests from tests/ghc-regress/* to just tests/* --- .../indexed-types/should_fail/DerivUnsatFam.hs | 8 +++ .../indexed-types/should_fail/DerivUnsatFam.stderr | 5 ++ .../tests/indexed-types/should_fail/GADTwrong1.hs | 12 ++++ .../indexed-types/should_fail/GADTwrong1.stderr | 18 ++++++ testsuite/tests/indexed-types/should_fail/Makefile | 3 + .../tests/indexed-types/should_fail/NoMatchErr.hs | 21 +++++++ .../indexed-types/should_fail/NoMatchErr.stderr | 13 ++++ .../indexed-types/should_fail/NonLinearSigErr.hs | 8 +++ .../should_fail/NonLinearSigErr.stderr | 0 .../should_fail/NotRelaxedExamples.hs | 11 ++++ .../should_fail/NotRelaxedExamples.stderr | 18 ++++++ .../tests/indexed-types/should_fail/Over.stderr | 10 +++ testsuite/tests/indexed-types/should_fail/OverA.hs | 8 +++ testsuite/tests/indexed-types/should_fail/OverB.hs | 9 +++ testsuite/tests/indexed-types/should_fail/OverC.hs | 9 +++ testsuite/tests/indexed-types/should_fail/OverD.hs | 3 + .../indexed-types/should_fail/SimpleFail10.hs | 13 ++++ .../indexed-types/should_fail/SimpleFail10.stderr | 6 ++ .../indexed-types/should_fail/SimpleFail11a.hs | 13 ++++ .../indexed-types/should_fail/SimpleFail11a.stderr | 10 +++ .../indexed-types/should_fail/SimpleFail11b.hs | 18 ++++++ .../indexed-types/should_fail/SimpleFail11b.stderr | 10 +++ .../indexed-types/should_fail/SimpleFail11c.hs | 21 +++++++ .../indexed-types/should_fail/SimpleFail11c.stderr | 10 +++ .../indexed-types/should_fail/SimpleFail11d.hs | 10 +++ .../indexed-types/should_fail/SimpleFail11d.stderr | 5 ++ .../indexed-types/should_fail/SimpleFail12.hs | 9 +++ .../indexed-types/should_fail/SimpleFail12.stderr | 4 ++ .../indexed-types/should_fail/SimpleFail13.hs | 13 ++++ .../indexed-types/should_fail/SimpleFail13.stderr | 8 +++ .../indexed-types/should_fail/SimpleFail14.hs | 6 ++ .../indexed-types/should_fail/SimpleFail14.stderr | 6 ++ .../indexed-types/should_fail/SimpleFail15.hs | 6 ++ .../indexed-types/should_fail/SimpleFail15.stderr | 6 ++ .../indexed-types/should_fail/SimpleFail16.hs | 11 ++++ .../indexed-types/should_fail/SimpleFail16.stderr | 6 ++ .../indexed-types/should_fail/SimpleFail1a.hs | 4 ++ .../indexed-types/should_fail/SimpleFail1a.stderr | 4 ++ .../indexed-types/should_fail/SimpleFail1b.hs | 4 ++ .../indexed-types/should_fail/SimpleFail1b.stderr | 4 ++ .../indexed-types/should_fail/SimpleFail2a.hs | 14 +++++ .../indexed-types/should_fail/SimpleFail2a.stderr | 5 ++ .../indexed-types/should_fail/SimpleFail2b.hs | 12 ++++ .../indexed-types/should_fail/SimpleFail2b.stderr | 5 ++ .../indexed-types/should_fail/SimpleFail3a.hs | 10 +++ .../indexed-types/should_fail/SimpleFail3a.stderr | 5 ++ .../indexed-types/should_fail/SimpleFail3b.stderr | 3 + .../tests/indexed-types/should_fail/SimpleFail4.hs | 8 +++ .../indexed-types/should_fail/SimpleFail4.stderr | 4 ++ .../indexed-types/should_fail/SimpleFail5a.hs | 31 +++++++++ .../indexed-types/should_fail/SimpleFail5a.stderr | 10 +++ .../indexed-types/should_fail/SimpleFail5b.hs | 31 +++++++++ .../indexed-types/should_fail/SimpleFail5b.stderr | 7 +++ .../tests/indexed-types/should_fail/SimpleFail6.hs | 7 +++ .../indexed-types/should_fail/SimpleFail6.stderr | 2 + .../tests/indexed-types/should_fail/SimpleFail7.hs | 8 +++ .../indexed-types/should_fail/SimpleFail7.stderr | 4 ++ .../tests/indexed-types/should_fail/SimpleFail8.hs | 10 +++ .../indexed-types/should_fail/SimpleFail8.stderr | 4 ++ .../tests/indexed-types/should_fail/SimpleFail9.hs | 13 ++++ .../indexed-types/should_fail/SimpleFail9.stderr | 6 ++ .../indexed-types/should_fail/SkolemOccursLoop.hs | 31 +++++++++ .../should_fail/SkolemOccursLoop.stderr | 10 +++ testsuite/tests/indexed-types/should_fail/T1900.hs | 73 ++++++++++++++++++++++ .../tests/indexed-types/should_fail/T1900.stderr | 18 ++++++ testsuite/tests/indexed-types/should_fail/T2157.hs | 7 +++ .../tests/indexed-types/should_fail/T2157.stderr | 4 ++ .../tests/indexed-types/should_fail/T2203a.hs | 15 +++++ .../tests/indexed-types/should_fail/T2203a.stderr | 5 ++ testsuite/tests/indexed-types/should_fail/T2239.hs | 51 +++++++++++++++ .../tests/indexed-types/should_fail/T2239.stderr | 30 +++++++++ testsuite/tests/indexed-types/should_fail/T2334.hs | 16 +++++ .../tests/indexed-types/should_fail/T2334.stderr | 17 +++++ testsuite/tests/indexed-types/should_fail/T2544.hs | 15 +++++ .../tests/indexed-types/should_fail/T2544.stderr | 22 +++++++ .../tests/indexed-types/should_fail/T2627b.hs | 20 ++++++ .../tests/indexed-types/should_fail/T2627b.stderr | 7 +++ testsuite/tests/indexed-types/should_fail/T2664.hs | 31 +++++++++ .../tests/indexed-types/should_fail/T2664.stderr | 18 ++++++ .../tests/indexed-types/should_fail/T2664a.hs | 30 +++++++++ testsuite/tests/indexed-types/should_fail/T2677.hs | 7 +++ .../tests/indexed-types/should_fail/T2677.stderr | 5 ++ testsuite/tests/indexed-types/should_fail/T2693.hs | 11 ++++ .../tests/indexed-types/should_fail/T2693.stderr | 7 +++ testsuite/tests/indexed-types/should_fail/T2888.hs | 7 +++ testsuite/tests/indexed-types/should_fail/T3092.hs | 9 +++ .../tests/indexed-types/should_fail/T3092.stderr | 10 +++ .../tests/indexed-types/should_fail/T3330a.hs | 25 ++++++++ .../tests/indexed-types/should_fail/T3330a.stderr | 9 +++ .../tests/indexed-types/should_fail/T3330b.hs | 19 ++++++ .../tests/indexed-types/should_fail/T3330b.stderr | 5 ++ .../tests/indexed-types/should_fail/T3330c.hs | 58 +++++++++++++++++ .../tests/indexed-types/should_fail/T3330c.stderr | 18 ++++++ testsuite/tests/indexed-types/should_fail/T3440.hs | 11 ++++ .../tests/indexed-types/should_fail/T3440.stderr | 19 ++++++ .../tests/indexed-types/should_fail/T4093a.hs | 8 +++ .../tests/indexed-types/should_fail/T4093a.stderr | 14 +++++ .../tests/indexed-types/should_fail/T4093b.hs | 40 ++++++++++++ .../tests/indexed-types/should_fail/T4093b.stderr | 32 ++++++++++ testsuite/tests/indexed-types/should_fail/T4099.hs | 14 +++++ .../tests/indexed-types/should_fail/T4099.stderr | 13 ++++ testsuite/tests/indexed-types/should_fail/T4174.hs | 60 ++++++++++++++++++ .../tests/indexed-types/should_fail/T4174.stderr | 5 ++ .../indexed-types/should_fail/T4174.stderr-ghc-7.0 | 7 +++ testsuite/tests/indexed-types/should_fail/T4179.hs | 26 ++++++++ .../tests/indexed-types/should_fail/T4179.stderr | 63 +++++++++++++++++++ testsuite/tests/indexed-types/should_fail/T4246.hs | 15 +++++ .../tests/indexed-types/should_fail/T4246.stderr | 10 +++ testsuite/tests/indexed-types/should_fail/T4254.hs | 21 +++++++ .../tests/indexed-types/should_fail/T4254.stderr | 18 ++++++ testsuite/tests/indexed-types/should_fail/T4272.hs | 22 +++++++ .../tests/indexed-types/should_fail/T4272.stderr | 8 +++ testsuite/tests/indexed-types/should_fail/T4485.hs | 66 +++++++++++++++++++ .../tests/indexed-types/should_fail/T4485.stderr | 19 ++++++ .../tests/indexed-types/should_fail/TyFamArity1.hs | 4 ++ .../indexed-types/should_fail/TyFamArity1.stderr | 4 ++ .../tests/indexed-types/should_fail/TyFamArity2.hs | 4 ++ .../indexed-types/should_fail/TyFamArity2.stderr | 4 ++ .../tests/indexed-types/should_fail/TyFamUndec.hs | 8 +++ .../indexed-types/should_fail/TyFamUndec.stderr | 18 ++++++ testsuite/tests/indexed-types/should_fail/all.T | 72 +++++++++++++++++++++ 121 files changed, 1777 insertions(+) create mode 100644 testsuite/tests/indexed-types/should_fail/DerivUnsatFam.hs create mode 100644 testsuite/tests/indexed-types/should_fail/DerivUnsatFam.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/GADTwrong1.hs create mode 100644 testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/Makefile create mode 100644 testsuite/tests/indexed-types/should_fail/NoMatchErr.hs create mode 100644 testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/NonLinearSigErr.hs create mode 100644 testsuite/tests/indexed-types/should_fail/NonLinearSigErr.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.hs create mode 100644 testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/Over.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/OverA.hs create mode 100644 testsuite/tests/indexed-types/should_fail/OverB.hs create mode 100644 testsuite/tests/indexed-types/should_fail/OverC.hs create mode 100644 testsuite/tests/indexed-types/should_fail/OverD.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail10.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail10.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail11a.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail11b.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail11c.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail11d.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail12.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail13.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail14.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail15.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail16.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail1a.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail1b.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail2a.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail2b.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail3a.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail3b.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail4.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail5a.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail5b.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail6.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail7.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail7.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail8.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail8.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail9.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SimpleFail9.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.hs create mode 100644 testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T1900.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T1900.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2157.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2157.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2203a.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2203a.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2239.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2239.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2334.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2334.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2544.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2544.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2627b.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2627b.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2664.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2664.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2664a.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2677.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2677.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2693.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T2693.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T2888.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T3092.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T3092.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T3330a.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T3330a.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T3330b.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T3330b.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T3330c.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T3330c.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T3440.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T3440.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T4093a.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T4093a.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T4093b.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T4093b.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T4099.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T4099.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T4174.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T4174.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T4174.stderr-ghc-7.0 create mode 100644 testsuite/tests/indexed-types/should_fail/T4179.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T4179.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T4246.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T4246.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T4254.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T4254.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T4272.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T4272.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/T4485.hs create mode 100644 testsuite/tests/indexed-types/should_fail/T4485.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/TyFamArity1.hs create mode 100644 testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/TyFamArity2.hs create mode 100644 testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/TyFamUndec.hs create mode 100644 testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr create mode 100644 testsuite/tests/indexed-types/should_fail/all.T (limited to 'testsuite/tests/indexed-types/should_fail') diff --git a/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.hs b/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.hs new file mode 100644 index 0000000000..d401356326 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies, StandaloneDeriving #-} + +-- Crashed 6.12 + +module T1769 where + +data family T a +deriving instance Functor T diff --git a/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.stderr b/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.stderr new file mode 100644 index 0000000000..63c1262147 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/DerivUnsatFam.stderr @@ -0,0 +1,5 @@ + +DerivUnsatFam.hs:8:1: + Can't make a derived instance of `Functor T': + Unsaturated data family application + In the stand-alone deriving instance for `Functor T' diff --git a/testsuite/tests/indexed-types/should_fail/GADTwrong1.hs b/testsuite/tests/indexed-types/should_fail/GADTwrong1.hs new file mode 100644 index 0000000000..7295090439 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/GADTwrong1.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeFamilies, GADTs, RankNTypes, ScopedTypeVariables #-} + +module ShouldFail where + +type family Const a +type instance Const a = () + +data T a where T :: a -> T (Const a) + +coerce :: forall a b . a -> b +coerce x = case T x :: T (Const b) of + T y -> y diff --git a/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr b/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr new file mode 100644 index 0000000000..e565aa6cde --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr @@ -0,0 +1,18 @@ + +GADTwrong1.hs:12:19: + Could not deduce (a1 ~ b) + from the context (() ~ Const a1) + bound by a pattern with constructor + T :: forall a. a -> T (Const a), + in a case alternative + at GADTwrong1.hs:12:12-14 + `a1' is a rigid type variable bound by + a pattern with constructor + T :: forall a. a -> T (Const a), + in a case alternative + at GADTwrong1.hs:12:12 + `b' is a rigid type variable bound by + the type signature for coerce :: a -> b at GADTwrong1.hs:11:1 + In the expression: y + In a case alternative: T y -> y + In the expression: case T x :: T (Const b) of { T y -> y } diff --git a/testsuite/tests/indexed-types/should_fail/Makefile b/testsuite/tests/indexed-types/should_fail/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/indexed-types/should_fail/NoMatchErr.hs b/testsuite/tests/indexed-types/should_fail/NoMatchErr.hs new file mode 100644 index 0000000000..304e11613e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/NoMatchErr.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE TypeFamilies #-} + +-- Type error message looks like +-- TF.hs:12:11: +-- Couldn't match expected type `Memo d' +-- against inferred type `Memo d1' +-- NB: `Memo' is a (non-injective) type function +-- +-- Note the "NB", which helps point out the problem + +module Foo where + +class Fun d where + type Memo d :: * -> * + abst :: (d -> a) -> Memo d a + appl :: Memo d a -> (d -> a) + +f :: (Fun d) => Memo d a -> Memo d a -- (1) +f = abst . appl + diff --git a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr new file mode 100644 index 0000000000..38c8cf6b2f --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr @@ -0,0 +1,13 @@ + +NoMatchErr.hs:20:12: + Could not deduce (Memo d0 ~ Memo d) + from the context (Fun d) + bound by the type signature for f :: Fun d => Memo d a -> Memo d a + at NoMatchErr.hs:20:1-15 + NB: `Memo' is a type function, and may not be injective + Expected type: Memo d a + Actual type: Memo d0 a + Expected type: Memo d a -> d0 -> a + Actual type: Memo d0 a -> d0 -> a + In the second argument of `(.)', namely `appl' + In the expression: abst . appl diff --git a/testsuite/tests/indexed-types/should_fail/NonLinearSigErr.hs b/testsuite/tests/indexed-types/should_fail/NonLinearSigErr.hs new file mode 100644 index 0000000000..34a9fd3ff6 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/NonLinearSigErr.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +-- This is actually perfectly ok! + +module NonLinearSigErr where + +type family E a b +type instance E a (a :: *) = [a] diff --git a/testsuite/tests/indexed-types/should_fail/NonLinearSigErr.stderr b/testsuite/tests/indexed-types/should_fail/NonLinearSigErr.stderr new file mode 100644 index 0000000000..e69de29bb2 diff --git a/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.hs b/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.hs new file mode 100644 index 0000000000..d41f86b3a1 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies #-} + +module NotRelaxedExamples where + +type family F1 a +type family F2 a +type family F3 a + +type instance F1 Char = F1 (F1 Char) +type instance F2 [x] = F2 [x] +type instance F3 Bool = F3 [Char] diff --git a/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr b/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr new file mode 100644 index 0000000000..dbc83696ee --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr @@ -0,0 +1,18 @@ + +NotRelaxedExamples.hs:9:1: + Nested type family application + in the type family application: F1 (F1 Char) + (Use -XUndecidableInstances to permit this) + In the type synonym instance declaration for `F1' + +NotRelaxedExamples.hs:10:1: + Application is no smaller than the instance head + in the type family application: F2 [x] + (Use -XUndecidableInstances to permit this) + In the type synonym instance declaration for `F2' + +NotRelaxedExamples.hs:11:1: + Application is no smaller than the instance head + in the type family application: F3 [Char] + (Use -XUndecidableInstances to permit this) + In the type synonym instance declaration for `F3' diff --git a/testsuite/tests/indexed-types/should_fail/Over.stderr b/testsuite/tests/indexed-types/should_fail/Over.stderr new file mode 100644 index 0000000000..bb973eee08 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/Over.stderr @@ -0,0 +1,10 @@ + +OverB.hs:7:15: + Conflicting family instance declarations: + data instance OverA.C [Int] [a] -- Defined at OverB.hs:7:15 + data instance OverA.C [a] [Int] -- Defined at OverC.hs:7:15 + +OverB.hs:9:15: + Conflicting family instance declarations: + type instance OverA.D [Int] [a] -- Defined at OverB.hs:9:15 + type instance OverA.D [a] [Int] -- Defined at OverC.hs:9:15 diff --git a/testsuite/tests/indexed-types/should_fail/OverA.hs b/testsuite/tests/indexed-types/should_fail/OverA.hs new file mode 100644 index 0000000000..0f0573782f --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/OverA.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +module OverA (C, D) +where + +data family C a b :: * + +type family D a b :: * \ No newline at end of file diff --git a/testsuite/tests/indexed-types/should_fail/OverB.hs b/testsuite/tests/indexed-types/should_fail/OverB.hs new file mode 100644 index 0000000000..6f1546d19f --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/OverB.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} + +module OverB +where +import OverA (C, D) + +data instance C [Int] [a] = CListList2 + +type instance D [Int] [a] = Int \ No newline at end of file diff --git a/testsuite/tests/indexed-types/should_fail/OverC.hs b/testsuite/tests/indexed-types/should_fail/OverC.hs new file mode 100644 index 0000000000..01f82d9170 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/OverC.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} + +module OverC +where +import OverA (C, D) + +data instance C [a] [Int] = C9ListList + +type instance D [a] [Int] = Char diff --git a/testsuite/tests/indexed-types/should_fail/OverD.hs b/testsuite/tests/indexed-types/should_fail/OverD.hs new file mode 100644 index 0000000000..3bce8de55e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/OverD.hs @@ -0,0 +1,3 @@ +module OverD where +import OverB +import OverC diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail10.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail10.hs new file mode 100644 index 0000000000..7235f67e02 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail10.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +class C8 a where + data S8 a :: * -> * + +instance C8 Int where + data S8 Int a = S8Int a + +-- must fail: extra arguments must be variables +instance C8 Bool where + data S8 Bool Char = S8Bool diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail10.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail10.stderr new file mode 100644 index 0000000000..5fe00056b3 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail10.stderr @@ -0,0 +1,6 @@ + +SimpleFail10.hs:13:3: + Arguments that do not correspond to a class parameter must be variables + Instead of a variable, found Char + In the associated type instance for `S8' + In the instance declaration for `C8 Bool' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11a.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.hs new file mode 100644 index 0000000000..830b05fc75 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +data family C9 a b :: * +data instance C9 Int Int = C9IntInt +-- must fail: conflicting +data instance C9 Int Int = C9IntInt2 + +type family D9 a b :: * +type instance D9 Int Int = Char +-- must fail: conflicting +type instance D9 Int Int = Int diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr new file mode 100644 index 0000000000..23a8fd957d --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr @@ -0,0 +1,10 @@ + +SimpleFail11a.hs:8:15: + Conflicting family instance declarations: + data instance C9 Int Int -- Defined at SimpleFail11a.hs:8:15-16 + data instance C9 Int Int -- Defined at SimpleFail11a.hs:6:15-16 + +SimpleFail11a.hs:13:15: + Conflicting family instance declarations: + type instance D9 Int Int -- Defined at SimpleFail11a.hs:13:15-16 + type instance D9 Int Int -- Defined at SimpleFail11a.hs:11:15-16 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11b.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.hs new file mode 100644 index 0000000000..f6aa7aa3b0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +data family C9 a b :: * +data instance C9 Int Int = C9IntInt +data instance C9 [a] Int = C9ListInt +-- must fail: conflicting +data instance C9 [a] Int = C9ListInt2 + +type family D9 a b :: * +type instance D9 Int Int = Int +type instance D9 [a] Int = [a] +-- must fail: conflicting +type instance D9 [a] Int = Maybe a + +type instance D9 Int [a] = [a] +type instance D9 Int [b] = [b] -- must not conflict! diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr new file mode 100644 index 0000000000..f32fe3a2bb --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr @@ -0,0 +1,10 @@ + +SimpleFail11b.hs:9:15: + Conflicting family instance declarations: + data instance C9 [a] Int -- Defined at SimpleFail11b.hs:9:15-16 + data instance C9 [a] Int -- Defined at SimpleFail11b.hs:7:15-16 + +SimpleFail11b.hs:15:15: + Conflicting family instance declarations: + type instance D9 [a] Int -- Defined at SimpleFail11b.hs:15:15-16 + type instance D9 [a] Int -- Defined at SimpleFail11b.hs:13:15-16 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11c.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.hs new file mode 100644 index 0000000000..21d3f2b4ea --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +data family C9 a b :: * +data instance C9 Int Int = C9IntInt +data instance C9 [a] Int = C9ListInt +-- must fail: conflicting +data instance C9 [Int] Int = C9ListInt2 + +type family D9 a b :: * +type instance D9 Int Int = Int +type instance D9 [a] Int = [a] +-- must fail: conflicting +type instance D9 [Int] Int = [Bool] + +type family E9 a b :: * +type instance E9 Int Int = Int +type instance E9 [a] Int = [a] +type instance E9 [Int] Int = [Int] -- does *not* conflict! +type instance E9 b Int = b diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr new file mode 100644 index 0000000000..ccc897a626 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr @@ -0,0 +1,10 @@ + +SimpleFail11c.hs:7:15: + Conflicting family instance declarations: + data instance C9 [a] Int -- Defined at SimpleFail11c.hs:7:15-16 + data instance C9 [Int] Int -- Defined at SimpleFail11c.hs:9:15-16 + +SimpleFail11c.hs:15:15: + Conflicting family instance declarations: + type instance D9 [Int] Int -- Defined at SimpleFail11c.hs:15:15-16 + type instance D9 [a] Int -- Defined at SimpleFail11c.hs:13:15-16 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11d.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.hs new file mode 100644 index 0000000000..b0457a6933 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +data family C9 a b :: * +data instance C9 Int Int = C9IntInt +data instance C9 [a] Int = C9ListInt +data instance C9 [Int] [a] = C9ListList2 +-- must fail: conflicting +data instance C9 [a] [Int] = C9ListList diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr new file mode 100644 index 0000000000..1847565329 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr @@ -0,0 +1,5 @@ + +SimpleFail11d.hs:10:15: + Conflicting family instance declarations: + data instance C9 [a] [Int] -- Defined at SimpleFail11d.hs:10:15-16 + data instance C9 [Int] [a] -- Defined at SimpleFail11d.hs:8:15-16 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail12.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail12.hs new file mode 100644 index 0000000000..0c8ffefefe --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail12.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, Rank2Types #-} + + +module ShouldFail where + +type family C a :: * +-- must fail: rhs is not a tau type +type instance C Int = forall a. [a] + diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr new file mode 100644 index 0000000000..24ac5f10a1 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail12.stderr @@ -0,0 +1,4 @@ + +SimpleFail12.hs:8:1: + Illegal polymorphic or qualified type: forall a. [a] + In the type synonym instance declaration for `C' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail13.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail13.hs new file mode 100644 index 0000000000..bc94e2115a --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail13.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +type family C a :: * + +data family D a :: * +-- must fail: lhs contains a type family application +data instance D [C a] = DC + +type family E a :: * +-- must fail: lhs contains a type family application +type instance E [C a] = Int diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr new file mode 100644 index 0000000000..f87d4059ae --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr @@ -0,0 +1,8 @@ + +SimpleFail13.hs:9:1: + Illegal type synonym family application in instance: [C a] + In the data type instance declaration for `D' + +SimpleFail13.hs:13:1: + Illegal type synonym family application in instance: [C a] + In the type synonym instance declaration for `E' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail14.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail14.hs new file mode 100644 index 0000000000..a25d81d3ba --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail14.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeFamilies #-} + +module Simple14 where + +data T a = T (a~a) + diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr new file mode 100644 index 0000000000..e11f9500fb --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr @@ -0,0 +1,6 @@ + +SimpleFail14.hs:5:15: + Predicate used as a type: a ~ a + In the type `a ~ a' + In the definition of data constructor `T' + In the data type declaration for `T' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail15.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail15.hs new file mode 100644 index 0000000000..586403937b --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail15.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +foo :: (a,b) -> (a~b => t) -> (a,b) +foo p x = p diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr new file mode 100644 index 0000000000..8f97746510 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr @@ -0,0 +1,6 @@ + +SimpleFail15.hs:5:1: + Illegal polymorphic or qualified type: a ~ b => t + Perhaps you intended to use -XRankNTypes or -XRank2Types + In the type signature for `foo': + foo :: (a, b) -> (a ~ b => t) -> (a, b) diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail16.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail16.hs new file mode 100644 index 0000000000..fc70df1fd8 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail16.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +type family F a + +foo :: p a -> p a +foo x = x + +bar = foo (undefined :: F ()) + diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr new file mode 100644 index 0000000000..0573e15aea --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail16.stderr @@ -0,0 +1,6 @@ + +SimpleFail16.hs:10:12: + Couldn't match type `F ()' with `p0 a0' + In the first argument of `foo', namely `(undefined :: F ())' + In the expression: foo (undefined :: F ()) + In an equation for `bar': bar = foo (undefined :: F ()) diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.hs new file mode 100644 index 0000000000..a87d5e515d --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} + +data family T1 a :: * -> * +data instance T1 Int = T1_1 -- must fail: too few args diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr new file mode 100644 index 0000000000..6bbbb32da9 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr @@ -0,0 +1,4 @@ + +SimpleFail1a.hs:4:1: + Family instance has too few parameters; expected 2 + In the data type instance declaration for `T1' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.hs new file mode 100644 index 0000000000..71ede91143 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} + +data family T1 a :: * -> * +data instance T1 Int Bool Char = T1_3 -- must fail: too many args diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr new file mode 100644 index 0000000000..e4db86bdf1 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr @@ -0,0 +1,4 @@ + +SimpleFail1b.hs:4:1: + Family instance has too many parameters: `T1' + In the data type instance declaration for `T1' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2a.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.hs new file mode 100644 index 0000000000..011426fe3b --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} + +module Simple2a where + +class C a where + data Sd a :: * + data Sn a :: * + type St a :: * + +instance C Int where + data Sd a :: * -- must fail: parse error + data Sd Int = SdC Char + newtype Sn Int = SnC Char + type St Int = Char diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr new file mode 100644 index 0000000000..56e06e3145 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr @@ -0,0 +1,5 @@ + +SimpleFail2a.hs:11:11: + Conflicting definitions for `Sd' + Bound at: SimpleFail2a.hs:11:11-12 + SimpleFail2a.hs:12:11-12 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2b.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.hs new file mode 100644 index 0000000000..031b170a1a --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeFamilies #-} + +class C a where + data Sd a :: * + data Sn a :: * + type St a :: * + +instance C Int where + data Sd Int = SdC1 Char -- must fail: conflicting + data Sd Int = SdC2 Char -- declarations + newtype Sn Int = SnC Char + type St Int = Char diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr new file mode 100644 index 0000000000..cdb91dea58 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr @@ -0,0 +1,5 @@ + +SimpleFail2b.hs:9:11: + Conflicting definitions for `Sd' + Bound at: SimpleFail2b.hs:9:11-12 + SimpleFail2b.hs:10:11-12 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail3a.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail3a.hs new file mode 100644 index 0000000000..87f68ab124 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail3a.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +class C1 a where + data S1 a :: * + +-- must fail: wrong category of type instance +instance C1 Int where + type S1 Int = Bool diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr new file mode 100644 index 0000000000..9a93d9fc90 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr @@ -0,0 +1,5 @@ + +SimpleFail3a.hs:10:3: + Wrong category of family instance; declaration was for a data type + In the type synonym instance declaration for `S1' + In the instance declaration for `C1 Int' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail3b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail3b.stderr new file mode 100644 index 0000000000..419fe91492 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail3b.stderr @@ -0,0 +1,3 @@ + +SimpleFail3b.hs:10:2: + Wrong category of family instance; declaration was for a newtype diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail4.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail4.hs new file mode 100644 index 0000000000..de674a39fd --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail4.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +-- must fail: defaults have no patterns +class C2 a b where + type S2 a :: * + type S2 Int = Char diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr new file mode 100644 index 0000000000..0f42d5a572 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr @@ -0,0 +1,4 @@ + +SimpleFail4.hs:8:3: + Type declaration in a class must be a kind signature or synonym default: + type instance S2 Int = Char diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.hs new file mode 100644 index 0000000000..e50250d4e7 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +class C3 a where + data S3 a :: * + data S3n a :: * + foo3 :: a -> S3 a + foo3n :: a -> S3n a + bar3 :: S3 a -> a + bar3n :: S3n a -> a + +instance C3 Int where + data S3 Int = D3Int + newtype S3n Int = D3Intn () + foo3 _ = D3Int + foo3n _ = D3Intn () + bar3 D3Int = 1 + bar3n (D3Intn _) = 1 + +instance C3 Char where + data S3 Char = D3Char + foo3 _ = D3Char + bar3 D3Char = 'c' + +bar3' :: S3 Char -> Char +bar3' D3Char = 'a' + +-- must fail: signature too general +bar3wrong :: S3 a -> a +bar3wrong D3Int = 1 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr new file mode 100644 index 0000000000..861ef5c869 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr @@ -0,0 +1,10 @@ + +SimpleFail5a.hs:31:11: + Couldn't match type `a' with `Int' + `a' is a rigid type variable bound by + the type signature for bar3wrong :: S3 a -> a + at SimpleFail5a.hs:31:1 + Expected type: S3 a + Actual type: S3 Int + In the pattern: D3Int + In an equation for `bar3wrong': bar3wrong D3Int = 1 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5b.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.hs new file mode 100644 index 0000000000..d05b3bcb36 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +class C3 a where + data S3 a :: * + data S3n a :: * + foo3 :: a -> S3 a + foo3n :: a -> S3n a + bar3 :: S3 a -> a + bar3n :: S3n a -> a + +instance C3 Int where + data S3 Int = D3Int + newtype S3n Int = D3Intn () + foo3 _ = D3Int + foo3n _ = D3Intn () + bar3 D3Int = 1 + bar3n (D3Intn _) = 1 + +instance C3 Char where + data S3 Char = D3Char + foo3 _ = D3Char + bar3 D3Char = 'c' + +bar3' :: S3 Char -> Char +bar3' D3Char = 'a' + +-- must fail: Can't match Int against Char +bar3wrong' D3Int = 1 +bar3wrong' D3Char = 'a' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr new file mode 100644 index 0000000000..5a9d279860 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5b.stderr @@ -0,0 +1,7 @@ + +SimpleFail5b.hs:31:12: + Couldn't match expected type `Int' with actual type `Char' + Expected type: S3 Int + Actual type: S3 Char + In the pattern: D3Char + In an equation for `bar3wrong'': bar3wrong' D3Char = 'a' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail6.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail6.hs new file mode 100644 index 0000000000..8a39e6042d --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail6.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +-- must fail: Repeated type variable +class C4 a where + data S4 a a :: * diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr new file mode 100644 index 0000000000..c5c7e8a86a --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr @@ -0,0 +1,2 @@ + +SimpleFail6.hs:7:11: Illegal repeated type variable `a' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail7.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail7.hs new file mode 100644 index 0000000000..3d9a089381 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail7.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +-- must fail: AT must be in class instance +class C5 a where + data S5 a :: * +data instance S5 Int = S5 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail7.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail7.stderr new file mode 100644 index 0000000000..04131efe33 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail7.stderr @@ -0,0 +1,4 @@ + +SimpleFail7.hs:8:1: + Associated type `S5' must be inside a class instance + In the data type instance declaration for `S5' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail8.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail8.hs new file mode 100644 index 0000000000..cefb00f5b0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail8.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +-- must fail: C6 has no ATs S3 and Map +class C6 a + +instance C6 Integer where + data Map Integer v = MapInteger + data S3 Integer = S3Integer diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail8.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail8.stderr new file mode 100644 index 0000000000..88c71b690c --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail8.stderr @@ -0,0 +1,4 @@ + +SimpleFail8.hs:9:8: Not in scope: type constructor or class `Map' + +SimpleFail8.hs:10:8: Not in scope: type constructor or class `S3' diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail9.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail9.hs new file mode 100644 index 0000000000..d45c9830a4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail9.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-} + +module ShouldFail where + +class C7 a b where + data S7 b :: * + +instance C7 Char (a, Bool) where + data S7 (a, Bool) = S7_1 + +-- must fail: type indexes don't match the instance types +instance C7 Char (a, Int) where + data S7 (b, Int) = S7_2 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail9.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail9.stderr new file mode 100644 index 0000000000..fb04fa8af7 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail9.stderr @@ -0,0 +1,6 @@ + +SimpleFail9.hs:13:3: + Type indexes must match class instance head + Found `(b, Int)' but expected `(a, Int)' + In the associated type instance for `S7' + In the instance declaration for `C7 Char (a, Int)' diff --git a/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.hs b/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.hs new file mode 100644 index 0000000000..ce86d7beab --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE TypeFamilies, FlexibleContexts, EmptyDataDecls #-} + +module SkolemOccursLoop where + +-- SkelemOccurs tests by Tom and Martin + +data T x +type family F x +type instance F [x] = [T (F x)] + +t :: a -> a -> Bool +t _ _ = True + +f :: a -> F [a] +f = undefined + +test1 :: (F [a] ~ a) => a -> Bool +test1 x = t x (f x) + +-- + +data S a +type family G x +type instance G (S x, y) = S (G (x,y)) + +g :: a -> G [a] +g = undefined + +test2 :: (G (S a,a) ~ a) => a -> Bool +-- inferred: G [a] ~ a => a -> Bool +test2 x = t x (g x) diff --git a/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.stderr b/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.stderr new file mode 100644 index 0000000000..0900da8e33 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.stderr @@ -0,0 +1,10 @@ + +SkolemOccursLoop.hs:18:0: + Couldn't match expected type `F a' + against inferred type `[T (F (T (F a)))]' + When generalising the type(s) for `test1' + +SkolemOccursLoop.hs:31:0: + Couldn't match expected type `S (G (a, a))' + against inferred type `G [S (G (a, a))]' + When generalising the type(s) for `test2' diff --git a/testsuite/tests/indexed-types/should_fail/T1900.hs b/testsuite/tests/indexed-types/should_fail/T1900.hs new file mode 100644 index 0000000000..efcfbc1391 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T1900.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE TypeFamilies, FlexibleContexts #-} + +module Class4 where + +class (Eq (Depend s)) => Bug s where + type Depend s + trans :: Depend s -> Depend s + +instance Bug Int where + type Depend Int = () + trans = (+1) + +check :: (Bug s) => Depend s -> Bool +check d = d == trans d + +{- + Given: (Bug s, Eq (Depend s)) + = (Bug s, Eq fsk, Depend s ~ fsk) + + Wanted: (Eq alpha, (invocation of == at alpha) + Depend s ~ alpha (first arg of ==) + Depend sigma ~ alpha (second arg of ==) + Bug sigma, (invocation of trans at sigma) + Depend sigma ~ Depend s (first arg of trans) + + {der}Eq (Depend sigma) (superclass of Bug sigma) + +==> + Wanted: (Eq alpha, (invocation of == at alpha) + Depend s ~ alpha (first arg of ==) + Depend sigma ~ alpha (second arg of ==) + Bug sigma, (invocation of trans at sigma) + {der}Eq (Depend sigma) (superclass of Bug sigma) + +==> + Wanted: (Eq alpha, (invocation of == at alpha) + Depend s ~ alpha (first arg of ==) + Depend sigma ~ alpha (second arg of ==) + Bug sigma, (invocation of trans at sigma) + + {der}Eq uf_ahj + Depend sigma ~ uf_ahj + +==> uf := alpha + Wanted: (Eq alpha, (invocation of == at alpha) + Depend s ~ alpha (first arg of ==) + Depend sigma ~ alpha (second arg of ==) + Bug sigma, (invocation of trans at sigma) + {der}Eq alpha) +==> discharge Eq alpha from {der} + Wanted: (Depend s ~ alpha (first arg of ==) + Depend sigma ~ alpha (second arg of ==) + Bug sigma, (invocation of trans at sigma) + {der}Eq alpha) + +==> use given Depend s ~ fsk + Wanted: (alpha ~ fsk + Depend sigma ~ alpha (second arg of ==) + Bug sigma, (invocation of trans at sigma) + {der}Eq alpha) + +==> alpha := fsk + Wanted: ({given}alpha ~ fsk + Depend sigma ~ alpha (second arg of ==) + Bug sigma, (invocation of trans at sigma) + {der}Eq fsk) + +==> discharge {der} Eq fsk + Wanted: ({given}uf ~ fsk + Depend sigma ~ uf (second arg of ==) + Bug sigma, (invocation of trans at sigma) + +-} diff --git a/testsuite/tests/indexed-types/should_fail/T1900.stderr b/testsuite/tests/indexed-types/should_fail/T1900.stderr new file mode 100644 index 0000000000..4e3be835c4 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T1900.stderr @@ -0,0 +1,18 @@ + +T1900.hs:11:13: + No instance for (Num ()) + arising from the literal `1' + Possible fix: add an instance declaration for (Num ()) + In the second argument of `(+)', namely `1' + In the expression: (+ 1) + In an equation for `trans': trans = (+ 1) + +T1900.hs:14:22: + Could not deduce (Depend s0 ~ Depend s) + from the context (Bug s) + bound by the type signature for check :: Bug s => Depend s -> Bool + at T1900.hs:14:1-22 + NB: `Depend' is a type function, and may not be injective + In the first argument of `trans', namely `d' + In the second argument of `(==)', namely `trans d' + In the expression: d == trans d diff --git a/testsuite/tests/indexed-types/should_fail/T2157.hs b/testsuite/tests/indexed-types/should_fail/T2157.hs new file mode 100644 index 0000000000..c9e562051e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2157.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies, LiberalTypeSynonyms #-} + +module T2157 where + +type S a b = a +type family F a :: * -> * +type instance F a = S a diff --git a/testsuite/tests/indexed-types/should_fail/T2157.stderr b/testsuite/tests/indexed-types/should_fail/T2157.stderr new file mode 100644 index 0000000000..b28f879663 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2157.stderr @@ -0,0 +1,4 @@ + +T2157.hs:7:1: + Type synonym `S' should have 2 arguments, but has been given 1 + In the type synonym instance declaration for `F' diff --git a/testsuite/tests/indexed-types/should_fail/T2203a.hs b/testsuite/tests/indexed-types/should_fail/T2203a.hs new file mode 100644 index 0000000000..89ed37e3da --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2203a.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE ScopedTypeVariables, TypeFamilies, FlexibleInstances #-} + +module T2203a where + +class Foo a where + type TheFoo a + foo :: TheFoo a -> a + foo' :: a -> Int + +class Bar b where + bar :: b -> Int + +instance Foo a => Bar (Either a (TheFoo a)) where + bar (Left a) = foo' a + bar (Right b) = foo' (foo b :: a) diff --git a/testsuite/tests/indexed-types/should_fail/T2203a.stderr b/testsuite/tests/indexed-types/should_fail/T2203a.stderr new file mode 100644 index 0000000000..cd12f6a7be --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2203a.stderr @@ -0,0 +1,5 @@ + +T2203a.hs:13:19: + Illegal type synonym family application in instance: + Either a (TheFoo a) + In the instance declaration for `Bar (Either a (TheFoo a))' diff --git a/testsuite/tests/indexed-types/should_fail/T2239.hs b/testsuite/tests/indexed-types/should_fail/T2239.hs new file mode 100644 index 0000000000..750fdd941c --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2239.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE NoMonomorphismRestriction, RankNTypes #-} +{-# LANGUAGE FunctionalDependencies, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module T2239 where + +data A = A +data B = B + +class C a where c :: a -> String +instance C Bool where c _ = "Bool" +instance C Char where c _ = "Char" + +-- via TFs +type family TF a +type instance TF A = Char +type instance TF B = Bool + +tf :: forall a b. (b ~ TF a,C b) => a -> String +tf a = c (undefined:: b) + +tfa = tf A +tfb = tf B + +-- via FDs +class FD a b | a -> b +instance FD A Char +instance FD B Bool + +fd :: forall a b. (FD a b,C b) => a -> String +fd a = c (undefined:: b) + +fda = fd A +fdb = fd B + + +class MyEq a b | a->b, b->a +instance MyEq a a + +simpleFD = id :: (forall b. MyEq b Bool => b->b) + +simpleTF = id :: (forall b. b~Bool => b->b) + +-- These two both involve impredicative instantiation, +-- and should fail (in the same way) +complexFD = id :: (forall b. MyEq b Bool => b->b) + -> (forall b. MyEq b Bool => b->b) + +complexTF = id :: (forall b. b~Bool => b->b) + -> (forall b. b~Bool => b->b) diff --git a/testsuite/tests/indexed-types/should_fail/T2239.stderr b/testsuite/tests/indexed-types/should_fail/T2239.stderr new file mode 100644 index 0000000000..b8d5fc7a36 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2239.stderr @@ -0,0 +1,30 @@ + +T2239.hs:47:13: + Couldn't match expected type `b -> b' + with actual type `forall b1. MyEq b1 Bool => b1 -> b1' + Expected type: (forall b1. MyEq b1 Bool => b1 -> b1) -> b -> b + Actual type: (forall b1. MyEq b1 Bool => b1 -> b1) + -> forall b1. MyEq b1 Bool => b1 -> b1 + In the expression: + id :: + (forall b. MyEq b Bool => b -> b) + -> (forall b. MyEq b Bool => b -> b) + In an equation for `complexFD': + complexFD + = id :: + (forall b. MyEq b Bool => b -> b) + -> (forall b. MyEq b Bool => b -> b) + +T2239.hs:50:13: + Couldn't match expected type `b -> b' + with actual type `forall b1. b1 ~ Bool => b1 -> b1' + Expected type: (forall b1. b1 ~ Bool => b1 -> b1) -> b -> b + Actual type: (forall b1. b1 ~ Bool => b1 -> b1) + -> forall b1. b1 ~ Bool => b1 -> b1 + In the expression: + id :: + (forall b. b ~ Bool => b -> b) -> (forall b. b ~ Bool => b -> b) + In an equation for `complexTF': + complexTF + = id :: + (forall b. b ~ Bool => b -> b) -> (forall b. b ~ Bool => b -> b) diff --git a/testsuite/tests/indexed-types/should_fail/T2334.hs b/testsuite/tests/indexed-types/should_fail/T2334.hs new file mode 100644 index 0000000000..c73402e2d5 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2334.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TypeFamilies #-} + +-- Trac #2334 + +module Test where + +data family F r + +newtype instance F () = F () () deriving Eq +newtype instance F Int = H deriving Eq + +data instance F Bool = K1 +data instance F Bool = K2 + + + diff --git a/testsuite/tests/indexed-types/should_fail/T2334.stderr b/testsuite/tests/indexed-types/should_fail/T2334.stderr new file mode 100644 index 0000000000..5bb3e24c22 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2334.stderr @@ -0,0 +1,17 @@ + +T2334.hs:9:26: + The constructor of a newtype must have exactly one field + but `F' has two + In the definition of data constructor `F' + In the newtype instance declaration for `F' + +T2334.hs:10:27: + The constructor of a newtype must have exactly one field + but `H' has none + In the definition of data constructor `H' + In the newtype instance declaration for `F' + +T2334.hs:13:15: + Conflicting family instance declarations: + data instance F Bool -- Defined at T2334.hs:13:15 + data instance F Bool -- Defined at T2334.hs:12:15 diff --git a/testsuite/tests/indexed-types/should_fail/T2544.hs b/testsuite/tests/indexed-types/should_fail/T2544.hs new file mode 100644 index 0000000000..22f3995286 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2544.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TypeOperators, TypeFamilies #-} + +module T2544 where + +data (:|:) a b = Inl a | Inr b + +class Ix i where + type IxMap i :: * -> * + empty :: IxMap i [Int] + +data BiApp a b c = BiApp (a c) (b c) + +instance (Ix l, Ix r) => Ix (l :|: r) where + type IxMap (l :|: r) = BiApp (IxMap l) (IxMap r) + empty = BiApp empty empty \ No newline at end of file diff --git a/testsuite/tests/indexed-types/should_fail/T2544.stderr b/testsuite/tests/indexed-types/should_fail/T2544.stderr new file mode 100644 index 0000000000..6c977bf833 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2544.stderr @@ -0,0 +1,22 @@ + +T2544.hs:15:18: + Could not deduce (IxMap i0 ~ IxMap l) + from the context (Ix l, Ix r) + bound by the instance declaration at T2544.hs:13:10-37 + NB: `IxMap' is a type function, and may not be injective + Expected type: IxMap l [Int] + Actual type: IxMap i0 [Int] + In the first argument of `BiApp', namely `empty' + In the expression: BiApp empty empty + In an equation for `empty': empty = BiApp empty empty + +T2544.hs:15:24: + Could not deduce (IxMap i1 ~ IxMap r) + from the context (Ix l, Ix r) + bound by the instance declaration at T2544.hs:13:10-37 + NB: `IxMap' is a type function, and may not be injective + Expected type: IxMap r [Int] + Actual type: IxMap i1 [Int] + In the second argument of `BiApp', namely `empty' + In the expression: BiApp empty empty + In an equation for `empty': empty = BiApp empty empty diff --git a/testsuite/tests/indexed-types/should_fail/T2627b.hs b/testsuite/tests/indexed-types/should_fail/T2627b.hs new file mode 100644 index 0000000000..13dbd9cb26 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2627b.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE GADTs, TypeFamilies, EmptyDataDecls #-} + +module T2627b where + +data R a b +data W a b +data Z + +type family Dual a +type instance Dual Z = Z +type instance Dual (R a b) = W a (Dual b) +type instance Dual (W a b) = R a (Dual b) + +data Comm a where + Rd :: (a -> Comm b) -> Comm (R a b) + Wr :: a -> Comm b -> Comm (W a b) + Fin :: Int -> Comm Z + +conn :: (Dual a ~ b, Dual b ~ a) => Comm a -> Comm b -> (Int, Int) +conn (Rd k) (Wr a r) = conn undefined undefined diff --git a/testsuite/tests/indexed-types/should_fail/T2627b.stderr b/testsuite/tests/indexed-types/should_fail/T2627b.stderr new file mode 100644 index 0000000000..a8e232486b --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2627b.stderr @@ -0,0 +1,7 @@ + +T2627b.hs:20:24: + Occurs check: cannot construct the infinite type: + a0 = Dual (Dual a0) + In the expression: conn undefined undefined + In an equation for `conn': + conn (Rd k) (Wr a r) = conn undefined undefined diff --git a/testsuite/tests/indexed-types/should_fail/T2664.hs b/testsuite/tests/indexed-types/should_fail/T2664.hs new file mode 100644 index 0000000000..d5b04a6380 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2664.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE EmptyDataDecls, TypeFamilies, TypeOperators, ScopedTypeVariables #-} +module Overflow where +import Control.Concurrent + +data (:*:) a b +data (:+:) a b + +data family PChan a +data instance PChan (a :+: b) = E (IO (PChan a)) (IO (PChan b)) +newtype instance PChan (a :*: b) = O (IO (Either (PChan a) (PChan b))) + +type family Dual a +type instance Dual (a :+: b) = Dual a :*: Dual b +type instance Dual (a :*: b) = Dual a :+: Dual b + +class Connect s where + newPChan :: (s ~ Dual c, c ~ Dual s) => IO (PChan s, PChan c) + +pchoose :: (t -> a) -> MVar a -> IO (t,b) -> IO b +pchoose = undefined + +instance (Connect a, Connect b) => Connect (a :*: b) where + newPChan = do + v <- newEmptyMVar + + -- This version is in T2664a + -- correct implementation: + -- return (O $ takeMVar v, E (pchoose Left v newPChan) (pchoose Right v newPChan)) + + -- type error leads to stack overflow (even without UndecidableInstances!) + return (O $ takeMVar v, E (pchoose Right v newPChan) (pchoose Left v newPChan)) diff --git a/testsuite/tests/indexed-types/should_fail/T2664.stderr b/testsuite/tests/indexed-types/should_fail/T2664.stderr new file mode 100644 index 0000000000..b3b8428a55 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2664.stderr @@ -0,0 +1,18 @@ + +T2664.hs:31:33: + Could not deduce (Dual a ~ Dual b) + from the context (Connect a, Connect b) + bound by the instance declaration at T2664.hs:22:10-52 + or from ((a :*: b) ~ Dual c, c ~ Dual (a :*: b)) + bound by the type signature for + newPChan :: ((a :*: b) ~ Dual c, c ~ Dual (a :*: b)) => + IO (PChan (a :*: b), PChan c) + at T2664.hs:(23,5)-(31,87) + NB: `Dual' is a type function, and may not be injective + Expected type: c + Actual type: Dual b :+: Dual a + Expected type: PChan c + Actual type: PChan (Dual b :+: Dual a) + In the return type of a call of `E' + In the expression: + E (pchoose Right v newPChan) (pchoose Left v newPChan) diff --git a/testsuite/tests/indexed-types/should_fail/T2664a.hs b/testsuite/tests/indexed-types/should_fail/T2664a.hs new file mode 100644 index 0000000000..b7a3033723 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2664a.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE EmptyDataDecls, TypeFamilies, TypeOperators, ScopedTypeVariables #-} +module Overflow where +import Control.Concurrent + +data (:*:) a b +data (:+:) a b + +data family PChan a +data instance PChan (a :+: b) = E (IO (PChan a)) (IO (PChan b)) +newtype instance PChan (a :*: b) = O (IO (Either (PChan a) (PChan b))) + +type family Dual a +type instance Dual (a :+: b) = Dual a :*: Dual b +type instance Dual (a :*: b) = Dual a :+: Dual b + +class Connect s where + newPChan :: (s ~ Dual c, c ~ Dual s) => IO (PChan s, PChan c) + +pchoose :: (t -> a) -> MVar a -> IO (t,b) -> IO b +pchoose = undefined + +instance (Connect a, Connect b) => Connect (a :*: b) where + newPChan = do + v <- newEmptyMVar + -- correct implementation: + return (O $ takeMVar v, E (pchoose Left v newPChan) (pchoose Right v newPChan)) + + -- This version is in T2664 + -- type error leads to stack overflow (even without UndecidableInstances!) + --return (O $ takeMVar v, E (pchoose Right v newPChan) (pchoose Left v newPChan)) diff --git a/testsuite/tests/indexed-types/should_fail/T2677.hs b/testsuite/tests/indexed-types/should_fail/T2677.hs new file mode 100644 index 0000000000..93288ba40d --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2677.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} + +module T2677 where + +type family A x +type instance A a = Bool +type instance A Int = Char diff --git a/testsuite/tests/indexed-types/should_fail/T2677.stderr b/testsuite/tests/indexed-types/should_fail/T2677.stderr new file mode 100644 index 0000000000..e1c08e3b15 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2677.stderr @@ -0,0 +1,5 @@ + +T2677.hs:7:15: + Conflicting family instance declarations: + type instance A Int -- Defined at T2677.hs:7:15 + type instance A a -- Defined at T2677.hs:6:15 diff --git a/testsuite/tests/indexed-types/should_fail/T2693.hs b/testsuite/tests/indexed-types/should_fail/T2693.hs new file mode 100644 index 0000000000..5b0066e948 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2693.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies #-} + +module T2693 where + +type family TFn a :: * + +f :: Maybe () +f = do + let Just x = undefined :: Maybe (TFn a) + let n = fst x + fst x + return () diff --git a/testsuite/tests/indexed-types/should_fail/T2693.stderr b/testsuite/tests/indexed-types/should_fail/T2693.stderr new file mode 100644 index 0000000000..2072d53296 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2693.stderr @@ -0,0 +1,7 @@ + +T2693.hs:9:16: + Couldn't match type `TFn a0' with `(a1, b0)' + Expected type: Maybe (a1, b0) + Actual type: Maybe (TFn a0) + In the expression: undefined :: Maybe (TFn a) + In a pattern binding: Just x = undefined :: Maybe (TFn a) diff --git a/testsuite/tests/indexed-types/should_fail/T2888.hs b/testsuite/tests/indexed-types/should_fail/T2888.hs new file mode 100644 index 0000000000..169eebb474 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2888.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} +-- Test for no type indices + +module T2888 where + +class C w where + data D:: * -> * diff --git a/testsuite/tests/indexed-types/should_fail/T3092.hs b/testsuite/tests/indexed-types/should_fail/T3092.hs new file mode 100644 index 0000000000..e3a671e67e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3092.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} +module T3092 where + +data T a = T1 a +data instance T Int = T2 Char + +type S b = b +type instance S Int = Char + diff --git a/testsuite/tests/indexed-types/should_fail/T3092.stderr b/testsuite/tests/indexed-types/should_fail/T3092.stderr new file mode 100644 index 0000000000..ceea069f8f --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3092.stderr @@ -0,0 +1,10 @@ + +T3092.hs:5:1: + Illegal family instance for `T' + (T is not an indexed type family) + In the data type instance declaration for `T' + +T3092.hs:8:1: + Illegal family instance for `S' + (S is not an indexed type family) + In the type synonym instance declaration for `S' diff --git a/testsuite/tests/indexed-types/should_fail/T3330a.hs b/testsuite/tests/indexed-types/should_fail/T3330a.hs new file mode 100644 index 0000000000..c09eb0fd5c --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3330a.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} + +-- A very bogus program (multiple errors) but +-- sent GHC 6.12 into a loop + +module T3330a where + +import Control.Monad.Writer + +data AnyF (s :: * -> *) = AnyF +class HFunctor (f :: (* -> *) -> * -> *) +type family PF (phi :: * -> *) :: (* -> *) -> * -> * + +children :: s ix -> (PF s) r ix -> [AnyF s] +children p x = execWriter (hmapM p collect x) + +collect :: HFunctor (PF s) => s ix -> r ix -> Writer [AnyF s] (r ix) +collect = undefined + +hmapM :: (forall ix. phi ix -> r ix -> m (r' ix)) + -> phi ix -> f r ix -> m (f r' ix) +hmapM = undefined + diff --git a/testsuite/tests/indexed-types/should_fail/T3330a.stderr b/testsuite/tests/indexed-types/should_fail/T3330a.stderr new file mode 100644 index 0000000000..cfe7f67270 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3330a.stderr @@ -0,0 +1,9 @@ + +T3330a.hs:17:34: + Couldn't match type `s' with `(->) (s ix1 -> ix1)' + `s' is a rigid type variable bound by + the type signature for children :: s ix -> PF s r ix -> [AnyF s] + at T3330a.hs:17:1 + In the first argument of `hmapM', namely `p' + In the first argument of `execWriter', namely `(hmapM p collect x)' + In the expression: execWriter (hmapM p collect x) diff --git a/testsuite/tests/indexed-types/should_fail/T3330b.hs b/testsuite/tests/indexed-types/should_fail/T3330b.hs new file mode 100644 index 0000000000..05d2282304 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3330b.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +-- Bizarrely this made 6.10 loop + +module T3330b where + +class RFunctor c a b where + type Res c a b :: * + rmap :: (a -> b) -> c -> Res c a b + +instance (a ~ c) => RFunctor c a b where + type Res c a b = b + rmap f = f + +instance (RFunctor c a b, a ~ c) => RFunctor [c] a b where + type Res [c] a b = [b] + rmap f = map (map f) diff --git a/testsuite/tests/indexed-types/should_fail/T3330b.stderr b/testsuite/tests/indexed-types/should_fail/T3330b.stderr new file mode 100644 index 0000000000..927bd5b483 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3330b.stderr @@ -0,0 +1,5 @@ + +T3330b.hs:14:10: + Conflicting family instance declarations: + type Res c a b -- Defined at T3330b.hs:14:10-12 + type Res [c] a b -- Defined at T3330b.hs:18:10-12 diff --git a/testsuite/tests/indexed-types/should_fail/T3330c.hs b/testsuite/tests/indexed-types/should_fail/T3330c.hs new file mode 100644 index 0000000000..e6c4dfbb30 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3330c.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE EmptyDataDecls, TypeFamilies, TypeOperators, GADTs, KindSignatures #-} + +module T3330c where + +data (f :+: g) x = Inl (f x) | Inr (g x) + +data R :: (* -> *) -> * where + RSum :: R f -> R g -> R (f :+: g) + +class Rep f where + rep :: R f + +instance (Rep f, Rep g) => Rep (f :+: g) where + rep = RSum rep rep + +type family Der (f :: * -> *) :: * -> * +type instance Der (f :+: g) = Der f :+: Der g + +plug :: Rep f => Der f x -> x -> f x +plug = plug' rep where + +plug' :: R f -> Der f x -> x -> f x +plug' (RSum rf rg) (Inl df) x = Inl (plug rf df x) + +{- +rf :: R f1, rg :: R g1 +Given by GADT match: f ~ f1 :+: g1 + +Second arg has type (Der f x) + = (Der (f1:+:g1) x) + = (:+:) (Der f1) (Der g1) x +Hence df :: Der f1 x + +Inl {f3,g3,x} (plug {f2,x1} rf df x) gives rise to + result of Inl: ((:+:) f3 g3 x ~ f x) + first arg (rf): (R f1 ~ Der f2 x1) + second arg (df): (Der f1 x ~ x1) + result of plug: (f2 x1 ~ x -> f3 x) + + result of Inl: ((:+:) f3 g3 x ~ f x) + by given ((:+:) f3 g3 x ~ (:+:) f1 g1 x) + hence need f3~f1, g3~g1 + +So we are left with + first arg: (R f1 ~ Der f2 x1) + second arg: (Der f1 x ~ x1) + result: (f2 x1 ~ (->) x (f3 x)) + +Decompose result: + f2 ~ (->) x + x1 ~ f1 x +Hence + first: R f1 ~ Der ((->) x) (f1 x) + decompose : R ~ Der ((->) x) + f1 ~ f1 x + + +-} \ No newline at end of file diff --git a/testsuite/tests/indexed-types/should_fail/T3330c.stderr b/testsuite/tests/indexed-types/should_fail/T3330c.stderr new file mode 100644 index 0000000000..4ca19f8a4e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3330c.stderr @@ -0,0 +1,18 @@ + +T3330c.hs:23:43: + Couldn't match type `f1' with `f1 x' + `f1' is a rigid type variable bound by + a pattern with constructor + RSum :: forall (f :: * -> *) (g :: * -> *). + R f -> R g -> R (f :+: g), + in an equation for `plug'' + at T3330c.hs:23:8 + In the first argument of `plug', namely `rf' + In the first argument of `Inl', namely `(plug rf df x)' + In the expression: Inl (plug rf df x) + +T3330c.hs:23:43: + Couldn't match type `Der ((->) x)' with `R' + In the first argument of `plug', namely `rf' + In the first argument of `Inl', namely `(plug rf df x)' + In the expression: Inl (plug rf df x) diff --git a/testsuite/tests/indexed-types/should_fail/T3440.hs b/testsuite/tests/indexed-types/should_fail/T3440.hs new file mode 100644 index 0000000000..0bf1544009 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3440.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies, GADTs #-} + +module T3440 where + +type family Fam a :: * + +data GADT :: * -> * where + GADT :: a -> Fam a -> GADT (Fam a) + +unwrap :: GADT (Fam a) -> (a, Fam a) +unwrap (GADT x y) = (x, y) diff --git a/testsuite/tests/indexed-types/should_fail/T3440.stderr b/testsuite/tests/indexed-types/should_fail/T3440.stderr new file mode 100644 index 0000000000..fe61b1da65 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T3440.stderr @@ -0,0 +1,19 @@ + +T3440.hs:11:22: + Could not deduce (a1 ~ a) + from the context (Fam a ~ Fam a1) + bound by a pattern with constructor + GADT :: forall a. a -> Fam a -> GADT (Fam a), + in an equation for `unwrap' + at T3440.hs:11:9-16 + `a1' is a rigid type variable bound by + a pattern with constructor + GADT :: forall a. a -> Fam a -> GADT (Fam a), + in an equation for `unwrap' + at T3440.hs:11:9 + `a' is a rigid type variable bound by + the type signature for unwrap :: GADT (Fam a) -> (a, Fam a) + at T3440.hs:11:1 + In the expression: x + In the expression: (x, y) + In an equation for `unwrap': unwrap (GADT x y) = (x, y) diff --git a/testsuite/tests/indexed-types/should_fail/T4093a.hs b/testsuite/tests/indexed-types/should_fail/T4093a.hs new file mode 100644 index 0000000000..06168f577e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4093a.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} +module T4093a where + +type family Foo x +type instance Foo () = Maybe () + +hang :: (Foo e ~ Maybe e) => Foo e +hang = Just () diff --git a/testsuite/tests/indexed-types/should_fail/T4093a.stderr b/testsuite/tests/indexed-types/should_fail/T4093a.stderr new file mode 100644 index 0000000000..0b36936be9 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4093a.stderr @@ -0,0 +1,14 @@ + +T4093a.hs:8:8: + Could not deduce (e ~ ()) + from the context (Foo e ~ Maybe e) + bound by the type signature for hang :: Foo e ~ Maybe e => Foo e + at T4093a.hs:8:1-14 + `e' is a rigid type variable bound by + the type signature for hang :: Foo e ~ Maybe e => Foo e + at T4093a.hs:8:1 + Expected type: Foo e + Actual type: Maybe () + In the return type of a call of `Just' + In the expression: Just () + In an equation for `hang': hang = Just () diff --git a/testsuite/tests/indexed-types/should_fail/T4093b.hs b/testsuite/tests/indexed-types/should_fail/T4093b.hs new file mode 100644 index 0000000000..2d9878541f --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4093b.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE GADTs, EmptyDataDecls, ScopedTypeVariables, TypeFamilies #-} + +module T4093b where + +data C +data O + +type family EitherCO e a b :: * +type instance EitherCO C a b = a +type instance EitherCO O a b = b + +data MaybeC ex t where + JustC :: t -> MaybeC C t + NothingC :: MaybeC O t + +data Block (n :: * -> * -> *) e x + + +blockToNodeList :: + forall n e x. (EitherCO e (A C O n) (A O O n) ~ A e O n, + EitherCO x (A C C n) (A C O n) ~ A C x n) => + Block n e x -> A e x n + +type A e x n = (MaybeC e (n C O), MaybeC x (n O C)) +blockToNodeList b = foldBlockNodesF (f, l) b z + where + z :: EitherCO e (EitherCO e (A C O n) (A O O n)) (EitherCO e (A C O n) (A O O n)) + z = undefined + + f :: n C O -> EitherCO e (A C O n) (A O O n) -> EitherCO e (A C O n) (A O O n) + f n _ = (JustC n, NothingC) + + l :: n O C -> EitherCO e (A C O n) (A O O n) -> EitherCO e (A C C n) (A O C n) + l _ = undefined + +foldBlockNodesF :: forall n a b c e x . + ( n C O -> a -> b + , n O C -> b -> c) + -> (Block n e x -> EitherCO e a b -> EitherCO x c b) +foldBlockNodesF _ = undefined diff --git a/testsuite/tests/indexed-types/should_fail/T4093b.stderr b/testsuite/tests/indexed-types/should_fail/T4093b.stderr new file mode 100644 index 0000000000..6818e006ef --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4093b.stderr @@ -0,0 +1,32 @@ + +T4093b.hs:31:13: + Could not deduce (e ~ C) + from the context (EitherCO e (A C O n) (A O O n) ~ A e O n, + EitherCO x (A C C n) (A C O n) ~ A C x n) + bound by the type signature for + blockToNodeList :: (EitherCO e (A C O n) (A O O n) ~ A e O n, + EitherCO x (A C C n) (A C O n) ~ A C x n) => + Block n e x -> A e x n + at T4093b.hs:(25,1)-(34,19) + `e' is a rigid type variable bound by + the type signature for + blockToNodeList :: (EitherCO e (A C O n) (A O O n) ~ A e O n, + EitherCO x (A C C n) (A C O n) ~ A C x n) => + Block n e x -> A e x n + at T4093b.hs:25:1 + Expected type: EitherCO e (A C O n) (A O O n) + Actual type: (MaybeC C (n C O), MaybeC O (n O C)) + In the expression: (JustC n, NothingC) + In an equation for `f': f n _ = (JustC n, NothingC) + In an equation for `blockToNodeList': + blockToNodeList b + = foldBlockNodesF (f, l) b z + where + z :: + EitherCO e (EitherCO e (A C O n) (A O O n)) (EitherCO e (A C O n) (A O O n)) + z = undefined + f :: + n C O + -> EitherCO e (A C O n) (A O O n) -> EitherCO e (A C O n) (A O O n) + f n _ = (JustC n, NothingC) + .... diff --git a/testsuite/tests/indexed-types/should_fail/T4099.hs b/testsuite/tests/indexed-types/should_fail/T4099.hs new file mode 100644 index 0000000000..1ca3c7a4a5 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4099.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} + +module T4099 where + +type family T a + +foo :: T a -> Int +foo x = error "urk" + +bar1 :: T b -> Int +bar1 x = foo x + +bar2 :: Maybe b -> Int +bar2 x = foo x diff --git a/testsuite/tests/indexed-types/should_fail/T4099.stderr b/testsuite/tests/indexed-types/should_fail/T4099.stderr new file mode 100644 index 0000000000..1f5a917296 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4099.stderr @@ -0,0 +1,13 @@ + +T4099.hs:11:14: + Couldn't match type `T b' with `T a0' + NB: `T' is a type function, and may not be injective + In the first argument of `foo', namely `x' + In the expression: foo x + In an equation for `bar1': bar1 x = foo x + +T4099.hs:14:14: + Couldn't match type `T a1' with `Maybe b' + In the first argument of `foo', namely `x' + In the expression: foo x + In an equation for `bar2': bar2 x = foo x diff --git a/testsuite/tests/indexed-types/should_fail/T4174.hs b/testsuite/tests/indexed-types/should_fail/T4174.hs new file mode 100644 index 0000000000..784c0baa08 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4174.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE TypeFamilies, TypeOperators, EmptyDataDecls #-} + +module T4174 where + +data True +data False + +data Minor1 + +data GHC6'8 m +data GHC6'10 m + +type family a :<=: b :: {-Bool-}* +type instance GHC6'10 m1 :<=: GHC6'8 m2 = False + +type a :>=: b = b :<=: a + +data Way ghcVersion tablesNextToCode profiling threaded + +type family GHCVersion way :: {-GHCVersion-} * +type instance GHCVersion (Way v n p t) = v + +type family Threaded way :: {-Bool-} * +type instance Threaded (Way v n p t) = t + +data Field w s t +data SmStep +data RtsSpinLock + +field :: String -> m (Field w a b) +field = undefined + +type family WayOf (m :: * -> *) :: * + +sync_large_objects :: (Monad m, + (GHCVersion (WayOf m) :>=: GHC6'10 Minor1) ~ True, + Threaded (WayOf m) ~ True) + => m (Field (WayOf m) SmStep RtsSpinLock) +sync_large_objects = field "sync_large_objects" + +testcase :: Monad m => m (Field (Way (GHC6'8 minor) n t p) a b) +testcase = sync_large_objects + +{- Wanted constraints from the occurrence of sync_large_objects + + (WayOf m) ~ (Way (GHC6'8 minor) n t p) + a ~ SmStep + b ~ RtsSpinLock + + Threaded (WayOf m) ~ True + == Threaded (Way (GHC6'8 minor) n t p) ~ True + == p ~ True + + (GHCVersion (WayOf m) :>=: GHC6'10 Minor1) ~ True, + == (GHC6'10 Minor1 :<=: GHCVersion (WayOf m)) ~ True, + == (GHC6'10 Minor1 :<=: GHCVersion (Way (GHC6'8 minor) n t p))) ~ True, + == (GHC6'10 Minor1 :<=: GHC6'8 minor) ~ True + == False ~ True + +-} \ No newline at end of file diff --git a/testsuite/tests/indexed-types/should_fail/T4174.stderr b/testsuite/tests/indexed-types/should_fail/T4174.stderr new file mode 100644 index 0000000000..2a403786d9 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4174.stderr @@ -0,0 +1,5 @@ + +T4174.hs:42:12: + Couldn't match type `False' with `True' + In the expression: sync_large_objects + In an equation for `testcase': testcase = sync_large_objects diff --git a/testsuite/tests/indexed-types/should_fail/T4174.stderr-ghc-7.0 b/testsuite/tests/indexed-types/should_fail/T4174.stderr-ghc-7.0 new file mode 100644 index 0000000000..81fb603dd8 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4174.stderr-ghc-7.0 @@ -0,0 +1,7 @@ + +T4174.hs:42:12: + Couldn't match type `False' with `True' + Expected type: True + Actual type: GHCVersion (WayOf m) :>=: GHC6'10 Minor1 + In the expression: sync_large_objects + In an equation for `testcase': testcase = sync_large_objects diff --git a/testsuite/tests/indexed-types/should_fail/T4179.hs b/testsuite/tests/indexed-types/should_fail/T4179.hs new file mode 100644 index 0000000000..ee54100ccc --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4179.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE TypeFamilies #-} + +module T4179 where + +class DoC a where + type A2 a + type A3 a + op :: a -> A2 a -> A3 a + +data Con x = InCon (x (Con x)) +type FCon x = x (Con x) + +-- should have been changed to this, which works +-- foldDoC :: Functor f => (f a -> a) -> A2 (FCon f) -> Con f -> a +-- foldDoC f i (InCon t) = f (fmap (foldDoC f i) t) +-- this original version causes GHC to hang +foldDoC :: Functor f => (f a -> a) -> Con f -> a +foldDoC f (InCon t) = f (fmap (foldDoC f) t) + +doCon :: (DoC (FCon x)) => Con x -> A2 (FCon x) -> A3 (FCon x) +doCon (InCon x) = op x + +-- Note that if this is commented out then there's no hang: +-- presumably because GHC doesn't have to perform type deduction for foldDoC. +fCon :: (Functor x, DoC (FCon x)) => Con x -> A2 (FCon x) -> A3 (FCon x) +fCon = foldDoC op diff --git a/testsuite/tests/indexed-types/should_fail/T4179.stderr b/testsuite/tests/indexed-types/should_fail/T4179.stderr new file mode 100644 index 0000000000..50c1ad5365 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4179.stderr @@ -0,0 +1,63 @@ + +T4179.hs:26:16: + Could not deduce (DoC (x (A2 (FCon x) -> A3 (FCon x)))) + arising from a use of `op' + from the context (Functor x, DoC (FCon x)) + bound by the type signature for + fCon :: (Functor x, DoC (FCon x)) => + Con x -> A2 (FCon x) -> A3 (FCon x) + at T4179.hs:26:1-17 + Possible fix: + add (DoC (x (A2 (FCon x) -> A3 (FCon x)))) to the context of + the type signature for + fCon :: (Functor x, DoC (FCon x)) => + Con x -> A2 (FCon x) -> A3 (FCon x) + or add an instance declaration for + (DoC (x (A2 (FCon x) -> A3 (FCon x)))) + In the first argument of `foldDoC', namely `op' + In the expression: foldDoC op + In an equation for `fCon': fCon = foldDoC op + +T4179.hs:26:16: + Could not deduce (A2 (x (A2 (FCon x) -> A3 (FCon x))) + ~ + A2 (FCon x)) + from the context (Functor x, DoC (FCon x)) + bound by the type signature for + fCon :: (Functor x, DoC (FCon x)) => + Con x -> A2 (FCon x) -> A3 (FCon x) + at T4179.hs:26:1-17 + NB: `A2' is a type function, and may not be injective + Expected type: A2 (FCon x) -> A3 (FCon x) + Actual type: A2 (x (A2 (FCon x) -> A3 (FCon x))) + -> A3 (x (A2 (FCon x) -> A3 (FCon x))) + Expected type: x (A2 (FCon x) -> A3 (FCon x)) + -> A2 (FCon x) + -> A3 (FCon x) + Actual type: x (A2 (FCon x) -> A3 (FCon x)) + -> A2 (x (A2 (FCon x) -> A3 (FCon x))) + -> A3 (x (A2 (FCon x) -> A3 (FCon x))) + In the first argument of `foldDoC', namely `op' + In the expression: foldDoC op + +T4179.hs:26:16: + Could not deduce (A3 (x (A2 (FCon x) -> A3 (FCon x))) + ~ + A3 (FCon x)) + from the context (Functor x, DoC (FCon x)) + bound by the type signature for + fCon :: (Functor x, DoC (FCon x)) => + Con x -> A2 (FCon x) -> A3 (FCon x) + at T4179.hs:26:1-17 + NB: `A3' is a type function, and may not be injective + Expected type: A2 (FCon x) -> A3 (FCon x) + Actual type: A2 (x (A2 (FCon x) -> A3 (FCon x))) + -> A3 (x (A2 (FCon x) -> A3 (FCon x))) + Expected type: x (A2 (FCon x) -> A3 (FCon x)) + -> A2 (FCon x) + -> A3 (FCon x) + Actual type: x (A2 (FCon x) -> A3 (FCon x)) + -> A2 (x (A2 (FCon x) -> A3 (FCon x))) + -> A3 (x (A2 (FCon x) -> A3 (FCon x))) + In the first argument of `foldDoC', namely `op' + In the expression: foldDoC op diff --git a/testsuite/tests/indexed-types/should_fail/T4246.hs b/testsuite/tests/indexed-types/should_fail/T4246.hs new file mode 100644 index 0000000000..b5c37a68e3 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4246.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TypeFamilies, FlexibleInstances, OverlappingInstances #-} +module T4246 where + +class Stupid a where + type F a + +instance Stupid a where + type F a = a + +instance Stupid Int where + type F Int = Bool + +type family G a :: * +type instance G Int = Int +type instance G Int = Bool diff --git a/testsuite/tests/indexed-types/should_fail/T4246.stderr b/testsuite/tests/indexed-types/should_fail/T4246.stderr new file mode 100644 index 0000000000..fe1cfce250 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4246.stderr @@ -0,0 +1,10 @@ + +T4246.hs:8:9: + Conflicting family instance declarations: + type F a -- Defined at T4246.hs:8:9 + type F Int -- Defined at T4246.hs:11:9 + +T4246.hs:15:15: + Conflicting family instance declarations: + type instance G Int -- Defined at T4246.hs:15:15 + type instance G Int -- Defined at T4246.hs:14:15 diff --git a/testsuite/tests/indexed-types/should_fail/T4254.hs b/testsuite/tests/indexed-types/should_fail/T4254.hs new file mode 100644 index 0000000000..b12ffb4f87 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4254.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TypeFamilies, FunctionalDependencies, RankNTypes, MultiParamTypeClasses #-} +module T4254 where + +class FD a b | a -> b where + op :: a -> b; + op = undefined + +instance FD Int Bool + +ok1 :: forall a b. (a~Int,FD a b) => a -> b +ok1 = op +-- Should be OK: op has the right type + +ok2 :: forall a b. (a~Int,FD a b,b~Bool) => a -> Bool +ok2 = op +-- Should be OK: needs the b~Bool + +fails :: forall a b. (a~Int,FD a b) => a -> Bool +fails = op +-- Could fail: no proof that b~Bool +-- But can also succeed; it's not a *wanted* constraint diff --git a/testsuite/tests/indexed-types/should_fail/T4254.stderr b/testsuite/tests/indexed-types/should_fail/T4254.stderr new file mode 100644 index 0000000000..03aa80bdac --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4254.stderr @@ -0,0 +1,18 @@ + +T4254.hs:19:10: + Could not deduce (b ~ Bool) + from the context (a ~ Int, FD a b) + bound by the type signature for + fails :: (a ~ Int, FD a b) => a -> Bool + at T4254.hs:19:1-11 + `b' is a rigid type variable bound by + the type signature for fails :: (a ~ Int, FD a b) => a -> Bool + at T4254.hs:19:1 + When using functional dependencies to combine + FD Int b, + arising from the type signature for + fails :: (a ~ Int, FD a b) => a -> Bool + at T4254.hs:19:1-11 + FD Int Bool, arising from a use of `op' at T4254.hs:19:10-11 + In the expression: op + In an equation for `fails': fails = op diff --git a/testsuite/tests/indexed-types/should_fail/T4272.hs b/testsuite/tests/indexed-types/should_fail/T4272.hs new file mode 100644 index 0000000000..3370fc3637 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4272.hs @@ -0,0 +1,22 @@ + {-# LANGUAGE TypeFamilies, ScopedTypeVariables, FlexibleContexts #-} +module T4272 where + +class Family f where + terms :: f a -> a + +class Family (TermFamily a) => TermLike a where + type TermFamily a :: * -> * + +laws :: forall a b. TermLike a => TermFamily a a -> b +laws t = prune t (terms (undefined :: TermFamily a a)) + +prune :: TermLike a => TermFamily a a -> TermFamily a a -> b +prune = undefined + +-- terms :: Family f => f a -> a +-- Instantiate with f = TermFamily a +-- terms :: Family (TermFamily a) => TermFamily a a -> a +-- (terms (undefined::TermFamily a a) :: Family (TermFamily a) => a +-- So the call to prune forces the equality +-- TermFamily a a ~ a +-- which triggers an occurs check \ No newline at end of file diff --git a/testsuite/tests/indexed-types/should_fail/T4272.stderr b/testsuite/tests/indexed-types/should_fail/T4272.stderr new file mode 100644 index 0000000000..792cde92b8 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4272.stderr @@ -0,0 +1,8 @@ + +T4272.hs:11:16: + Occurs check: cannot construct the infinite type: + a0 = TermFamily a0 a0 + In the first argument of `prune', namely `t' + In the expression: prune t (terms (undefined :: TermFamily a a)) + In an equation for `laws': + laws t = prune t (terms (undefined :: TermFamily a a)) diff --git a/testsuite/tests/indexed-types/should_fail/T4485.hs b/testsuite/tests/indexed-types/should_fail/T4485.hs new file mode 100644 index 0000000000..b48e8206f2 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4485.hs @@ -0,0 +1,66 @@ +-- The behavior of type-inference and OverlappingInstances has changed +-- between GHC 6.12 and GHC 7.0 such that the following code +-- type-checks under 6.12, but not 7.0rc2. I assume this change has +-- something to do with the new type checker in GHC 7, but it is not +-- clear to me if this change in behavior is intended. Nor am I clear +-- how to achieve something similar to the old behavior. This is +-- preventing HSP (and by extension, happstack) from migrating to GHC +-- 7. I reported this earlier on the mailing lists, but I have further +-- simplied the test case here. + +{-# LANGUAGE TypeFamilies, MultiParamTypeClasses + , FlexibleContexts, FlexibleInstances, UndecidableInstances + , TypeSynonymInstances, GeneralizedNewtypeDeriving + , OverlappingInstances + #-} +module XMLGenerator where + +newtype XMLGenT m a = XMLGenT (m a) + deriving (Functor, Monad) + +class Monad m => XMLGen m where + type XML m + data Child m + genElement :: String -> XMLGenT m (XML m) + +class XMLGen m => EmbedAsChild m c where + asChild :: c -> XMLGenT m [Child m] + +instance (EmbedAsChild m c, m1 ~ m) => EmbedAsChild m (XMLGenT m1 c) + +instance (XMLGen m, XML m ~ x) => EmbedAsChild m x + +data Xml = Xml +data IdentityT m a = IdentityT (m a) +instance Monad (IdentityT m) +instance XMLGen (IdentityT m) where + type XML (IdentityT m) = Xml + +data Identity a = Identity a +instance Monad Identity + +instance EmbedAsChild (IdentityT IO) (XMLGenT Identity ()) + +data FooBar = FooBar + +instance EmbedAsChild (IdentityT IO) FooBar where + asChild b = asChild $ (genElement "foo") + -- asChild :: FooBar -> XMLGenT (XMLGenT (IdentityT IO) [Child (IdentitiyT IO)]) + +{- ---------- Deriving the constraints ---------- + asChild :: EmbedAsChild m c => c -> XMLGenT m [Child m] + genElement :: XMLGen m => String -> XMLGenT m (XML m) + + Wanted: EmbedAsChild m c, with m = IdentityT IO + c = XMLGenT meta (XML meta) + XMLGen meta + + ie EmbedAsChild (IdentityT IO) (XMLGen meta (XML meta) + XMLGen meta + +We have instances + EmbedAsChild (IdentityT IO) FooBar + EmbedAsChild (IdentityT IO) (XMLGenT Identity ()) + EmbedAsChild m (XMLGenT m1 c) + EmbedAsChild m x +-} diff --git a/testsuite/tests/indexed-types/should_fail/T4485.stderr b/testsuite/tests/indexed-types/should_fail/T4485.stderr new file mode 100644 index 0000000000..a9e9792cda --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T4485.stderr @@ -0,0 +1,19 @@ + +T4485.hs:47:15: + Overlapping instances for EmbedAsChild + (IdentityT IO) (XMLGenT m0 (XML m0)) + arising from a use of `asChild' + Matching instances: + instance [overlap ok] (m1 ~ m, EmbedAsChild m c) => + EmbedAsChild m (XMLGenT m1 c) + -- Defined at T4485.hs:29:10-68 + instance [overlap ok] EmbedAsChild + (IdentityT IO) (XMLGenT Identity ()) + -- Defined at T4485.hs:42:10-58 + (The choice depends on the instantiation of `m0' + To pick the first instance above, use -XIncoherentInstances + when compiling the other instance declarations) + In the expression: asChild + In the expression: asChild $ (genElement "foo") + In an equation for `asChild': + asChild b = asChild $ (genElement "foo") diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity1.hs b/testsuite/tests/indexed-types/should_fail/TyFamArity1.hs new file mode 100644 index 0000000000..4a35071e2f --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/TyFamArity1.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} + +type family T a b :: * +type instance T Int = IO -- must fail: too few args diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr new file mode 100644 index 0000000000..7ee60167e1 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr @@ -0,0 +1,4 @@ + +TyFamArity1.hs:4:1: + Number of parameters must match family declaration; expected 2 + In the type synonym instance declaration for `T' diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity2.hs b/testsuite/tests/indexed-types/should_fail/TyFamArity2.hs new file mode 100644 index 0000000000..2bff129925 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/TyFamArity2.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} + +type family T a :: * -> * +type instance T Int Float = Char -- must fail: extra arguments diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr new file mode 100644 index 0000000000..30d0526664 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr @@ -0,0 +1,4 @@ + +TyFamArity2.hs:4:1: + Number of parameters must match family declaration; expected 1 + In the type synonym instance declaration for `T' diff --git a/testsuite/tests/indexed-types/should_fail/TyFamUndec.hs b/testsuite/tests/indexed-types/should_fail/TyFamUndec.hs new file mode 100644 index 0000000000..2c81faab2d --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/TyFamUndec.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +module ShouldFail where + +type family T a +type instance T (a, [b]) = T (b, b) -- var occurs more often +type instance T (a, Maybe b) = T (a, Maybe b) -- not smaller +type instance T (a, IO [b]) = T (a, T b) -- nested tyfam application diff --git a/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr b/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr new file mode 100644 index 0000000000..2fc8e1b078 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr @@ -0,0 +1,18 @@ + +TyFamUndec.hs:6:1: + Variable occurs more often than in instance head + in the type family application: T (b, b) + (Use -XUndecidableInstances to permit this) + In the type synonym instance declaration for `T' + +TyFamUndec.hs:7:1: + Application is no smaller than the instance head + in the type family application: T (a, Maybe b) + (Use -XUndecidableInstances to permit this) + In the type synonym instance declaration for `T' + +TyFamUndec.hs:8:1: + Nested type family application + in the type family application: T (a, T b) + (Use -XUndecidableInstances to permit this) + In the type synonym instance declaration for `T' diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T new file mode 100644 index 0000000000..f2d904d32e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -0,0 +1,72 @@ +setTestOpts(only_compiler_types(['ghc'])) +setTestOpts(omit_ways(['optasm'])) + +test('SimpleFail1a', normal, compile_fail, ['']) +test('SimpleFail1b', normal, compile_fail, ['']) +test('SimpleFail2a', normal, compile_fail, ['']) +test('SimpleFail2b', normal, compile_fail, ['']) +test('SimpleFail3a', normal, compile_fail, ['']) +test('SimpleFail4', normal, compile_fail, ['']) +test('SimpleFail5a', normal, compile_fail, ['']) +test('SimpleFail5b', normal, compile_fail, ['']) +test('SimpleFail6', normal, compile_fail, ['']) +test('SimpleFail7', normal, compile_fail, ['']) +test('SimpleFail8', normal, compile_fail, ['']) +test('SimpleFail9', normal, compile_fail, ['']) +test('SimpleFail10', normal, compile_fail, ['']) +test('SimpleFail11a', normal, compile_fail, ['']) +test('SimpleFail11b', normal, compile_fail, ['']) +test('SimpleFail11c', normal, compile_fail, ['']) +test('SimpleFail11d', normal, compile_fail, ['']) +test('SimpleFail12', normal, compile_fail, ['']) +test('SimpleFail13', normal, compile_fail, ['']) +test('SimpleFail14', normal, compile_fail, ['']) +test('SimpleFail15', normal, compile_fail, ['']) +test('SimpleFail16', normal, compile_fail, ['']) +test('TyFamArity1', normal, compile_fail, ['']) +test('TyFamArity2', normal, compile_fail, ['']) +test('TyFamUndec', normal, compile_fail, ['']) + +test('NotRelaxedExamples', normal, compile_fail, ['']) +test('NonLinearSigErr', normal, compile, ['']) + +test('GADTwrong1', normal, compile_fail, ['']) + +test('Over', + extra_clean(['OverA.hi', 'OverA.o', + 'OverB.hi', 'OverB.o', + 'OverC.hi', 'OverC.o']), + multimod_compile_fail, + ['OverD', '-no-hs-main -c -v0']) + +test('SkolemOccursLoop', expect_fail, compile_fail, ['']) + +test('T2334', normal, compile_fail, ['']) +test('T1900', normal, compile_fail, ['']) +test('T2157', normal, compile_fail, ['']) +test('T2203a', normal, compile_fail, ['']) +test('T2627b', normal, compile_fail, ['']) +test('T2693', normal, compile_fail, ['']) +test('T2888', normal, compile, ['']) +test('T3092', normal, compile_fail, ['']) +test('NoMatchErr', normal, compile_fail, ['']) +test('T2677', normal, compile_fail, ['']) +test('T4099', normal, compile_fail, ['']) +test('T4272', normal, compile_fail, ['']) +test('T4246', normal, compile_fail, ['']) +test('T4093a', normal, compile_fail, ['']) +test('T4093b', normal, compile_fail, ['']) +test('T3330a', reqlib('mtl'), compile_fail, ['']) +test('T3330b', normal, compile_fail, ['']) +test('T3330c', normal, compile_fail, ['']) +test('T4179', normal, compile_fail, ['']) +test('T4254', normal, compile_fail, ['']) +test('T2239', normal, compile_fail, ['']) +test('T3440', normal, compile_fail, ['']) +test('T4485', normal, compile_fail, ['']) +test('T4174', normal, compile_fail, ['']) +test('DerivUnsatFam', if_compiler_lt('ghc', '7.1', expect_fail), compile_fail, ['']) +test('T2664', normal, compile_fail, ['']) +test('T2664a', normal, compile, ['']) +test('T2544', normal, compile_fail, ['']) + -- cgit v1.2.1