[project @ 2001-06-26 11:31:20 by sewardj]

Add the parser tests, formerly known as reader/.  Contains a significant
amount of breakage which needs to be looked at.

testsuite/tests/ghc-regress/parser/should_compile/all.T

+
+include ($confdir ++ "/../vanilla-test.T")
+
+-- Args to vtc are: extra compile flags
+
+test "read001" { vtc("") }
+test "read002" { vtc("") }
+test "read003" { vtc("") }
+test "read004" { vtc("") }
+test "read005" { vtc("") }
+test "read006" { vtc("") }
+test "read007" { vtc("") }
+test "read008" { vtc("") }
+test "read009" { vtc("") }
+test "read010" { vtc("") }
+test "read011" { vtc("") }
+test "read012" { vtc("-O -funfold-casms-in-hi-file -fglasgow-exts -ohi T1.hi") }
+test "read013" { vtc("-O -funfold-casms-in-hi-file -fglasgow-exts") }
+test "read014" { vtc("-Wall") }
+test "read015" { vtc("") }
+test "read016" { vtc("") }
+test "read017" { vtc("") }
+test "read018" { vtc("") }
+test "read019" { vtc("") }
+test "read020" { vtc("") }
+test "read021" { vtc("") }
+test "read022" { vtc("-fglasgow-exts") }
+test "read023" { vtc("") }
+test "read024" { vtc("-fglasgow-exts") }
+test "read025" { vtc("") }
+test "read026" { vtc("") }
+test "read027" { vtc("") }
+test "read028" { vtc("") }
+test "read029" { vtc("") }
+test "read030" { vtc("") }

testsuite/tests/ghc-regress/parser/should_compile/read001.hs

+-- !!! import qualified Prelude should leave (), [] etc in scope
+
+module ShouldCompile where
+
+import qualified Prelude
+
+f :: Prelude.IO ()
+f = Prelude.return ()

testsuite/tests/ghc-regress/parser/should_compile/read002.hs

+-- !!! tests fixity reading and printing
+module ShouldCompile where
+
+infixl 1 `f`
+infixr 2 \\\
+infix  3 :==>
+infix  4 `MkFoo`
+
+data Foo = MkFoo Int | Float :==> Double
+
+x `f` y = x
+
+(\\\) :: (Eq a) => [a] -> [a] -> [a]
+(\\\) xs ys =  xs

testsuite/tests/ghc-regress/parser/should_compile/read003.hs

+-- !!! Testing layout rule
+module ShouldCompile where
+
+l1 :: IO ()
+l1 = do
+  return a
+  where
+   a = ()
+
+l2 :: IO ()
+l2 = do
+  return a
+ where
+  a = ()
+
+l3 :: IO ()
+l3 = do
+  return a
+   where
+   a = ()

testsuite/tests/ghc-regress/parser/should_compile/read004.hs

+module ShouldCompile where
+
+{-
+From: Kevin Hammond <kh>
+To: partain
+Subject: Re:  parsing problem w/ queens
+Date: Wed, 9 Oct 91 17:31:46 BST
+
+OK, I've fixed that little problem by disallowing,
+-}
+
+f x = x + if True then 1 else 2
+g x = x + 1::Int
+
+-- (the conditional/sig need to be parenthesised).  If this is
+-- problematic, let me know!

testsuite/tests/ghc-regress/parser/should_compile/read005.hs

+module ShouldCompile where
+
+-- !!! Empty comments terminating a file..
+main = print "Hello" --

testsuite/tests/ghc-regress/parser/should_compile/read006.hs

+-- !!! Testing handling of troublesome constructor name (:::)
+module MyList (MyList(Empty, (:::))) where
+
+data MyList a =   Empty
+                | (MyList a) ::: (MyList a)

testsuite/tests/ghc-regress/parser/should_compile/read007.hs

+module ShouldCompile where
+
+import MyList
+
+myLength :: MyList a -> Int
+myLength Empty = 0
+myLength (x ::: xs) = 1 + myLength xs
+

testsuite/tests/ghc-regress/parser/should_compile/read008.hs

