Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f7fd2ebd4ce3e48b47592c8091f217fc975ed1b7 >--------------------------------------------------------------- commit f7fd2ebd4ce3e48b47592c8091f217fc975ed1b7 Author: Ian Lynagh <[email protected]> Date: Sat Jan 14 02:14:26 2012 +0000 Update tests after instances are moved out of Control.Monad.Instances The instance-leaks test is now gone, as we now expect the instances to leak into haskell98. >--------------------------------------------------------------- tests/deriving/should_compile/T3057.hs | 4 +++- tests/deriving/should_compile/T3057A.hs | 4 ++++ tests/deriving/should_compile/all.T | 2 +- tests/ghci/scripts/ghci011.stdout | 1 + tests/ghci/scripts/ghci020.stdout | 2 ++ tests/lib/haskell98/Makefile | 3 --- tests/lib/haskell98/all.T | 1 - tests/lib/haskell98/instance-leaks.hs | 27 --------------------------- 8 files changed, 11 insertions(+), 33 deletions(-) diff --git a/tests/deriving/should_compile/T3057.hs b/tests/deriving/should_compile/T3057.hs index 0e9aef7..c0b064e 100644 --- a/tests/deriving/should_compile/T3057.hs +++ b/tests/deriving/should_compile/T3057.hs @@ -1,6 +1,8 @@ {-# LANGUAGE StandaloneDeriving, DeriveFunctor #-} module T3057 where -deriving instance Functor (Either a) +import T3057A + +deriving instance Functor (MyType a) diff --git a/tests/deriving/should_compile/T3057A.hs b/tests/deriving/should_compile/T3057A.hs new file mode 100644 index 0000000..410615d --- /dev/null +++ b/tests/deriving/should_compile/T3057A.hs @@ -0,0 +1,4 @@ + +module T3057A where + +data MyType a b = C1 a | C2 b diff --git a/tests/deriving/should_compile/all.T b/tests/deriving/should_compile/all.T index 22353ab..f6b1ef4 100644 --- a/tests/deriving/should_compile/all.T +++ b/tests/deriving/should_compile/all.T @@ -18,7 +18,7 @@ test('drv021', normal, compile, ['']) test('deriving-1935', normal, compile, ['']) test('T2378', normal, compile, ['']) test('T2856', normal, compile, ['']) -test('T3057', normal, compile, ['']) +test('T3057', extra_clean(['T3057A.o', 'T3057A.hi']), multimod_compile, ['T3057', '-v0']) test('T3012', normal, compile, ['']) test('T3965', normal, compile, ['']) test('T4220', normal, compile, ['']) diff --git a/tests/ghci/scripts/ghci011.stdout b/tests/ghci/scripts/ghci011.stdout index 8d78f41..caed5d0 100644 --- a/tests/ghci/scripts/ghci011.stdout +++ b/tests/ghci/scripts/ghci011.stdout @@ -16,6 +16,7 @@ data (,) a b = (,) a b -- Defined in `GHC.Tuple' instance (Bounded a, Bounded b) => Bounded (a, b) -- Defined in `GHC.Enum' instance (Eq a, Eq b) => Eq (a, b) -- Defined in `GHC.Classes' +instance Functor ((,) a) -- Defined in `GHC.Base' instance (Ord a, Ord b) => Ord (a, b) -- Defined in `GHC.Classes' instance (Read a, Read b) => Read (a, b) -- Defined in `GHC.Read' instance (Show a, Show b) => Show (a, b) -- Defined in `GHC.Show' diff --git a/tests/ghci/scripts/ghci020.stdout b/tests/ghci/scripts/ghci020.stdout index 2741b4f..333e785 100644 --- a/tests/ghci/scripts/ghci020.stdout +++ b/tests/ghci/scripts/ghci020.stdout @@ -1 +1,3 @@ data (->) a b -- Defined in `GHC.Prim' +instance Monad ((->) r) -- Defined in `GHC.Base' +instance Functor ((->) r) -- Defined in `GHC.Base' diff --git a/tests/lib/haskell98/Makefile b/tests/lib/haskell98/Makefile deleted file mode 100644 index 9101fbd..0000000 --- a/tests/lib/haskell98/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/tests/lib/haskell98/all.T b/tests/lib/haskell98/all.T deleted file mode 100644 index 85e226f..0000000 --- a/tests/lib/haskell98/all.T +++ /dev/null @@ -1 +0,0 @@ -test('instance-leaks', normal, compile, ['-hide-all-packages -package haskell98']) diff --git a/tests/lib/haskell98/instance-leaks.hs b/tests/lib/haskell98/instance-leaks.hs deleted file mode 100644 index 131d42c..0000000 --- a/tests/lib/haskell98/instance-leaks.hs +++ /dev/null @@ -1,27 +0,0 @@ --- Check that the instances in Control.Monad.Instances do not leak --- into any Haskell 98 modules. -module Main where - --- import all Haskell 98 modules -import Array -import Char -import Complex -import CPUTime -import Directory -import IO -import Ix -import List -import Locale -import Maybe -import Monad -import Numeric -import Random -import Ratio -import System -import Time - --- This will fail if any of the Haskell 98 modules indirectly import --- Control.Monad.Instances -instance Functor ((->) r) where fmap = (.) - -main = undefined _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
