Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/0a7cd204d8069d458b5bfb40372c07d9524180d1 >--------------------------------------------------------------- commit 0a7cd204d8069d458b5bfb40372c07d9524180d1 Author: Simon Marlow <[email protected]> Date: Mon Nov 14 11:03:19 2011 +0000 Reduce this test case further. There looks to be something suspicious going on, perhaps a general bug related to .hs-boot files, we should really look at this. >--------------------------------------------------------------- tests/rename/should_compile/T3103/Foreign/Ptr.hs | 8 +---- tests/rename/should_compile/T3103/GHC/Base.lhs | 15 +++------- tests/rename/should_compile/T3103/GHC/Num.lhs | 29 -------------------- tests/rename/should_compile/T3103/GHC/Show.lhs | 8 ----- tests/rename/should_compile/T3103/GHC/Unicode.hs | 9 +----- .../should_compile/T3103/GHC/Unicode.hs-boot | 4 --- tests/rename/should_compile/T3103/GHC/Word.hs | 12 +------- 7 files changed, 8 insertions(+), 77 deletions(-) diff --git a/tests/rename/should_compile/T3103/Foreign/Ptr.hs b/tests/rename/should_compile/T3103/Foreign/Ptr.hs index c0f1d62..a0f68bb 100644 --- a/tests/rename/should_compile/T3103/Foreign/Ptr.hs +++ b/tests/rename/should_compile/T3103/Foreign/Ptr.hs @@ -2,13 +2,9 @@ module Foreign.Ptr () where -import GHC.Classes (Eq) import GHC.Show (Show(..)) -import GHC.Num (Num) import GHC.Word (Word) +import GHC.Base (Num) newtype WordPtr = WordPtr Word - deriving (Eq,Num) - -instance Show WordPtr where - + deriving Num diff --git a/tests/rename/should_compile/T3103/GHC/Base.lhs b/tests/rename/should_compile/T3103/GHC/Base.lhs index d3949af..b6f20d0 100644 --- a/tests/rename/should_compile/T3103/GHC/Base.lhs +++ b/tests/rename/should_compile/T3103/GHC/Base.lhs @@ -1,24 +1,17 @@ - \begin{code} {-# LANGUAGE NoImplicitPrelude #-} module GHC.Base ( - module GHC.Base, module GHC.Classes, - module GHC.Types, module GHC.Prim, - ) - where + Num(..) + ) where -import GHC.Types import GHC.Classes import GHC.Prim -import GHC.Tuple () -import GHC.Integer () - -default () -type String = [Char] +class Num a where + signum :: a -> a \end{code} diff --git a/tests/rename/should_compile/T3103/GHC/Num.lhs b/tests/rename/should_compile/T3103/GHC/Num.lhs deleted file mode 100644 index 3b5fe06..0000000 --- a/tests/rename/should_compile/T3103/GHC/Num.lhs +++ /dev/null @@ -1,29 +0,0 @@ -\begin{code} -{-# LANGUAGE NoImplicitPrelude #-} - -module GHC.Num (Num(..)) where - -import GHC.Base -import GHC.Show -import GHC.Integer - -infixl 7 * -infixl 6 +, - - -default () - -class (Eq a, Show a) => Num a where - (+), (-), (*) :: a -> a -> a - (+) = (+) - (-) = (-) - (*) = (*) - negate :: a -> a - negate = negate - abs :: a -> a - abs = abs - signum :: a -> a - signum = signum - fromInteger :: Integer -> a - fromInteger = fromInteger -\end{code} - diff --git a/tests/rename/should_compile/T3103/GHC/Show.lhs b/tests/rename/should_compile/T3103/GHC/Show.lhs index 0049b27..8fd3bd4 100644 --- a/tests/rename/should_compile/T3103/GHC/Show.lhs +++ b/tests/rename/should_compile/T3103/GHC/Show.lhs @@ -5,14 +5,6 @@ module GHC.Show (Show(..)) where import GHC.Types -type ShowS = [Char] -> [Char] - class Show a where - showsPrec :: Int -> a -> ShowS show :: a -> [Char] - showList :: [a] -> ShowS - - showsPrec = showsPrec - show = show - showList = showList \end{code} diff --git a/tests/rename/should_compile/T3103/GHC/Unicode.hs b/tests/rename/should_compile/T3103/GHC/Unicode.hs index 7722037..51ddbd1 100644 --- a/tests/rename/should_compile/T3103/GHC/Unicode.hs +++ b/tests/rename/should_compile/T3103/GHC/Unicode.hs @@ -1,12 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} -module GHC.Unicode ( - isSpace, - ) where +module GHC.Unicode ( ) where -import GHC.Types import GHC.Show () - -isSpace :: Char -> Bool -isSpace = isSpace - diff --git a/tests/rename/should_compile/T3103/GHC/Unicode.hs-boot b/tests/rename/should_compile/T3103/GHC/Unicode.hs-boot index 995d010..47c2b25 100644 --- a/tests/rename/should_compile/T3103/GHC/Unicode.hs-boot +++ b/tests/rename/should_compile/T3103/GHC/Unicode.hs-boot @@ -2,7 +2,3 @@ module GHC.Unicode where -import GHC.Types - -isSpace :: Char -> Bool - diff --git a/tests/rename/should_compile/T3103/GHC/Word.hs b/tests/rename/should_compile/T3103/GHC/Word.hs index 9bfe7b7..81f438a 100644 --- a/tests/rename/should_compile/T3103/GHC/Word.hs +++ b/tests/rename/should_compile/T3103/GHC/Word.hs @@ -5,22 +5,12 @@ module GHC.Word ( ) where import GHC.Base -import GHC.Num + import {-# SOURCE #-} GHC.Unicode () -import GHC.Show (Show(..)) -import GHC.Integer data Word = W# Word# deriving Eq -instance Show Word where - instance Num Word where - (W# x#) + (W# y#) = W# (x# `plusWord#` y#) - (W# x#) - (W# y#) = W# (x# `minusWord#` y#) - (W# x#) * (W# y#) = W# (x# `timesWord#` y#) - negate (W# x#) = W# (int2Word# (negateInt# (word2Int# x#))) - abs x = x signum 0 = 0 signum _ = 1 - fromInteger i = W# (integerToWord i) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
