diff options
Diffstat (limited to 'testsuite/tests/deriving')
18 files changed, 78 insertions, 78 deletions
diff --git a/testsuite/tests/deriving/should_compile/drv005.hs b/testsuite/tests/deriving/should_compile/drv005.hs index 527dde98b9..05f9fabc74 100644 --- a/testsuite/tests/deriving/should_compile/drv005.hs +++ b/testsuite/tests/deriving/should_compile/drv005.hs @@ -3,4 +3,4 @@ module ShouldSucceed where data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8 - deriving Enum + deriving Enum diff --git a/testsuite/tests/deriving/should_compile/drv006.hs b/testsuite/tests/deriving/should_compile/drv006.hs index 62f2cbcf67..297d0ddc0b 100644 --- a/testsuite/tests/deriving/should_compile/drv006.hs +++ b/testsuite/tests/deriving/should_compile/drv006.hs @@ -4,6 +4,6 @@ module ShouldSucceed where import Data.Ix data Foo = Foo1 | Foo2 | Foo3 | Foo4 | Foo5 | Foo6 | Foo7 | Foo8 - deriving (Eq, Ord, Ix, Show) + deriving (Eq, Ord, Ix, Show) data Bar a b = MkBar a Int b Integer a diff --git a/testsuite/tests/deriving/should_compile/drv015.hs b/testsuite/tests/deriving/should_compile/drv015.hs index f8cfbce2db..b8575b2970 100644 --- a/testsuite/tests/deriving/should_compile/drv015.hs +++ b/testsuite/tests/deriving/should_compile/drv015.hs @@ -1,8 +1,8 @@ -- July 07: I'm changing this from "should_compile" to "should_fail". -- It would generate an instance decl like --- insance (Show (f a), Show (g a)) => Show (Pair1 f g a) --- and that is not Haskell 98. +-- insance (Show (f a), Show (g a)) => Show (Pair1 f g a) +-- and that is not Haskell 98. -- -- See Note [Exotic derived instance contexts] in TcSimplify. -- The rule is simple: the context of a derived instance decl must diff --git a/testsuite/tests/deriving/should_compile/drv020.hs b/testsuite/tests/deriving/should_compile/drv020.hs index 9956407fbd..bd5c8f4235 100644 --- a/testsuite/tests/deriving/should_compile/drv020.hs +++ b/testsuite/tests/deriving/should_compile/drv020.hs @@ -1,7 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, GeneralizedNewtypeDeriving #-} --- Test deriving of a multi-parameter class for +-- Test deriving of a multi-parameter class for -- one-argument newtype defined in the same module module ShouldSucceed where @@ -26,14 +26,14 @@ instance Applicative (State s) where (<*>) = ap instance Monad (State s) where - return a = State $ \s -> (a, s) - m >>= k = State $ \s -> let - (a, s') = runState m s - in runState (k a) s' + return a = State $ \s -> (a, s) + m >>= k = State $ \s -> let + (a, s') = runState m s + in runState (k a) s' instance MonadState s (State s) where - get = State $ \s -> (s, s) - put s = State $ \_ -> ((), s) + get = State $ \s -> (s, s) + put s = State $ \_ -> ((), s) -- test code diff --git a/testsuite/tests/deriving/should_fail/T4846.hs b/testsuite/tests/deriving/should_fail/T4846.hs index e9cd180d4c..e9cd180d4c 100755..100644 --- a/testsuite/tests/deriving/should_fail/T4846.hs +++ b/testsuite/tests/deriving/should_fail/T4846.hs diff --git a/testsuite/tests/deriving/should_fail/drvfail001.hs b/testsuite/tests/deriving/should_fail/drvfail001.hs index 47447fb3e3..d2ba8eb1f6 100644 --- a/testsuite/tests/deriving/should_fail/drvfail001.hs +++ b/testsuite/tests/deriving/should_fail/drvfail001.hs @@ -1,9 +1,9 @@ -{- From: Ian Bayley +{- From: Ian Bayley Sent: Tuesday, June 29, 1999 3:39 PM To: hugs-bugs@haskell.org Subject: Show for higher-order nested datatypes - - + + Is "deriving Show" meant to work for higher-order nested datatypes ? Hugs hangs when loading in the following file: -} @@ -12,15 +12,15 @@ module Foo where type SqMat a = SM Nil a -data SM f a = ZeroS (f (f a)) | SuccS (SM (Cons f) a) - deriving Show +data SM f a = ZeroS (f (f a)) | SuccS (SM (Cons f) a) + deriving Show -- Show (f (f a)), Show (SM (Cons f) a) => Show (SM f a) data Nil a = MkNil deriving Show data Cons f a = MkCons a (f a) - deriving Show + deriving Show diff --git a/testsuite/tests/deriving/should_fail/drvfail002.hs b/testsuite/tests/deriving/should_fail/drvfail002.hs index 26a8f083d2..945ead493e 100644 --- a/testsuite/tests/deriving/should_fail/drvfail002.hs +++ b/testsuite/tests/deriving/should_fail/drvfail002.hs @@ -2,7 +2,7 @@ MultiParamTypeClasses, FunctionalDependencies #-} -- The Show instance for S would have form --- instance X T c => Show S +-- instance X T c => Show S -- which is hard to deal with. It sent GHC 5.01 into -- an infinite loop; now it should be rejected. diff --git a/testsuite/tests/deriving/should_fail/drvfail006.hs b/testsuite/tests/deriving/should_fail/drvfail006.hs index 0d8d1a95d9..2f30efb99c 100644 --- a/testsuite/tests/deriving/should_fail/drvfail006.hs +++ b/testsuite/tests/deriving/should_fail/drvfail006.hs @@ -7,5 +7,5 @@ module ShouldFail where import Control.Monad.State newtype T a = T (StateT Int IO a) deriving( MonadState ) - -- Here MonadState takes two type params, - -- but exactly one is needed.
\ No newline at end of file + -- Here MonadState takes two type params, + -- but exactly one is needed. diff --git a/testsuite/tests/deriving/should_fail/drvfail009.hs b/testsuite/tests/deriving/should_fail/drvfail009.hs index 06155c38a1..fa130b5993 100644 --- a/testsuite/tests/deriving/should_fail/drvfail009.hs +++ b/testsuite/tests/deriving/should_fail/drvfail009.hs @@ -5,16 +5,16 @@ module ShouldFail where -class C a b +class C a b newtype T1 = T1 Int deriving( C ) - -- Wrong arity + -- Wrong arity newtype T2 = T2 Int deriving( Monad ) - -- Type constructor has wrong kind + -- Type constructor has wrong kind newtype T3 a = T3 Int deriving( Monad ) - -- Rep type has wrong kind + -- Rep type has wrong kind newtype T4 a = T4 (Either a a) deriving( Monad ) - -- Eta fails + -- Eta fails diff --git a/testsuite/tests/deriving/should_run/drvrun005.hs b/testsuite/tests/deriving/should_run/drvrun005.hs index a4ef060a6a..03a12042a4 100644 --- a/testsuite/tests/deriving/should_run/drvrun005.hs +++ b/testsuite/tests/deriving/should_run/drvrun005.hs @@ -5,13 +5,13 @@ module Main where an operator, it is defaulted to being "infixl 9". OLD: The derived Read instances for data types containing - left-assoc constructors produces code that causes - non-termination if you use 'read' to evaluate them - ( (head (reads x)) is cool tho.) + left-assoc constructors produces code that causes + non-termination if you use 'read' to evaluate them + ( (head (reads x)) is cool tho.) - ==> The inferred assoc for :++ below left & the derived - Read instance should fail to terminate (with ghc-4.xx, - this is exemplified by having the stack overflow.) + ==> The inferred assoc for :++ below left & the derived + Read instance should fail to terminate (with ghc-4.xx, + this is exemplified by having the stack overflow.) NEW: the new H98 spec says that we ignore associativity when parsing, so it terminates fine diff --git a/testsuite/tests/deriving/should_run/drvrun006.hs b/testsuite/tests/deriving/should_run/drvrun006.hs index 3d268019bd..5eba61588b 100644 --- a/testsuite/tests/deriving/should_run/drvrun006.hs +++ b/testsuite/tests/deriving/should_run/drvrun006.hs @@ -2,7 +2,7 @@ module Main(main) where infix 4 :^: -data Tree a +data Tree a = Leaf a | (Tree a) :^: (Tree a) deriving (Show, Read) @@ -25,25 +25,25 @@ main = do instance (Show a) => Show (Tree a) where showsPrec d (Leaf m) = showParen (d >= 10) showStr - where + where showStr = showString "Leaf " . showsPrec 10 m showsPrec d (u :^: v) = showParen (d > 4) showStr - where - showStr = showsPrec 5 u . + where + showStr = showsPrec 5 u . showString " :^: " . showsPrec 5 v instance (Read a) => Read (Tree a) where - readsPrec d r = readParen (d > 4) - (\r -> [(u:^:v,w) | - (u,s) <- readsPrec 5 r, - (":^:",t) <- lex s, - (v,w) <- readsPrec 5 t]) r + readsPrec d r = readParen (d > 4) + (\r -> [(u:^:v,w) | + (u,s) <- readsPrec 5 r, + (":^:",t) <- lex s, + (v,w) <- readsPrec 5 t]) r - ++ readParen (d > 9) - (\r -> [(Leaf m,t) | - ("Leaf",s) <- lex r, - (m,t) <- readsPrec 10 s]) r + ++ readParen (d > 9) + (\r -> [(Leaf m,t) | + ("Leaf",s) <- lex r, + (m,t) <- readsPrec 10 s]) r -} diff --git a/testsuite/tests/deriving/should_run/drvrun009.hs b/testsuite/tests/deriving/should_run/drvrun009.hs index 0bd22ab787..03b073e3c4 100644 --- a/testsuite/tests/deriving/should_run/drvrun009.hs +++ b/testsuite/tests/deriving/should_run/drvrun009.hs @@ -13,8 +13,8 @@ a :: MyArr a = array bds [ ((i,j), i+j) | (i,j) <- range bds ] main = do { putStrLn (show a) ; - let { b :: MyArr ; - b = read (show a) } ; - putStrLn (show b) - } + let { b :: MyArr ; + b = read (show a) } ; + putStrLn (show b) + } diff --git a/testsuite/tests/deriving/should_run/drvrun010.hs b/testsuite/tests/deriving/should_run/drvrun010.hs index 0a2f3d2742..292bc5892d 100644 --- a/testsuite/tests/deriving/should_run/drvrun010.hs +++ b/testsuite/tests/deriving/should_run/drvrun010.hs @@ -7,6 +7,6 @@ main = putStrLn $ then "works" else "not" -- The point here is that if 'show' generates --- Test { field=-1 } +-- Test { field=-1 } -- the lexer things the '=-' is one lexeme, which does not work diff --git a/testsuite/tests/deriving/should_run/drvrun011.hs b/testsuite/tests/deriving/should_run/drvrun011.hs index aad1482f2a..82e6b71919 100644 --- a/testsuite/tests/deriving/should_run/drvrun011.hs +++ b/testsuite/tests/deriving/should_run/drvrun011.hs @@ -3,14 +3,14 @@ module Main( main ) where data Command = Commit (Maybe String) | Foo | Baz Bool | Boz Int - deriving (Read,Show) + deriving (Read,Show) type T = ([Command], [Command], [Command]) val :: T -val = ([Commit Nothing, Commit (Just "foo")], - [Foo, Baz True], +val = ([Commit Nothing, Commit (Just "foo")], + [Foo, Baz True], [Boz 3, Boz (-2)]) main = do { print val ; - print ((read (show val)) :: T) } + print ((read (show val)) :: T) } diff --git a/testsuite/tests/deriving/should_run/drvrun013.hs b/testsuite/tests/deriving/should_run/drvrun013.hs index 2a9adae585..8bf15161ea 100644 --- a/testsuite/tests/deriving/should_run/drvrun013.hs +++ b/testsuite/tests/deriving/should_run/drvrun013.hs @@ -1,18 +1,18 @@ --- This test makes sure that the derivied instance for --- Eq A --- "sees" the non-derived instance for --- Eq B +-- This test makes sure that the derivied instance for +-- Eq A +-- "sees" the non-derived instance for +-- Eq B -- -- In a version of GHC 5.05, this didn't happen, because the -- deriving mechanism looked through A's rep-type and found Int module Main where -newtype B = MkB Int +newtype B = MkB Int instance Eq B where - (MkB 1) == (MkB 2) = True -- Non-standard equality + (MkB 1) == (MkB 2) = True -- Non-standard equality (MkB a) == (MkB b) = False - + newtype A = MkA B deriving( Eq ) main = print (MkA (MkB 1) == MkA (MkB 2)) diff --git a/testsuite/tests/deriving/should_run/drvrun018.hs b/testsuite/tests/deriving/should_run/drvrun018.hs index a0b9f24362..e7bbd70fe8 100644 --- a/testsuite/tests/deriving/should_run/drvrun018.hs +++ b/testsuite/tests/deriving/should_run/drvrun018.hs @@ -6,4 +6,4 @@ module Main where data Foo = Int `MkFoo` Int deriving( Read, Show ) main = do { print (MkFoo 4 5) - ; print (read "3 `MkFoo` 5" :: Foo) } + ; print (read "3 `MkFoo` 5" :: Foo) } diff --git a/testsuite/tests/deriving/should_run/drvrun020.hs b/testsuite/tests/deriving/should_run/drvrun020.hs index cf78a2a992..381f3e7a78 100644 --- a/testsuite/tests/deriving/should_run/drvrun020.hs +++ b/testsuite/tests/deriving/should_run/drvrun020.hs @@ -6,13 +6,13 @@ module Main where infix 4 :%% data T = Int :%% T - | T1 { f1 :: Int } - | T2 T - deriving( Show, Read ) + | T1 { f1 :: Int } + | T2 T + deriving( Show, Read ) main = print (read "3 :%% T2 T1 { f1=3 }" :: T) -{- Here's the parser that is produced +{- Here's the parser that is produced import GHC.Read import Text.ParserCombinators.ReadPrec @@ -28,13 +28,13 @@ instance Read T where return (x :%% y)) +++ prec (appPrec+1) ( - do Ident "T1" <- lexP - Punc "{" <- lexP - Ident "f1" <- lexP - Punc "=" <- lexP - x <- reset readPrec - Punc "}" <- lexP - return (T1 { f1 = x })) + do Ident "T1" <- lexP + Punc "{" <- lexP + Ident "f1" <- lexP + Punc "=" <- lexP + x <- reset readPrec + Punc "}" <- lexP + return (T1 { f1 = x })) +++ prec appPrec ( do Ident "T2" <- lexP diff --git a/testsuite/tests/deriving/should_run/drvrun021.hs b/testsuite/tests/deriving/should_run/drvrun021.hs index 05c7c8dbf0..e634d1b80e 100644 --- a/testsuite/tests/deriving/should_run/drvrun021.hs +++ b/testsuite/tests/deriving/should_run/drvrun021.hs @@ -8,13 +8,13 @@ newtype Moose = MkMoose () deriving (Show, Eq, Ord) newtype Noose = MkNoose () deriving (Ord) instance Eq Noose where - a == b = False -- Non-standard! + a == b = False -- Non-standard! f :: Ord a => a -> Bool f x = x==x -main = do print (MkNoose () == MkNoose ()) -- Eq Noose - print (f (MkNoose ())) -- via Ord Noose - print (MkMoose () == MkMoose ()) -- Eq Moose - print (f (MkMoose ())) -- via Ord Moose - putStrLn (show (MkMoose ())) -- Should not use the show () method +main = do print (MkNoose () == MkNoose ()) -- Eq Noose + print (f (MkNoose ())) -- via Ord Noose + print (MkMoose () == MkMoose ()) -- Eq Moose + print (f (MkMoose ())) -- via Ord Moose + putStrLn (show (MkMoose ())) -- Should not use the show () method |