Commit 850e0b31 authored by sewardj's avatar sewardj

[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.
parent 172201a4
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("") }
-- !!! import qualified Prelude should leave (), [] etc in scope
module ShouldCompile where
import qualified Prelude
f :: Prelude.IO ()
f = Prelude.return ()
-- !!! 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
-- !!! 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 = ()
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!
module ShouldCompile where
-- !!! Empty comments terminating a file..
main = print "Hello" --
-- !!! Testing handling of troublesome constructor name (:::)
module MyList (MyList(Empty, (:::))) where
data MyList a = Empty
| (MyList a) ::: (MyList a)
module ShouldCompile where
import MyList
myLength :: MyList a -> Int
myLength Empty = 0
myLength (x ::: xs) = 1 + myLength xs
module ShouldCompile where
{-# SPECIALISE f :: Int -> Int #-}
f n = n + 1
-- !!! 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
-- !!! Infix record constructor.
module ShouldCompile where
data Rec = (:<-:) { a :: Int, b :: Float }
-- !!! 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]
module T1 where
malloc :: IO Int
malloc = _casm_ ``%r = 42;''
module T2 where
import T1
blah :: IO Int
blah = malloc
-- !!! 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
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'
-- !!! Testing whether the parser likes empty declarations..
module ShouldCompile where { ;;;;;x=let{;;;;;y=2;;;;}in y;;;;;}
-- !!! Checking that both import lists and 'hiding' lists might
-- !!! be empty.
module ShouldCompile where
import List ()
import List hiding ()
x :: Int
x = 1
-- !!! 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
-- !!! 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
-- !!! 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.
};
-- !!! 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
-- !!! Empty export list
module ShouldCompile() where
instance Show (a->b) where
show f = "<<function>>"
module ShouldCompile where
f (x :: Int) = x + 1
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
-- !!! 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]
-- !!! Check the handling of 'qualified' and 'as' clauses
module ShouldCompile where
import List as L ( intersperse )
x = L.intersperse
y = intersperse
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
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
module ShouldCompile where
data T a b = (:^:) a b
-- !!! 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
-- !!! 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
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("") }
-- !!! 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
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'