Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/187bae1b33660b089abe5b50f31041fca531fb16 >--------------------------------------------------------------- commit 187bae1b33660b089abe5b50f31041fca531fb16 Author: Ian Lynagh <[email protected]> Date: Tue May 24 22:46:12 2011 +0100 Add "LANGUAGE DatatypeContexts" pragmas to some tcfail tests >--------------------------------------------------------------- .../ghc-regress/typecheck/should_fail/tcfail067.hs | 2 +- .../ghc-regress/typecheck/should_fail/tcfail102.hs | 1 + .../typecheck/should_fail/tcfail102.stderr | 4 ++-- .../ghc-regress/typecheck/should_fail/tcfail125.hs | 2 +- .../ghc-regress/typecheck/should_fail/tcfail133.hs | 2 +- .../ghc-regress/typecheck/should_fail/tcfail137.hs | 2 +- .../ghc-regress/typecheck/should_fail/tcfail151.hs | 1 + .../typecheck/should_fail/tcfail151.stderr | 2 +- 8 files changed, 9 insertions(+), 7 deletions(-) diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail067.hs b/tests/ghc-regress/typecheck/should_fail/tcfail067.hs index db9cb9c..bcdb0c7 100644 --- a/tests/ghc-regress/typecheck/should_fail/tcfail067.hs +++ b/tests/ghc-regress/typecheck/should_fail/tcfail067.hs @@ -1,8 +1,8 @@ +{-# LANGUAGE DatatypeContexts #-} module ShouldFail where infixr 1 `rangeOf` - data Ord a => SubRange a = SubRange (a, a) a type IntSubRange = SubRange Int diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail102.hs b/tests/ghc-regress/typecheck/should_fail/tcfail102.hs index 91f9bb8..f494178 100644 --- a/tests/ghc-regress/typecheck/should_fail/tcfail102.hs +++ b/tests/ghc-regress/typecheck/should_fail/tcfail102.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DatatypeContexts #-} module ShouldFail where import Data.Ratio diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail102.stderr b/tests/ghc-regress/typecheck/should_fail/tcfail102.stderr index 27fa9ae..ffbba5d 100644 --- a/tests/ghc-regress/typecheck/should_fail/tcfail102.stderr +++ b/tests/ghc-regress/typecheck/should_fail/tcfail102.stderr @@ -1,10 +1,10 @@ -tcfail102.hs:8:7: +tcfail102.hs:9:7: Could not deduce (Integral (Ratio a)) arising from a record update from the context (Integral a) bound by the type signature for f :: Integral a => P (Ratio a) -> P (Ratio a) - at tcfail102.hs:8:1-19 + at tcfail102.hs:9:1-19 Possible fix: add (Integral (Ratio a)) to the context of the type signature for diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail125.hs b/tests/ghc-regress/typecheck/should_fail/tcfail125.hs index 0c70573..664354d 100644 --- a/tests/ghc-regress/typecheck/should_fail/tcfail125.hs +++ b/tests/ghc-regress/typecheck/should_fail/tcfail125.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE DatatypeContexts, ExistentialQuantification #-} -- Tests the "stupid theta" in pattern-matching -- when there's an existential as well diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail133.hs b/tests/ghc-regress/typecheck/should_fail/tcfail133.hs index cbfc2cb..af45be9 100644 --- a/tests/ghc-regress/typecheck/should_fail/tcfail133.hs +++ b/tests/ghc-regress/typecheck/should_fail/tcfail133.hs @@ -1,5 +1,5 @@ {-# LANGUAGE UndecidableInstances, FlexibleInstances, TypeOperators, - MultiParamTypeClasses, FunctionalDependencies #-} + MultiParamTypeClasses, FunctionalDependencies, DatatypeContexts #-} -- This one crashed GHC 6.3 due to an error in TcSimplify.add_ors diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail137.hs b/tests/ghc-regress/typecheck/should_fail/tcfail137.hs index 7258f34..3d3b4e0 100644 --- a/tests/ghc-regress/typecheck/should_fail/tcfail137.hs +++ b/tests/ghc-regress/typecheck/should_fail/tcfail137.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DatatypeContexts #-} -- Test the stupid context on newtypes -- (GHC 6.4 dropped it on the floor by mistake) - module ShouldFail where newtype Floating a => Test a = Test [a] diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail151.hs b/tests/ghc-regress/typecheck/should_fail/tcfail151.hs index 0d21282..112973b 100644 --- a/tests/ghc-regress/typecheck/should_fail/tcfail151.hs +++ b/tests/ghc-regress/typecheck/should_fail/tcfail151.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DatatypeContexts #-} module ShouldFail where class (Show a, Eq a, Monad m) => Name m a where diff --git a/tests/ghc-regress/typecheck/should_fail/tcfail151.stderr b/tests/ghc-regress/typecheck/should_fail/tcfail151.stderr index e67a4ea..379d610 100644 --- a/tests/ghc-regress/typecheck/should_fail/tcfail151.stderr +++ b/tests/ghc-regress/typecheck/should_fail/tcfail151.stderr @@ -1,5 +1,5 @@ -tcfail151.hs:7:6: +tcfail151.hs:8:6: `Name a' is not applied to enough type arguments Expected kind `?', but `Name a' has kind `* -> *' In the data type declaration for `Exp' _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
