Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4750db20d3ab4f9cd32a9efe09576b47b51e2699 >--------------------------------------------------------------- commit 4750db20d3ab4f9cd32a9efe09576b47b51e2699 Author: Ian Lynagh <[email protected]> Date: Tue May 24 23:04:55 2011 +0100 Add "LANGUAGE DatatypeContexts" pragmas to some tests >--------------------------------------------------------------- tests/ghc-regress/array/should_run/arr016.hs | 2 +- tests/ghc-regress/deSugar/should_compile/ds041.hs | 1 + .../deSugar/should_compile/ds041.stderr-ghc | 2 +- tests/ghc-regress/deriving/should_compile/T4325.hs | 1 + tests/ghc-regress/deriving/should_compile/T4966.hs | 1 + .../should_compile/drv-foldable-traversable1.hs | 2 +- .../deriving/should_compile/drv-functor1.hs | 1 + .../deriving/should_fail/drvfail-functor2.hs | 2 +- tests/ghc-regress/ghci/scripts/ghci031.hs | 1 + tests/ghc-regress/ghci/scripts/ghci031.stdout | 2 +- .../indexed-types/should_compile/T3418.hs | 2 +- tests/ghc-regress/parser/should_compile/read018.hs | 1 + .../ghc-regress/typecheck/should_compile/T2478.hs | 2 +- .../ghc-regress/typecheck/should_compile/T4355.hs | 2 +- 14 files changed, 14 insertions(+), 8 deletions(-) diff --git a/tests/ghc-regress/array/should_run/arr016.hs b/tests/ghc-regress/array/should_run/arr016.hs index 81e3242..055e660 100644 --- a/tests/ghc-regress/array/should_run/arr016.hs +++ b/tests/ghc-regress/array/should_run/arr016.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, DatatypeContexts #-} module Main where diff --git a/tests/ghc-regress/deSugar/should_compile/ds041.hs b/tests/ghc-regress/deSugar/should_compile/ds041.hs index 9fafd58..90c1c22 100644 --- a/tests/ghc-regress/deSugar/should_compile/ds041.hs +++ b/tests/ghc-regress/deSugar/should_compile/ds041.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DatatypeContexts #-} {- In 2.05 this one crashed with Fail: "basicTypes/Id.lhs", line 990: incomplete pattern(s) diff --git a/tests/ghc-regress/deSugar/should_compile/ds041.stderr-ghc b/tests/ghc-regress/deSugar/should_compile/ds041.stderr-ghc index dc82113..f9697c6 100644 --- a/tests/ghc-regress/deSugar/should_compile/ds041.stderr-ghc +++ b/tests/ghc-regress/deSugar/should_compile/ds041.stderr-ghc @@ -1,5 +1,5 @@ -ds041.hs:15:7: +ds041.hs:16:7: Warning: Fields of `Foo' not initialised: x In the expression: Foo {} In an equation for `foo': foo = Foo {} diff --git a/tests/ghc-regress/deriving/should_compile/T4325.hs b/tests/ghc-regress/deriving/should_compile/T4325.hs index 499e2aa..68ab817 100644 --- a/tests/ghc-regress/deriving/should_compile/T4325.hs +++ b/tests/ghc-regress/deriving/should_compile/T4325.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DatatypeContexts #-} module T4325 where diff --git a/tests/ghc-regress/deriving/should_compile/T4966.hs b/tests/ghc-regress/deriving/should_compile/T4966.hs index 1695c33..d7328c6 100644 --- a/tests/ghc-regress/deriving/should_compile/T4966.hs +++ b/tests/ghc-regress/deriving/should_compile/T4966.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DatatypeContexts #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} diff --git a/tests/ghc-regress/deriving/should_compile/drv-foldable-traversable1.hs b/tests/ghc-regress/deriving/should_compile/drv-foldable-traversable1.hs index 1a78435..712f14a 100644 --- a/tests/ghc-regress/deriving/should_compile/drv-foldable-traversable1.hs +++ b/tests/ghc-regress/deriving/should_compile/drv-foldable-traversable1.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, DatatypeContexts #-} module ShouldCompile where diff --git a/tests/ghc-regress/deriving/should_compile/drv-functor1.hs b/tests/ghc-regress/deriving/should_compile/drv-functor1.hs index 15500b3..8249858 100644 --- a/tests/ghc-regress/deriving/should_compile/drv-functor1.hs +++ b/tests/ghc-regress/deriving/should_compile/drv-functor1.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DatatypeContexts #-} module ShouldCompile where diff --git a/tests/ghc-regress/deriving/should_fail/drvfail-functor2.hs b/tests/ghc-regress/deriving/should_fail/drvfail-functor2.hs index 79ec2fe..7198755 100644 --- a/tests/ghc-regress/deriving/should_fail/drvfail-functor2.hs +++ b/tests/ghc-regress/deriving/should_fail/drvfail-functor2.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFunctor, DatatypeContexts #-} module ShouldFail where -- Derive Functor on a type that uses 'a' in the wrong places diff --git a/tests/ghc-regress/ghci/scripts/ghci031.hs b/tests/ghc-regress/ghci/scripts/ghci031.hs index 7d37154..ef5d985 100644 --- a/tests/ghc-regress/ghci/scripts/ghci031.hs +++ b/tests/ghc-regress/ghci/scripts/ghci031.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DatatypeContexts #-} -- Trac #2138 -- If we :i D, we should see the Eq constraint diff --git a/tests/ghc-regress/ghci/scripts/ghci031.stdout b/tests/ghc-regress/ghci/scripts/ghci031.stdout index 3acc527..018dc4b 100644 --- a/tests/ghc-regress/ghci/scripts/ghci031.stdout +++ b/tests/ghc-regress/ghci/scripts/ghci031.stdout @@ -1 +1 @@ -data Eq a => D a = C a -- Defined at ghci031.hs:6:14 +data Eq a => D a = C a -- Defined at ghci031.hs:7:14 diff --git a/tests/ghc-regress/indexed-types/should_compile/T3418.hs b/tests/ghc-regress/indexed-types/should_compile/T3418.hs index 7c01082..a0ffaf0 100644 --- a/tests/ghc-regress/indexed-types/should_compile/T3418.hs +++ b/tests/ghc-regress/indexed-types/should_compile/T3418.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilies, DatatypeContexts #-} module T3418 where newtype (a ~ b) => S a b = S { unS :: a } diff --git a/tests/ghc-regress/parser/should_compile/read018.hs b/tests/ghc-regress/parser/should_compile/read018.hs index e4abfb6..91eef51 100644 --- a/tests/ghc-regress/parser/should_compile/read018.hs +++ b/tests/ghc-regress/parser/should_compile/read018.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DatatypeContexts #-} -- !!! Checking that empty contexts are permitted. module ShouldCompile where diff --git a/tests/ghc-regress/typecheck/should_compile/T2478.hs b/tests/ghc-regress/typecheck/should_compile/T2478.hs index a71a69e..eec589b 100644 --- a/tests/ghc-regress/typecheck/should_compile/T2478.hs +++ b/tests/ghc-regress/typecheck/should_compile/T2478.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ExistentialQuantification, DatatypeContexts #-} module ShouldCompile where diff --git a/tests/ghc-regress/typecheck/should_compile/T4355.hs b/tests/ghc-regress/typecheck/should_compile/T4355.hs index bed2787..8eff366 100644 --- a/tests/ghc-regress/typecheck/should_compile/T4355.hs +++ b/tests/ghc-regress/typecheck/should_compile/T4355.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, Rank2Types, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, Rank2Types, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards, DatatypeContexts #-} module T4355 where _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