+module ShouldCompile where
+
+{-# SPECIALISE f :: Int -> Int #-}
+f n = n + 1

testsuite/tests/ghc-regress/parser/should_compile/read009.hs

+-- !!! combining undeclared infix operators
+module ShouldCompile where
+
+-- should default to 'infixl 9'
+
+test = let f x y = x+y in 1 `f` 2 `f` 3
+

testsuite/tests/ghc-regress/parser/should_compile/read010.hs

+-- !!! Infix record constructor.
+module ShouldCompile where
+
+data Rec = (:<-:) { a :: Int, b :: Float }

testsuite/tests/ghc-regress/parser/should_compile/read011.hs

+-- !!! do & where interaction
+module ShouldCompile where
+
+f1 :: IO a -> IO [a]
+f1 x = do
+  v <- x
+  return [v]
+ where
+  g x = [x,x]
+
+f2 :: IO a -> IO [a]
+f2 x = do
+  v <- x
+  return (g v)
+   where
+    g x = [x,x]
+
+f3 :: IO a -> IO [a]
+f3 x = do
+  v <- x
+  return (g v)
+  where
+   g x = [x,x]
+

testsuite/tests/ghc-regress/parser/should_compile/read012.hs

+module T1 where
+malloc :: IO Int
+malloc = _casm_ ``%r = 42;''

testsuite/tests/ghc-regress/parser/should_compile/read013.hs

+module T2 where
+import T1
+blah :: IO Int
+blah = malloc

testsuite/tests/ghc-regress/parser/should_compile/read014.hs

+-- !!! Empty export lists are legal (and useful.)
+module ShouldCompile () where
+
+ng1 x y = negate y
+
+instance (Num a, Num b) => Num (a,b)
+  where
+   negate (a,b) = (ng 'c' a, ng1 'c' b)   where  ng x y = negate y

testsuite/tests/ghc-regress/parser/should_compile/read014.stderr

+
+read014.hs:4: Warning: Definition but no type signature for `ng1'
+
+read014.hs:4: Warning: Defined but not used: x
+
+read014.hs:8: Warning: Defined but not used: x
+
+read014.hs:6:
+    Warning: No explicit method nor default method for `*'
+	     in an instance declaration for `Num'
+
+read014.hs:6:
+    Warning: No explicit method nor default method for `+'
+	     in an instance declaration for `Num'
+
+read014.hs:6:
+    Warning: No explicit method nor default method for `signum'
+	     in an instance declaration for `Num'
+
+read014.hs:6:
+    Warning: No explicit method nor default method for `abs'
+	     in an instance declaration for `Num'
+
+read014.hs:6:
+    Warning: No explicit method nor default method for `fromInteger'
+	     in an instance declaration for `Num'

testsuite/tests/ghc-regress/parser/should_compile/read015.hs

+-- !!! Testing whether the parser likes empty declarations..
+module ShouldCompile where { ;;;;;x=let{;;;;;y=2;;;;}in y;;;;;}

testsuite/tests/ghc-regress/parser/should_compile/read016.hs

+-- !!! Checking that both import lists and 'hiding' lists might
+-- !!! be empty.
+module ShouldCompile where
+
+import List  ()
+import List  hiding ()
+
+x :: Int
+x = 1
+

testsuite/tests/ghc-regress/parser/should_compile/read017.hs

+-- !!! Checking that empty declarations are permitted.
+module ShouldCompile where
+
+
+class Foo a where
+
+class Foz a
+
+x = 2 where 
+y = 3
+
+instance Foo Int where
+
+f = f where g = g where
+type T = Int

testsuite/tests/ghc-regress/parser/should_compile/read018.hs

+-- !!! Checking that empty contexts are permitted.
+module ShouldCompile where
+
+data () => Foo a = Foo a
+
+newtype () => Bar = Bar Int
+
+f :: () => Int -> Int
+f = (+1)
+
+
+class () => Fob a where
+
+instance () => Fob Int where
+instance () => Fob Float
+

testsuite/tests/ghc-regress/parser/should_compile/read019.hs

+-- !!! Checking what's legal in the body of a class declaration.
+module ShouldCompile where
+
+class Foo a where {
+  (--<>--) :: a -> a -> Int  ;
+  infixl 5 --<>-- ;
+  (--<>--) _ _ = 2 ; -- empty decl at the end.
+};
+
+

testsuite/tests/ghc-regress/parser/should_compile/read020.hs

+-- !!! Checking that qualified method names are legal in instance body.
+module ShouldCompile where
+
+import Prelude hiding (Eq, (==))
+import Prelude as P (Eq,(==))
+
+data Foo = Foo Int Integer
+
+instance P.Eq Foo where
+  (Foo a1 b1) P.== (Foo a2 b2) = a1 P.== a2 && b1 P.== b2
+
+
+

testsuite/tests/ghc-regress/parser/should_compile/read021.hs

+-- !!! Empty export list
+
+module ShouldCompile() where
+
+instance Show (a->b) where
+  show f = "<<function>>"

testsuite/tests/ghc-regress/parser/should_compile/read022.hs

+module ShouldCompile where
+
+f (x :: Int) = x + 1

testsuite/tests/ghc-regress/parser/should_compile/read023.hs

+module ShouldCompile where
+
+-- M.<keyword> isn't a qualified identifier
+f  = Just.let x=id in x
+
+-- ---------------------------------------------------------------------------
+-- we changed the behaviour of this one in GHC, but the following test
+-- is strictly speaking legal Haskell:
+
+-- f' = Just.\1 where (.\) = ($)
+
+-- -----------------------------------------------------
+-- M.{as,hiding,qualified} *are* qualified identifiers:
+
+g  = ShouldCompile.as
+
+-- ---------------------------------------------------------------------------
+-- special symbols (!, -) can be qualified to make varids.
+
+g' = (ShouldCompile.!)
+
+as x = x
+(!) x = x

testsuite/tests/ghc-regress/parser/should_compile/read024.hs

+-- !!! checking that special ids are correctly handled.
+module ShouldCompile where
+
+as :: [as]
+as = [head as]
+
+qualified :: [qualified]
+qualified = [head qualified]
+
+hiding :: [hiding]
+hiding = [head hiding]
+
+export :: [export]
+export = [head export]
+
+label :: [label]
+label = [head label]
+
+dynamic :: [dynamic]
+dynamic = [head dynamic]
+
+unsafe :: [unsafe]
+unsafe = [head unsafe]
+
+stdcall :: [stdcall]
+stdcall = [head stdcall]
+
+ccall :: [ccall]
+ccall = [head ccall]
+

testsuite/tests/ghc-regress/parser/should_compile/read025.hs

+-- !!! Check the handling of 'qualified' and 'as' clauses
+module ShouldCompile where
+
+import List as L ( intersperse ) 
+
+x = L.intersperse
+
+y = intersperse
+

testsuite/tests/ghc-regress/parser/should_compile/read026.hs

+module ShouldCompile where
+
+(<>)          :: (a -> Maybe b) -> (b -> Maybe c) -> (a -> Maybe c)
+(m1 <> m2) a1	=  case m1 a1 of
+                      Nothing -> Nothing
+                      Just a2 -> m2 a2

testsuite/tests/ghc-regress/parser/should_compile/read027.hs

+module ShouldCompile where
+
+infix 5 |- 
+infix 9 :=
+
+data Equal = Char := Int
+
+-- fails in GHC (all versions), due to not doing fixity resolution on
+-- the lhs before deciding which is the function symbol.
+
+(|-) :: Int -> Equal -> Bool
+0 |- x:=y = 1 |- x:=y      -- XXX fails here
+2 |- (x:=y) = 0 |- x:=y
+_ |-  _     = False  

testsuite/tests/ghc-regress/parser/should_compile/read028.hs

+module ShouldCompile where
+
+data T a b = (:^:) a b

testsuite/tests/ghc-regress/parser/should_compile/read029.hs

+-- !!! Special Ids and ops
+
+-- The special ids 'as', 'qualified' and 'hiding' should be 
+-- OK in both qualified and unqualified form.
+-- Ditto special ops
+
+module ShouldCompile where
+import Prelude hiding ( (-) )
+
+as	  = ShouldCompile.as
+hiding	  = ShouldCompile.hiding
+qualified = ShouldCompile.qualified
+x!y	  = x ShouldCompile.! y
+x-y	  = x ShouldCompile.- y

testsuite/tests/ghc-regress/parser/should_compile/read030.hs

+-- !!! Infix decls w/ infix data constructors
+
+-- GHC used to barf on this...
+
+module ShouldCompile where
+
+infix 2 |-, |+
+
+ps  |-  q:qs   = undefined
+ps  |+  p:q:qs = undefined

testsuite/tests/ghc-regress/parser/should_fail/all.T

+
+include ($confdir ++ "/../vanilla-test.T")
+
+-- Args to vtf are: extra compile flags
+
+def myvtf ( $extra_compile_args )
+{
+   vtf ( $extra_compile_args ++ " -ddump-parsed ")
+}
+
+test "read001" { myvtf("") }
+test "read002" { myvtf("") }
+test "read003" { myvtf("") }
+test "read004" { myvtf("") }
+test "read005" { myvtf("") }
+test "read006" { myvtf("") }
+test "read007" { myvtf("") }
+test "read008" { myvtf("") }
+test "read009" { myvtf("") }
+test "read011" { myvtf("") }
+test "read012" { myvtf("") }
+test "read013" { myvtf("-fglasgow-exts") }
+test "read014" { myvtf("") }
+test "read015" { myvtf("") }
+test "read016" { myvtf("") }
+test "read017" { myvtf("") }

testsuite/tests/ghc-regress/parser/should_fail/read001.hs

+-- !!! this module supposedly includes one of each Haskell construct
+
+-- HsImpExp stuff
+
+module OneOfEverything (
+	fixn, 
+	FooData,
+	FooDataB(..),
+	FooDataC( .. ),
+	EqTree(EqLeaf, EqBranch),
+	EqClass(..),
+	OrdClass(orda, ordb),
+	module OneC ,
+	module OneOfEverything
+    ) where
+
+import Prelude
+import IO		( putStr )
+import System hiding	( getArgs )
+import Monad
+
+-- HsDecls stuff
+
+infix	6 `fixn`
+infixl	7 +#
+infixr	8 `fixr`
+
+fixn x y = x
+fixl x y = x
+fixr x y = x
+
+type Pair a b = (a, b)
+
+data FooData = FooCon Int
+
+data FooDataB = FooConB Double
+
+data (Eq a) => EqTree a = EqLeaf a | EqBranch (EqLeaf a) (EqLeaf a)
+
+class (Eq a) => EqClass a where
+    eqc :: a -> Char
+    eqc x = '?'
+
+class (Ord a) => OrdClass a where
+    orda :: a -> Char
+    ordb :: a -> Char
+    ordc :: a -> Char
+
+instance (Eq a) => EqClass (EqTree a) where
+    eqc x = 'a'
+
+default (Integer, Rational)
+
+-- HsBinds stuff
+
+singlebind x = x
+
+bindwith :: (OrdClass a, OrdClass b) => a -> b -> b
+bindwith a b = b
+
+reca a = recb a
+recb a = reca a
+
+(~(a,b,c)) | nullity b	= a
+	   | nullity c	= a
+	   | otherwise	= a
+	   where
+	    nullity = null
+
+-- HsMatches stuff
+
+mat a b c d | foof a b = d
+	    | foof a c = d
+	    | foof b c = d
+	    where
+		foof a b = a == b
+
+-- HsExpr stuff
+expr a b c d
+  = a
+  + (:) a b
+  + (a : b)
+  + (1 - 'c' - "abc" - 1.293)
+  + ( \ x y z -> x ) 42
+  + (9 *)
+  + (* 8)
+  + (case x of
+	[] | null x	-> 99
+	   | otherwise	-> 98
+	   | True	-> 97
+	   where
+	     null x = False
+    )
+  + [ z | z <- c, isSpace z ]
+  + let y = foo
+    in  y
+  + [1,2,3,4]
+  + (4,3,2,1)
+  + (4 :: Num a => a)
+  + (if 42 == 42.0 then 1 else 4)
+  + [1..]
+  + [2,4..]
+  + [3..5]
+  + [4,8..999]
+
+-- HsPat stuff
+f _ x 1 1.93 'c' "dog" ~y z@(Foo a b) (c `Bar` d) [1,2] (3,4) (n+42) = y
+
+-- HsLit stuff -- done above
+
+-- HsTypes stuff
+g :: (Num a, Eq b) => Foo a -> [b] -> (a,a,a) -> b
+g x y z = head y

testsuite/tests/ghc-regress/parser/should_fail/read001.stderr

+
+read001.hs:5: Unknown module in export list: module `OneC'
+
+read001.hs:5: Type constructor or class not in scope: `FooDataC'
+
+read001.hs:25: Variable not in scope: `+#'
+
+read001.hs:38: Type constructor or class not in scope: `EqLeaf'
+
+read001.hs:38: Type constructor or class not in scope: `EqLeaf'
+
+read001.hs:87: Variable not in scope: `x'
+
+read001.hs:88: Variable not in scope: `x'
+
+read001.hs:94: Variable not in scope: `isSpace'
+
+read001.hs:95: Variable not in scope: `foo'
+
+read001.hs:107: Data constructor not in scope: `Foo'
+
+read001.hs:107: Data constructor not in scope: `Bar'
+
+read001.hs:112: Type constructor or class not in scope: `Foo'