Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/89d165d1a8881cb6ed35737c20cc44e29eb88da8 >--------------------------------------------------------------- commit 89d165d1a8881cb6ed35737c20cc44e29eb88da8 Author: Simon Marlow <[email protected]> Date: Mon Jul 9 11:24:13 2012 +0100 Adapt to removal of catch from Prelude >--------------------------------------------------------------- tests/enum01.hs | 3 +++ tests/enum02.hs | 3 +++ tests/enum03.hs | 3 +++ tests/list001.hs | 7 +++++-- 4 files changed, 14 insertions(+), 2 deletions(-) diff --git a/tests/enum01.hs b/tests/enum01.hs index d817866..8b490bb 100644 --- a/tests/enum01.hs +++ b/tests/enum01.hs @@ -1,8 +1,11 @@ -- !!! Testing the Prelude's Enum instances. +{-# LANGUAGE CPP #-} module Main(main) where import Control.Exception +#if __GLASGOW_HASKELL__ < 705 import Prelude hiding (catch) +#endif import Data.Char import Data.Ratio diff --git a/tests/enum02.hs b/tests/enum02.hs index 3ba9d49..95812e5 100644 --- a/tests/enum02.hs +++ b/tests/enum02.hs @@ -1,8 +1,11 @@ -- !!! Testing the Int Enum instances. +{-# LANGUAGE CPP #-} module Main(main) where import Control.Exception +#if __GLASGOW_HASKELL__ < 705 import Prelude hiding (catch) +#endif import Data.Int main = do diff --git a/tests/enum03.hs b/tests/enum03.hs index 908f3dd..9f730a9 100644 --- a/tests/enum03.hs +++ b/tests/enum03.hs @@ -1,7 +1,10 @@ -- !!! Testing the Word Enum instances. +{-# LANGUAGE CPP #-} module Main(main) where +#if __GLASGOW_HASKELL__ < 705 import Prelude hiding (catch) +#endif import Control.Exception import Data.Word import Data.Int diff --git a/tests/list001.hs b/tests/list001.hs index c0a1ece..cec5f99 100644 --- a/tests/list001.hs +++ b/tests/list001.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE CPP #-} module Main where import Data.List import Control.Exception +#if __GLASGOW_HASKELL__ < 705 import Prelude hiding (catch) +#endif -- This module briefly tests all the functions in PrelList and a few -- from List. @@ -146,7 +149,7 @@ main = do print [delete 1 [0,1,1,2,3,4], delete (error "delete") []] - -- \\ + -- (\\) print [ [0,1,1,2,3,4] \\ [3,2,1], - [1,2,3,4] \\ [], + [1,2,3,4] \\ [], [] \\ [error "\\\\"] ] _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
