diff options
Diffstat (limited to 'testsuite/tests/parser')
295 files changed, 2528 insertions, 0 deletions
diff --git a/testsuite/tests/parser/Makefile b/testsuite/tests/parser/Makefile new file mode 100644 index 0000000000..9a36a1c5fe --- /dev/null +++ b/testsuite/tests/parser/Makefile @@ -0,0 +1,3 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/parser/prog001/Makefile b/testsuite/tests/parser/prog001/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/parser/prog001/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/parser/prog001/Read006.hs b/testsuite/tests/parser/prog001/Read006.hs new file mode 100644 index 0000000000..87546cb550 --- /dev/null +++ b/testsuite/tests/parser/prog001/Read006.hs @@ -0,0 +1,5 @@ +-- !!! Testing handling of troublesome constructor name (:::) +module Read006 (MyList(Empty, (:::))) where + +data MyList a = Empty + | (MyList a) ::: (MyList a) diff --git a/testsuite/tests/parser/prog001/Read007.hs b/testsuite/tests/parser/prog001/Read007.hs new file mode 100644 index 0000000000..a0c2ec0f44 --- /dev/null +++ b/testsuite/tests/parser/prog001/Read007.hs @@ -0,0 +1,8 @@ +module ShouldCompile where + +import Read006 + +myLength :: MyList a -> Int +myLength Empty = 0 +myLength (x ::: xs) = 1 + myLength xs + diff --git a/testsuite/tests/parser/prog001/test.T b/testsuite/tests/parser/prog001/test.T new file mode 100644 index 0000000000..b667211196 --- /dev/null +++ b/testsuite/tests/parser/prog001/test.T @@ -0,0 +1,4 @@ +test('parser.prog001', + extra_clean(['Read006.hi', 'Read006.o', 'Read007.hi', 'Read007.o']), + multimod_compile, + ['Read007.hs', '-v0']) diff --git a/testsuite/tests/parser/should_compile/DoAndIfThenElse.hs b/testsuite/tests/parser/should_compile/DoAndIfThenElse.hs new file mode 100644 index 0000000000..5bfb6edc86 --- /dev/null +++ b/testsuite/tests/parser/should_compile/DoAndIfThenElse.hs @@ -0,0 +1,9 @@ + +{-# LANGUAGE DoAndIfThenElse #-} + +module DoAndIfThenElse where + +foo :: IO () +foo = do if True + then return () + else return () diff --git a/testsuite/tests/parser/should_compile/EmptyDecls.hs b/testsuite/tests/parser/should_compile/EmptyDecls.hs new file mode 100644 index 0000000000..9583f23e32 --- /dev/null +++ b/testsuite/tests/parser/should_compile/EmptyDecls.hs @@ -0,0 +1,9 @@ +module Main where { + +f x = x; +; +; +g y z = z; + +main = print (g (f False) (f True)); +} diff --git a/testsuite/tests/parser/should_compile/Makefile b/testsuite/tests/parser/should_compile/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/parser/should_compile/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/parser/should_compile/NondecreasingIndentation.hs b/testsuite/tests/parser/should_compile/NondecreasingIndentation.hs new file mode 100644 index 0000000000..05273097ed --- /dev/null +++ b/testsuite/tests/parser/should_compile/NondecreasingIndentation.hs @@ -0,0 +1,10 @@ + +{-# LANGUAGE NondecreasingIndentation #-} + +module ShouldCompile where + +f :: IO () +f = do if True then f else do + f + if True then f else do + f diff --git a/testsuite/tests/parser/should_compile/T2245.hs b/testsuite/tests/parser/should_compile/T2245.hs new file mode 100644 index 0000000000..bf8287ba33 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T2245.hs @@ -0,0 +1,7 @@ +default (T) + +data T = T deriving (Eq, Ord, Read, Show) +instance Num T +instance Fractional T + +main = interact $ show . (< 1e400) . read
\ No newline at end of file diff --git a/testsuite/tests/parser/should_compile/T2245.stderr b/testsuite/tests/parser/should_compile/T2245.stderr new file mode 100644 index 0000000000..b1754ff0c5 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T2245.stderr @@ -0,0 +1,34 @@ + +T2245.hs:4:10: + Warning: No explicit method nor default method for `+' + In the instance declaration for `Num T' + +T2245.hs:4:10: + Warning: No explicit method nor default method for `*' + In the instance declaration for `Num T' + +T2245.hs:4:10: + Warning: No explicit method nor default method for `abs' + In the instance declaration for `Num T' + +T2245.hs:4:10: + Warning: No explicit method nor default method for `signum' + In the instance declaration for `Num T' + +T2245.hs:4:10: + Warning: No explicit method nor default method for `fromInteger' + In the instance declaration for `Num T' + +T2245.hs:5:10: + Warning: No explicit method nor default method for `fromRational' + In the instance declaration for `Fractional T' + +T2245.hs:7:29: + Warning: Defaulting the following constraint(s) to type `T' + (Fractional b0) arising from the literal `1e400' + at T2245.hs:7:29-33 + (Ord b0) arising from a use of `<' at T2245.hs:7:27 + (Read b0) arising from a use of `read' at T2245.hs:7:38-41 + In the second argument of `(<)', namely `1e400' + In the first argument of `(.)', namely `(< 1e400)' + In the second argument of `(.)', namely `(< 1e400) . read' diff --git a/testsuite/tests/parser/should_compile/T3303.hs b/testsuite/tests/parser/should_compile/T3303.hs new file mode 100644 index 0000000000..08de52e6cd --- /dev/null +++ b/testsuite/tests/parser/should_compile/T3303.hs @@ -0,0 +1,8 @@ + +module T3303 where + +import T3303A + +bar :: Int +bar = foo + diff --git a/testsuite/tests/parser/should_compile/T3303.stderr b/testsuite/tests/parser/should_compile/T3303.stderr new file mode 100644 index 0000000000..6e0b5629b3 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T3303.stderr @@ -0,0 +1,7 @@ + +T3303.hs:4:1: + Warning: In the use of `foo' + (imported from T3303A): + Deprecated: "This is a multi-line + deprecation message + for foo" diff --git a/testsuite/tests/parser/should_compile/T3303A.hs b/testsuite/tests/parser/should_compile/T3303A.hs new file mode 100644 index 0000000000..daa4bfb91d --- /dev/null +++ b/testsuite/tests/parser/should_compile/T3303A.hs @@ -0,0 +1,10 @@ + +module T3303A where + +{-# DEPRECATED foo + ["This is a multi-line", + "deprecation message", + "for foo"] #-} +foo :: Int +foo = 4 + diff --git a/testsuite/tests/parser/should_compile/T3741.hs b/testsuite/tests/parser/should_compile/T3741.hs new file mode 100644 index 0000000000..20d5c2d095 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T3741.hs @@ -0,0 +1,4 @@ +笑 :: Int +笑 = 3 + +main = print 笑 diff --git a/testsuite/tests/parser/should_compile/T5243.hs b/testsuite/tests/parser/should_compile/T5243.hs new file mode 100644 index 0000000000..e58ace299b --- /dev/null +++ b/testsuite/tests/parser/should_compile/T5243.hs @@ -0,0 +1 @@ + { import T5243A; main = print bar } diff --git a/testsuite/tests/parser/should_compile/T5243.stderr b/testsuite/tests/parser/should_compile/T5243.stderr new file mode 100644 index 0000000000..450e001237 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T5243.stderr @@ -0,0 +1,3 @@ +[1 of 2] Compiling T5243A ( T5243A.hs, T5243A.o ) +[2 of 2] Compiling Main ( T5243.hs, T5243.o ) +Linking T5243 ... diff --git a/testsuite/tests/parser/should_compile/T5243A.hs b/testsuite/tests/parser/should_compile/T5243A.hs new file mode 100644 index 0000000000..2332c84004 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T5243A.hs @@ -0,0 +1,2 @@ +module T5243A where +bar = True diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T new file mode 100644 index 0000000000..328c0651c3 --- /dev/null +++ b/testsuite/tests/parser/should_compile/all.T @@ -0,0 +1,94 @@ + +test('read001', normal, compile, ['']) +test('read002', normal, compile, ['']) +test('read003', normal, compile, ['']) +test('read004', normal, compile, ['']) +test('read005', normal, compile, ['']) + +# Missing: +# test('read006', normal, compile, ['']) +# test('read007', normal, compile, ['']) + +test('read008', normal, compile, ['']) +test('read009', normal, compile, ['']) +test('read010', normal, compile, ['']) +test('read011', normal, compile, ['']) + +# Missing: +# test('read012', normal, compile, ['']) +# test('read013', normal, compile, ['']) + +test('read014', normal, compile, ['-Wall -fno-warn-orphans']) +test('read015', normal, compile, ['']) +test('read016', normal, compile, ['']) +test('read017', normal, compile, ['']) +test('read018', normal, compile, ['']) +test('read019', normal, compile, ['']) + +# Missing: +# test('read020', normal, compile, ['']) + +test('read021', normal, compile, ['']) +test('read022', normal, compile, ['']) + +# we don't support strict Haskell 98 with respect to qualified identifiers +# any more (read023), see #1215. This test is in fact incorrect Haskell 98 +# anyway, so expect_fail would be wrong. +test('read023', skip, compile, ['']) + +test('read024', normal, compile, ['']) +test('read025', normal, compile, ['']) +test('read026', normal, compile, ['']) +test('read027', normal, compile, ['']) +test('read028', normal, compile, ['']) +test('read029', normal, compile, ['']) +test('read030', normal, compile, ['']) +test('read031', normal, compile, ['']) +test('read032', normal, compile, ['']) +test('read033', if_compiler_type('hugs', expect_fail), compile, ['']) +test('read034', if_compiler_type('hugs', expect_fail), compile, ['']) +test('read036', normal, compile, ['']) +test('read037', normal, compile, ['']) +test('read038', normal, compile, ['']) +test('read039', normal, compile, ['-fno-code']) +test('read040', normal, compile, ['']) +test('read041', literate, compile, ['']) +test('read042', normal, compile, ['']) +test('read043', normal, compile, ['']) +test('read044', normal, compile, ['']) +test('read045', normal, compile, ['']) +test('read046', normal, compile, ['']) +test('read047', normal, compile, ['']) +test('read048', normal, compile, ['']) +test('read049', normal, compile, ['']) +test('read050', normal, compile, ['']) +test('read051', normal, compile, ['']) +test('read052', normal, compile, ['']) +test('read053', normal, compile, ['']) +test('read054', normal, compile, ['']) +test('read055', normal, compile, ['']) +test('read056', normal, compile, ['']) +test('read057', normal, compile, ['']) +test('read058', omit_ways(['profc']), compile, ['']) +test('read059', omit_ways(['profc']), compile, ['']) +test('read060', normal, compile, ['']) +test('read061', normal, compile, ['']) +test('read062', normal, compile, ['']) +test('read063', normal, compile, ['']) +test('read064', normal, compile, ['']) +test('read066', normal, compile, ['']) +test('read067', normal, compile, ['']) +test('read068', normal, compile, ['']) +test('read069', normal, compile, ['']) +test('read_1821', normal, compile, ['']) +test('T2245', normal, compile, ['-fwarn-type-defaults']) +test('T3303', extra_clean(['T3303A.hi', 'T3303A.o']), + multimod_compile, ['T3303', '-v0']) +test('T3741', normal, compile, ['']) +test('DoAndIfThenElse', normal, compile, ['']) +test('NondecreasingIndentation', normal, compile, ['']) +test('mc15', normal, compile, ['']) +test('mc16', normal, compile, ['']) +test('EmptyDecls', normal, compile, ['']) + +test('T5243', normal, multimod_compile, ['T5243','']) diff --git a/testsuite/tests/parser/should_compile/mc15.hs b/testsuite/tests/parser/should_compile/mc15.hs new file mode 100644 index 0000000000..2976694803 --- /dev/null +++ b/testsuite/tests/parser/should_compile/mc15.hs @@ -0,0 +1,13 @@ + +{-# LANGUAGE MonadComprehensions, ParallelListComp #-} + +module Foo where + +import Control.Monad.Zip + +foo :: (MonadZip m, Monad m) => m () +foo = [ () + | () <- foo + | () <- foo + ] + diff --git a/testsuite/tests/parser/should_compile/mc16.hs b/testsuite/tests/parser/should_compile/mc16.hs new file mode 100644 index 0000000000..3f80c04abb --- /dev/null +++ b/testsuite/tests/parser/should_compile/mc16.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} + +module Foo where + +import Data.List +import GHC.Exts + +foo = [ () + | x <- [1..10] + , then take 5 + , then sortWith by x + , then group by x + , then group using inits + , then group by x using groupWith + ] + diff --git a/testsuite/tests/parser/should_compile/read001.hs b/testsuite/tests/parser/should_compile/read001.hs new file mode 100644 index 0000000000..d0a84ff7e5 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read001.hs @@ -0,0 +1,8 @@ +-- !!! import qualified Prelude should leave (), [] etc in scope + +module ShouldCompile where + +import qualified Prelude + +f :: Prelude.IO () +f = Prelude.return () diff --git a/testsuite/tests/parser/should_compile/read002.hs b/testsuite/tests/parser/should_compile/read002.hs new file mode 100644 index 0000000000..5b069fe2c6 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read002.hs @@ -0,0 +1,14 @@ +-- !!! 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 diff --git a/testsuite/tests/parser/should_compile/read002.stderr b/testsuite/tests/parser/should_compile/read002.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read002.stderr diff --git a/testsuite/tests/parser/should_compile/read003.hs b/testsuite/tests/parser/should_compile/read003.hs new file mode 100644 index 0000000000..afc3a21007 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read003.hs @@ -0,0 +1,20 @@ +-- !!! 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 = () diff --git a/testsuite/tests/parser/should_compile/read004.hs b/testsuite/tests/parser/should_compile/read004.hs new file mode 100644 index 0000000000..0741d0cd92 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read004.hs @@ -0,0 +1,16 @@ +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! diff --git a/testsuite/tests/parser/should_compile/read005.hs b/testsuite/tests/parser/should_compile/read005.hs new file mode 100644 index 0000000000..6e2c575902 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read005.hs @@ -0,0 +1,4 @@ +module ShouldCompile where + +-- !!! Empty comments terminating a file.. +main = print "Hello" -- diff --git a/testsuite/tests/parser/should_compile/read007.stderr b/testsuite/tests/parser/should_compile/read007.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read007.stderr diff --git a/testsuite/tests/parser/should_compile/read008.hs b/testsuite/tests/parser/should_compile/read008.hs new file mode 100644 index 0000000000..20060b0c4d --- /dev/null +++ b/testsuite/tests/parser/should_compile/read008.hs @@ -0,0 +1,4 @@ +module ShouldCompile where + +{-# SPECIALISE f :: Int -> Int #-} +f n = n + 1 diff --git a/testsuite/tests/parser/should_compile/read009.hs b/testsuite/tests/parser/should_compile/read009.hs new file mode 100644 index 0000000000..5294012de1 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read009.hs @@ -0,0 +1,7 @@ +-- !!! 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 + diff --git a/testsuite/tests/parser/should_compile/read010.hs b/testsuite/tests/parser/should_compile/read010.hs new file mode 100644 index 0000000000..d20f5fcc86 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read010.hs @@ -0,0 +1,4 @@ +-- !!! Infix record constructor. +module ShouldCompile where + +data Rec = (:<-:) { a :: Int, b :: Float } diff --git a/testsuite/tests/parser/should_compile/read010.stderr b/testsuite/tests/parser/should_compile/read010.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read010.stderr diff --git a/testsuite/tests/parser/should_compile/read011.hs b/testsuite/tests/parser/should_compile/read011.hs new file mode 100644 index 0000000000..7e20d468f0 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read011.hs @@ -0,0 +1,24 @@ +-- !!! 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] + diff --git a/testsuite/tests/parser/should_compile/read014.hs b/testsuite/tests/parser/should_compile/read014.hs new file mode 100644 index 0000000000..55fc053a8b --- /dev/null +++ b/testsuite/tests/parser/should_compile/read014.hs @@ -0,0 +1,8 @@ +-- !!! 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 diff --git a/testsuite/tests/parser/should_compile/read014.stderr-ghc b/testsuite/tests/parser/should_compile/read014.stderr-ghc new file mode 100644 index 0000000000..85f36b16da --- /dev/null +++ b/testsuite/tests/parser/should_compile/read014.stderr-ghc @@ -0,0 +1,28 @@ +
+read014.hs:4:1:
+ Warning: Top-level binding with no type signature:
+ ng1 :: forall t a. Num a => t -> a -> a
+
+read014.hs:4:5: Warning: Defined but not used: `x'
+
+read014.hs:6:10:
+ Warning: No explicit method nor default method for `+'
+ In the instance declaration for `Num (a, b)'
+
+read014.hs:6:10:
+ Warning: No explicit method nor default method for `*'
+ In the instance declaration for `Num (a, b)'
+
+read014.hs:6:10:
+ Warning: No explicit method nor default method for `abs'
+ In the instance declaration for `Num (a, b)'
+
+read014.hs:6:10:
+ Warning: No explicit method nor default method for `signum'
+ In the instance declaration for `Num (a, b)'
+
+read014.hs:6:10:
+ Warning: No explicit method nor default method for `fromInteger'
+ In the instance declaration for `Num (a, b)'
+
+read014.hs:8:53: Warning: Defined but not used: `x'
diff --git a/testsuite/tests/parser/should_compile/read015.hs b/testsuite/tests/parser/should_compile/read015.hs new file mode 100644 index 0000000000..7ba6140662 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read015.hs @@ -0,0 +1,2 @@ +-- !!! Testing whether the parser likes empty declarations.. +module ShouldCompile where { ;;;;;x=let{;;;;;y=2;;;;}in y;;;;;} diff --git a/testsuite/tests/parser/should_compile/read016.hs b/testsuite/tests/parser/should_compile/read016.hs new file mode 100644 index 0000000000..5c482f510d --- /dev/null +++ b/testsuite/tests/parser/should_compile/read016.hs @@ -0,0 +1,10 @@ +-- !!! Checking that both import lists and 'hiding' lists might +-- !!! be empty. +module ShouldCompile where + +import Data.List () +import Data.List hiding () + +x :: Int +x = 1 + diff --git a/testsuite/tests/parser/should_compile/read017.hs b/testsuite/tests/parser/should_compile/read017.hs new file mode 100644 index 0000000000..4349cb27ca --- /dev/null +++ b/testsuite/tests/parser/should_compile/read017.hs @@ -0,0 +1,15 @@ +-- !!! 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 diff --git a/testsuite/tests/parser/should_compile/read018.hs b/testsuite/tests/parser/should_compile/read018.hs new file mode 100644 index 0000000000..91eef518be --- /dev/null +++ b/testsuite/tests/parser/should_compile/read018.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DatatypeContexts #-} +-- !!! 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 + diff --git a/testsuite/tests/parser/should_compile/read018.stderr b/testsuite/tests/parser/should_compile/read018.stderr new file mode 100644 index 0000000000..30d1315840 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read018.stderr @@ -0,0 +1,3 @@ + +read018.hs:1:14: + Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. diff --git a/testsuite/tests/parser/should_compile/read019.hs b/testsuite/tests/parser/should_compile/read019.hs new file mode 100644 index 0000000000..3de6a9b71d --- /dev/null +++ b/testsuite/tests/parser/should_compile/read019.hs @@ -0,0 +1,10 @@ +-- !!! 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. +}; + + diff --git a/testsuite/tests/parser/should_compile/read021.hs b/testsuite/tests/parser/should_compile/read021.hs new file mode 100644 index 0000000000..8d5856e9b6 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read021.hs @@ -0,0 +1,6 @@ +-- !!! Empty export list + +module ShouldCompile() where + +instance Show (a->b) where + show f = "<<function>>" diff --git a/testsuite/tests/parser/should_compile/read022.hs b/testsuite/tests/parser/should_compile/read022.hs new file mode 100644 index 0000000000..4ab04cabb8 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read022.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module ShouldCompile where + +f (x :: Int) = x + 1 diff --git a/testsuite/tests/parser/should_compile/read023.hs b/testsuite/tests/parser/should_compile/read023.hs new file mode 100644 index 0000000000..3410afe946 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read023.hs @@ -0,0 +1,23 @@ +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 diff --git a/testsuite/tests/parser/should_compile/read024.hs b/testsuite/tests/parser/should_compile/read024.hs new file mode 100644 index 0000000000..f00ddb002c --- /dev/null +++ b/testsuite/tests/parser/should_compile/read024.hs @@ -0,0 +1,33 @@ +-- !!! 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] + +interruptible :: [interruptible] +interruptible = [head interruptible] + +stdcall :: [stdcall] +stdcall = [head stdcall] + +ccall :: [ccall] +ccall = [head ccall] + diff --git a/testsuite/tests/parser/should_compile/read025.hs b/testsuite/tests/parser/should_compile/read025.hs new file mode 100644 index 0000000000..7eca04e85c --- /dev/null +++ b/testsuite/tests/parser/should_compile/read025.hs @@ -0,0 +1,9 @@ +-- !!! Check the handling of 'qualified' and 'as' clauses +module ShouldCompile where + +import Data.List as L ( intersperse ) + +x = L.intersperse + +y = intersperse + diff --git a/testsuite/tests/parser/should_compile/read026.hs b/testsuite/tests/parser/should_compile/read026.hs new file mode 100644 index 0000000000..0ea695d373 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read026.hs @@ -0,0 +1,6 @@ +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 diff --git a/testsuite/tests/parser/should_compile/read027.hs b/testsuite/tests/parser/should_compile/read027.hs new file mode 100644 index 0000000000..a6893450f8 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read027.hs @@ -0,0 +1,14 @@ +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 diff --git a/testsuite/tests/parser/should_compile/read028.hs b/testsuite/tests/parser/should_compile/read028.hs new file mode 100644 index 0000000000..1f193a4584 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read028.hs @@ -0,0 +1,3 @@ +module ShouldCompile where + +data T a b = (:^:) a b diff --git a/testsuite/tests/parser/should_compile/read029.hs b/testsuite/tests/parser/should_compile/read029.hs new file mode 100644 index 0000000000..1a9e5c1c9e --- /dev/null +++ b/testsuite/tests/parser/should_compile/read029.hs @@ -0,0 +1,14 @@ +-- !!! 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 diff --git a/testsuite/tests/parser/should_compile/read030.hs b/testsuite/tests/parser/should_compile/read030.hs new file mode 100644 index 0000000000..26883024ee --- /dev/null +++ b/testsuite/tests/parser/should_compile/read030.hs @@ -0,0 +1,10 @@ +-- !!! 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 diff --git a/testsuite/tests/parser/should_compile/read031.hs b/testsuite/tests/parser/should_compile/read031.hs new file mode 100644 index 0000000000..d19f120ffd --- /dev/null +++ b/testsuite/tests/parser/should_compile/read031.hs @@ -0,0 +1,10 @@ +-- !!! "--" can start a legal lexeme + +module ShouldCompile where + +infix 2 --+, --> + +ps --> True = True + +(--+) a b = a && b + diff --git a/testsuite/tests/parser/should_compile/read032.hs b/testsuite/tests/parser/should_compile/read032.hs new file mode 100644 index 0000000000..634f6b5fa9 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read032.hs @@ -0,0 +1,4 @@ +module ShouldCompile where + +-- !!! Record declarations with zero fields are allowed +data Foo = Foo{} diff --git a/testsuite/tests/parser/should_compile/read033.hs b/testsuite/tests/parser/should_compile/read033.hs new file mode 100644 index 0000000000..2c8faf0343 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read033.hs @@ -0,0 +1,3 @@ +module ShouldCompile where + +x = const 1.0e+x where e = 3 diff --git a/testsuite/tests/parser/should_compile/read034.hs b/testsuite/tests/parser/should_compile/read034.hs new file mode 100644 index 0000000000..4fa7152f40 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read034.hs @@ -0,0 +1,12 @@ +module ShouldCompile where + +-- !!! Section precedences + +-- infixl 6 +, - +-- infixr 5 ++, : + +f = (++ [] ++ []) +g = (3 + 4 +) + +-- prefix negation is like infixl 6. +h x = (-x -) diff --git a/testsuite/tests/parser/should_compile/read036.hs b/testsuite/tests/parser/should_compile/read036.hs new file mode 100644 index 0000000000..81485f5a0f --- /dev/null +++ b/testsuite/tests/parser/should_compile/read036.hs @@ -0,0 +1,4 @@ +module ShouldCompile where + +f :: Double +f = 42e42 -- this should be a float diff --git a/testsuite/tests/parser/should_compile/read037.hs b/testsuite/tests/parser/should_compile/read037.hs new file mode 100644 index 0000000000..a9f822cc03 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read037.hs @@ -0,0 +1,6 @@ +module ShouldCompile where + +-- This file contains several non-breaking space characters, +-- aka '\xa0'. The compiler should recognise these as whitespace. + +f = ( + ) diff --git a/testsuite/tests/parser/should_compile/read038.hs b/testsuite/tests/parser/should_compile/read038.hs new file mode 100644 index 0000000000..30e20774fa --- /dev/null +++ b/testsuite/tests/parser/should_compile/read038.hs @@ -0,0 +1,5 @@ +module ShouldCompile where +a ---> b = a + a +foo = 3 + ---> 4 + ---> 5 diff --git a/testsuite/tests/parser/should_compile/read039.hs b/testsuite/tests/parser/should_compile/read039.hs new file mode 100644 index 0000000000..032c64f624 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read039.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP #-} +-- Test the LANGUAGE pragma +module ShouldCompile where + +#if 1 +foreign import ccall "foo" foo :: Int -> IO Int +#endif diff --git a/testsuite/tests/parser/should_compile/read040.hs b/testsuite/tests/parser/should_compile/read040.hs new file mode 100644 index 0000000000..e6d6629744 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read040.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- A type signature on the LHS of a do-stmt was a parse +-- error in 6.4.2, but ok thereafter + +module ShouldCompile where + +f () = do { x :: Bool <- return True + ; return x } diff --git a/testsuite/tests/parser/should_compile/read041.lhs b/testsuite/tests/parser/should_compile/read041.lhs new file mode 100644 index 0000000000..30274e85a1 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read041.lhs @@ -0,0 +1,10 @@ +-- Tests trac #210. + +module ShouldCompile where + +\begin{code} + main = foo +\end{code} + +> foo = putStrLn "Foo" + diff --git a/testsuite/tests/parser/should_compile/read042.hs b/testsuite/tests/parser/should_compile/read042.hs new file mode 100644 index 0000000000..922b7b12bb --- /dev/null +++ b/testsuite/tests/parser/should_compile/read042.hs @@ -0,0 +1,29 @@ +{-# OPTIONS -XBangPatterns #-} + +-- Various bang-pattern and lazy-pattern tests + +module ShouldCompile where + +main1,main2,main3,main4,main5,main6,main7 :: IO () + +main1 = do + !c <- return () + return () + +main2 = return () >>= \ !c -> return () + +main3 = do + (!c) <- return () + return () + +main4 = return () >>= \ (!c) -> return () + +main5 = let !x = 1 in return () + +main6 = do + ~c <- return () + return () + +main7 = return () >>= \ ~c -> return () + + diff --git a/testsuite/tests/parser/should_compile/read043.hs b/testsuite/tests/parser/should_compile/read043.hs new file mode 100644 index 0000000000..c663a7526e --- /dev/null +++ b/testsuite/tests/parser/should_compile/read043.hs @@ -0,0 +1,11 @@ + +{-# OPTIONS -fwarn-tabs #-} + +-- Check we get a warning for tabs + +module ShouldCompile where + +tab1 = 'a' +notab = 'b' +tab2 = 'c' + diff --git a/testsuite/tests/parser/should_compile/read043.stderr b/testsuite/tests/parser/should_compile/read043.stderr new file mode 100644 index 0000000000..dc1e84466a --- /dev/null +++ b/testsuite/tests/parser/should_compile/read043.stderr @@ -0,0 +1,4 @@ + +read043.hs:8:5: Warning: Tab character + +read043.hs:10:5: Warning: Tab character diff --git a/testsuite/tests/parser/should_compile/read044.hs b/testsuite/tests/parser/should_compile/read044.hs new file mode 100644 index 0000000000..a92b48c298 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read044.hs @@ -0,0 +1,5 @@ +-- test case from #1091 +main = + case True of {- | -} + True -> putStrLn "Hello World\n" + False {- | -} -> putStrLn "Goodbye Cruel World\n" diff --git a/testsuite/tests/parser/should_compile/read045.hs b/testsuite/tests/parser/should_compile/read045.hs new file mode 100644 index 0000000000..844acdfc82 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read045.hs @@ -0,0 +1,4 @@ +{ +main = +putStr "hello"; +} diff --git a/testsuite/tests/parser/should_compile/read046.hs b/testsuite/tests/parser/should_compile/read046.hs new file mode 100644 index 0000000000..5cc602f5a4 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read046.hs @@ -0,0 +1,7 @@ + +{-# OPTIONS_GHC -XMagicHash #-} + +module Foo where + +foo# = 'a' + diff --git a/testsuite/tests/parser/should_compile/read047.hs b/testsuite/tests/parser/should_compile/read047.hs new file mode 100644 index 0000000000..0c7470156d --- /dev/null +++ b/testsuite/tests/parser/should_compile/read047.hs @@ -0,0 +1,7 @@ + +{-# LANGUAGE MagicHash #-} + +module Foo where + +foo# = 'a' + diff --git a/testsuite/tests/parser/should_compile/read048.hs b/testsuite/tests/parser/should_compile/read048.hs new file mode 100644 index 0000000000..cd8c974af6 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read048.hs @@ -0,0 +1,7 @@ + +{-# OPTIONS_GHC -XEmptyDataDecls #-} + +module Foo where + +data Foo + diff --git a/testsuite/tests/parser/should_compile/read049.hs b/testsuite/tests/parser/should_compile/read049.hs new file mode 100644 index 0000000000..8337a79634 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read049.hs @@ -0,0 +1,7 @@ + +{-# LANGUAGE EmptyDataDecls #-} + +module Foo where + +data Foo + diff --git a/testsuite/tests/parser/should_compile/read050.hs b/testsuite/tests/parser/should_compile/read050.hs new file mode 100644 index 0000000000..d991bb01c7 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read050.hs @@ -0,0 +1,7 @@ + +{-# OPTIONS_GHC -XKindSignatures #-} + +module Foo where + +data Foo (a :: *) = Foo a + diff --git a/testsuite/tests/parser/should_compile/read051.hs b/testsuite/tests/parser/should_compile/read051.hs new file mode 100644 index 0000000000..3e95241862 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read051.hs @@ -0,0 +1,7 @@ + +{-# LANGUAGE KindSignatures #-} + +module Foo where + +data Foo (a :: *) = Foo a + diff --git a/testsuite/tests/parser/should_compile/read052.hs b/testsuite/tests/parser/should_compile/read052.hs new file mode 100644 index 0000000000..8c65e62a1b --- /dev/null +++ b/testsuite/tests/parser/should_compile/read052.hs @@ -0,0 +1,7 @@ + +{-# OPTIONS_GHC -XMultiParamTypeClasses #-} + +module Foo where + +class Foo a b + diff --git a/testsuite/tests/parser/should_compile/read053.hs b/testsuite/tests/parser/should_compile/read053.hs new file mode 100644 index 0000000000..a277f31257 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read053.hs @@ -0,0 +1,7 @@ + +{-# LANGUAGE MultiParamTypeClasses #-} + +module Foo where + +class Foo a b + diff --git a/testsuite/tests/parser/should_compile/read054.hs b/testsuite/tests/parser/should_compile/read054.hs new file mode 100644 index 0000000000..4e0c589bf3 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read054.hs @@ -0,0 +1,10 @@ + +{-# OPTIONS_GHC -XParallelListComp #-} + +module Foo where + +foo = [ () + | () <- foo + | () <- foo + ] + diff --git a/testsuite/tests/parser/should_compile/read055.hs b/testsuite/tests/parser/should_compile/read055.hs new file mode 100644 index 0000000000..25db332a4d --- /dev/null +++ b/testsuite/tests/parser/should_compile/read055.hs @@ -0,0 +1,10 @@ + +{-# LANGUAGE ParallelListComp #-} + +module Foo where + +foo = [ () + | () <- foo + | () <- foo + ] + diff --git a/testsuite/tests/parser/should_compile/read056.hs b/testsuite/tests/parser/should_compile/read056.hs new file mode 100644 index 0000000000..bab900ad6a --- /dev/null +++ b/testsuite/tests/parser/should_compile/read056.hs @@ -0,0 +1,11 @@ + +{-# OPTIONS_GHC -XGeneralizedNewtypeDeriving #-} + +module Foo where + +class C a +instance C Int + +newtype Foo = Foo Int + deriving C + diff --git a/testsuite/tests/parser/should_compile/read057.hs b/testsuite/tests/parser/should_compile/read057.hs new file mode 100644 index 0000000000..f2cf84b3b5 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read057.hs @@ -0,0 +1,11 @@ + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Foo where + +class C a +instance C Int + +newtype Foo = Foo Int + deriving C + diff --git a/testsuite/tests/parser/should_compile/read058.hs b/testsuite/tests/parser/should_compile/read058.hs new file mode 100644 index 0000000000..9d4f766ada --- /dev/null +++ b/testsuite/tests/parser/should_compile/read058.hs @@ -0,0 +1,11 @@ + +{-# OPTIONS_GHC -XRecursiveDo #-} + +module Foo where + +import Control.Monad.Fix + +z :: Maybe [Int] +z = mdo x <- return (1:x) + return (take 4 x) + diff --git a/testsuite/tests/parser/should_compile/read058.stderr b/testsuite/tests/parser/should_compile/read058.stderr new file mode 100644 index 0000000000..aa42286c89 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read058.stderr @@ -0,0 +1,3 @@ + +read058.hs:2:16: + Warning: -XRecursiveDo is deprecated: use -XDoRec or pragma {-# LANGUAGE DoRec #-} instead diff --git a/testsuite/tests/parser/should_compile/read059.hs b/testsuite/tests/parser/should_compile/read059.hs new file mode 100644 index 0000000000..79989afd3f --- /dev/null +++ b/testsuite/tests/parser/should_compile/read059.hs @@ -0,0 +1,11 @@ + +{-# LANGUAGE RecursiveDo #-} + +module Foo where + +import Control.Monad.Fix + +z :: Maybe [Int] +z = mdo x <- return (1:x) + return (take 4 x) + diff --git a/testsuite/tests/parser/should_compile/read059.stderr b/testsuite/tests/parser/should_compile/read059.stderr new file mode 100644 index 0000000000..5d2ae6c397 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read059.stderr @@ -0,0 +1,3 @@ + +read059.hs:2:14: + Warning: -XRecursiveDo is deprecated: use -XDoRec or pragma {-# LANGUAGE DoRec #-} instead diff --git a/testsuite/tests/parser/should_compile/read060.hs b/testsuite/tests/parser/should_compile/read060.hs new file mode 100644 index 0000000000..1b07dfa397 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read060.hs @@ -0,0 +1,8 @@ + +{-# OPTIONS_GHC -XFunctionalDependencies #-} +{-# OPTIONS_GHC -XMultiParamTypeClasses #-} + +module Foo where + +class Foo a b | a -> b + diff --git a/testsuite/tests/parser/should_compile/read061.hs b/testsuite/tests/parser/should_compile/read061.hs new file mode 100644 index 0000000000..1820e460f3 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read061.hs @@ -0,0 +1,8 @@ + +{-# LANGUAGE FunctionalDependencies #-} +{-# OPTIONS_GHC -XMultiParamTypeClasses #-} + +module Foo where + +class Foo a b | a -> b + diff --git a/testsuite/tests/parser/should_compile/read062.hs b/testsuite/tests/parser/should_compile/read062.hs new file mode 100644 index 0000000000..4d57585c10 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read062.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -XTransformListComp #-}
+
+module Foo where
+
+import Data.List
+import GHC.Exts
+
+foo = [ ()
+ | x <- [1..10]
+ , then take 5
+ , then sortWith by x
+ , then group by x
+ , then group using inits
+ , then group by x using groupWith
+ ]
+
diff --git a/testsuite/tests/parser/should_compile/read063.hs b/testsuite/tests/parser/should_compile/read063.hs new file mode 100644 index 0000000000..faa7c4a4a5 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read063.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +--module Foo where + +import GHC.Exts + +--you can use this if you want to test running it... +main = print (I# ( + f1pat 1# +# f1prepat 1# + +# f2pat 1# +# f2prepat 1# + +# f3pat 1# +# f3prepat 1# + )) + +--unboxed tuples are of sizes 1,2,3... +--(normal tuples are 0,2,3...) + +--make sure it's really the _unboxed_ tuples +--being used by putting unboxed values in, +--which are forbidden in boxed tuples + +f1 :: Int# -> (# Int# #) +f1 i = (# i #) +-- a space is needed in (# #) so that it's not +-- lexed/parsed as an operator named "##" +--(even though the error message about mismatched +--kinds for "instance Functor (# #)" names the type +--as "(##)" +-- Kind mis-match +-- Expected kind `* -> *', but `(##)' has kind `? -> (#)' +-- In the instance declaration for `Functor (##)' +f1prefix :: Int# -> (# #) Int# +f1prefix i = (# #) i +--test that prefix and non-prefix versions +--are the same type by switching the case-argument +f1pat a = case f1prefix a of (# i #) -> i +# 1# +f1prepat a = case f1 a of (# #) i -> i +# 1# + +f2 :: Int# -> (# Int#, Int# #) +f2 i = (# i, i #) +f2prefix :: Int# -> (#,#) Int# Int# +f2prefix i = (#,#) i i +f2pat a = case f2prefix a of (# i, j #) -> i +# j +f2prepat a = case f2 a of (#,#) i j -> i +# j + +f3 :: Int# -> (# Int#, Int#, Int# #) +f3 i = (# i, i, i #) +f3prefix :: Int# -> (#,,#) Int# Int# Int# +f3prefix i = (#,,#) i i i +f3pat a = case f3prefix a of (# i, j, k #) -> i +# j +# k +f3prepat a = case f3 a of (#,,#) i j k -> i +# j +# k + diff --git a/testsuite/tests/parser/should_compile/read064.hs b/testsuite/tests/parser/should_compile/read064.hs new file mode 100644 index 0000000000..386574244f --- /dev/null +++ b/testsuite/tests/parser/should_compile/read064.hs @@ -0,0 +1,7 @@ + +module Foo where + +{-# THISISATYPO foo #-} +foo :: () +foo = () + diff --git a/testsuite/tests/parser/should_compile/read064.stderr b/testsuite/tests/parser/should_compile/read064.stderr new file mode 100644 index 0000000000..8ed04fc629 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read064.stderr @@ -0,0 +1,2 @@ + +read064.hs:4:1: Unrecognised pragma diff --git a/testsuite/tests/parser/should_compile/read066.hs b/testsuite/tests/parser/should_compile/read066.hs new file mode 100644 index 0000000000..374f76126c --- /dev/null +++ b/testsuite/tests/parser/should_compile/read066.hs @@ -0,0 +1,8 @@ + +{-# OPTIONS_NO_SUCH_PRAGMA --no-such-flag #-} + +-- We should parse the above as an unrecognised pragma, not as an OPTIONS +-- pragma containing "_NO_SUCH_PRAGMA -wibble". Trac #2847. + +module Test where + diff --git a/testsuite/tests/parser/should_compile/read066.stderr b/testsuite/tests/parser/should_compile/read066.stderr new file mode 100644 index 0000000000..a094133754 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read066.stderr @@ -0,0 +1,2 @@ + +read066.hs:2:1: Unrecognised pragma diff --git a/testsuite/tests/parser/should_compile/read067.hs b/testsuite/tests/parser/should_compile/read067.hs new file mode 100644 index 0000000000..f65f56b498 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read067.hs @@ -0,0 +1,8 @@ + +{-# OPTIONS_HUGS --some-hugs-flag #-} + +-- We should ignore the above pragma, as we recognise that it is +-- hugs-specific. We shouldn't even warn about it. + +module Test where + diff --git a/testsuite/tests/parser/should_compile/read068.hs b/testsuite/tests/parser/should_compile/read068.hs new file mode 100644 index 0000000000..b6cf24fd0c --- /dev/null +++ b/testsuite/tests/parser/should_compile/read068.hs @@ -0,0 +1,27 @@ +-- Test for trac #3079 - parsing fails if a LANGUAGE pragma straddles +-- a 1024 byte boundary. +-- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +-- xxxxxxxxxxxxxxxxxxxxxxx +-- xxxxxxxxxxxxxxxxxxxxxxxxxxxxx +-- +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +-- +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx +-- +--xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx + +{-# LANGUAGE NoImplicitPrelude #-} + +import Prelude + +main :: IO () +main = return () + diff --git a/testsuite/tests/parser/should_compile/read069.hs b/testsuite/tests/parser/should_compile/read069.hs new file mode 100644 index 0000000000..cff74b474b --- /dev/null +++ b/testsuite/tests/parser/should_compile/read069.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RelaxedLayout #-} + +module ShouldFail where + +f x = case x of + False -> do + { return x; } + diff --git a/testsuite/tests/parser/should_compile/read_1821.hs b/testsuite/tests/parser/should_compile/read_1821.hs new file mode 100644 index 0000000000..f9669ab053 --- /dev/null +++ b/testsuite/tests/parser/should_compile/read_1821.hs @@ -0,0 +1,10 @@ + +-- Trac #1821 + +module Par where + +f x = x + where +-- ######### x86_64 machine code: + g y = y + h y = y diff --git a/testsuite/tests/parser/should_fail/Makefile b/testsuite/tests/parser/should_fail/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/parser/should_fail/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/parser/should_fail/NoDoAndIfThenElse.hs b/testsuite/tests/parser/should_fail/NoDoAndIfThenElse.hs new file mode 100644 index 0000000000..2439205e3e --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoDoAndIfThenElse.hs @@ -0,0 +1,9 @@ + +{-# LANGUAGE NoDoAndIfThenElse #-} + +module NoDoAndIfThenElse where + +foo :: IO () +foo = do if True + then return () + else return () diff --git a/testsuite/tests/parser/should_fail/NoDoAndIfThenElse.stderr b/testsuite/tests/parser/should_fail/NoDoAndIfThenElse.stderr new file mode 100644 index 0000000000..b175c0ac5e --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoDoAndIfThenElse.stderr @@ -0,0 +1,5 @@ + +NoDoAndIfThenElse.hs:7:13: + Unexpected semi-colons in conditional: + if True; then return (); else return () + Perhaps you meant to use -XDoAndIfThenElse? diff --git a/testsuite/tests/parser/should_fail/NondecreasingIndentationFail.hs b/testsuite/tests/parser/should_fail/NondecreasingIndentationFail.hs new file mode 100644 index 0000000000..5b67a60612 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NondecreasingIndentationFail.hs @@ -0,0 +1,10 @@ + +{-# LANGUAGE NoNondecreasingIndentation #-} + +module ShouldCompile where + +f :: IO () +f = do if True then f else do + f + if True then f else do + f diff --git a/testsuite/tests/parser/should_fail/NondecreasingIndentationFail.stderr b/testsuite/tests/parser/should_fail/NondecreasingIndentationFail.stderr new file mode 100644 index 0000000000..c9ccd3ea53 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NondecreasingIndentationFail.stderr @@ -0,0 +1,4 @@ + +NondecreasingIndentationFail.hs:7:28: Empty 'do' block + +NondecreasingIndentationFail.hs:9:28: Empty 'do' block diff --git a/testsuite/tests/parser/should_fail/T1344a.hs b/testsuite/tests/parser/should_fail/T1344a.hs new file mode 100644 index 0000000000..709d1636c0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T1344a.hs @@ -0,0 +1,7 @@ +module T1344a where + +a = "Hel\x6c000000000000000 World" +b = "Hel\x6c0000000000000000 World" +c = '\1114112' + + diff --git a/testsuite/tests/parser/should_fail/T1344a.stderr b/testsuite/tests/parser/should_fail/T1344a.stderr new file mode 100644 index 0000000000..a7c203c1c5 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T1344a.stderr @@ -0,0 +1,3 @@ + +T1344a.hs:3:16: + numeric escape sequence out of range at character '0' diff --git a/testsuite/tests/parser/should_fail/T1344b.hs b/testsuite/tests/parser/should_fail/T1344b.hs new file mode 100644 index 0000000000..b355dda5e6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T1344b.hs @@ -0,0 +1,4 @@ +module T1344b where + +b = "Hel\x6c0000000000000000 World" + diff --git a/testsuite/tests/parser/should_fail/T1344b.stderr b/testsuite/tests/parser/should_fail/T1344b.stderr new file mode 100644 index 0000000000..7b05c0fb2b --- /dev/null +++ b/testsuite/tests/parser/should_fail/T1344b.stderr @@ -0,0 +1,3 @@ + +T1344b.hs:3:16: + numeric escape sequence out of range at character '0' diff --git a/testsuite/tests/parser/should_fail/T1344c.hs b/testsuite/tests/parser/should_fail/T1344c.hs new file mode 100644 index 0000000000..0e5d0c6190 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T1344c.hs @@ -0,0 +1,4 @@ +module T1344c where + +c = '\1114112' + diff --git a/testsuite/tests/parser/should_fail/T1344c.stderr b/testsuite/tests/parser/should_fail/T1344c.stderr new file mode 100644 index 0000000000..57ad0592bd --- /dev/null +++ b/testsuite/tests/parser/should_fail/T1344c.stderr @@ -0,0 +1,3 @@ + +T1344c.hs:3:13: + numeric escape sequence out of range at character '2' diff --git a/testsuite/tests/parser/should_fail/T3095.hs b/testsuite/tests/parser/should_fail/T3095.hs new file mode 100644 index 0000000000..ad6b62c562 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3095.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE KindSignatures #-} +-- Trac #3095 +module T3095 where + +class Bla (forall x . x :: *) where diff --git a/testsuite/tests/parser/should_fail/T3095.stderr b/testsuite/tests/parser/should_fail/T3095.stderr new file mode 100644 index 0000000000..3e47128e41 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3095.stderr @@ -0,0 +1,5 @@ + +T3095.hs:5:21: + Illegal symbol '.' in type + Perhaps you intended -XRankNTypes or similar flag + to enable explicit-forall syntax: forall <tvs>. <type> diff --git a/testsuite/tests/parser/should_fail/T3153.hs b/testsuite/tests/parser/should_fail/T3153.hs new file mode 100644 index 0000000000..af28ddc98c --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3153.hs @@ -0,0 +1,2 @@ +{-# LANGUAGE +# diff --git a/testsuite/tests/parser/should_fail/T3153.stderr b/testsuite/tests/parser/should_fail/T3153.stderr new file mode 100644 index 0000000000..5a21b339aa --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3153.stderr @@ -0,0 +1,6 @@ + +T3153.hs:1:1: + Cannot parse LANGUAGE pragma + Expecting comma-separated list of language options, + each starting with a capital letter + E.g. {-# LANGUAGE RecordPuns, Generics #-} diff --git a/testsuite/tests/parser/should_fail/T3751.hs b/testsuite/tests/parser/should_fail/T3751.hs new file mode 100644 index 0000000000..9de569b01f --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3751.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +x = "\§" diff --git a/testsuite/tests/parser/should_fail/T3751.stderr b/testsuite/tests/parser/should_fail/T3751.stderr new file mode 100644 index 0000000000..cf14e746e1 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3751.stderr @@ -0,0 +1,3 @@ + +T3751.hs:3:7: + lexical error in string/character literal at character '\167' diff --git a/testsuite/tests/parser/should_fail/T3811.hs b/testsuite/tests/parser/should_fail/T3811.hs new file mode 100644 index 0000000000..30c1f5068f --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811.hs @@ -0,0 +1,5 @@ + +module T3811 where + +f x :: Char +f x = 'c' diff --git a/testsuite/tests/parser/should_fail/T3811.stderr b/testsuite/tests/parser/should_fail/T3811.stderr new file mode 100644 index 0000000000..afdead696e --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811.stderr @@ -0,0 +1,4 @@ + +T3811.hs:4:1: + Invalid type signature: f x :: Char + Should be of form <variable> :: <type> diff --git a/testsuite/tests/parser/should_fail/T3811b.hs b/testsuite/tests/parser/should_fail/T3811b.hs new file mode 100644 index 0000000000..720cffa17f --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811b.hs @@ -0,0 +1,4 @@ + +module T3811b where + +data Foo a = !B diff --git a/testsuite/tests/parser/should_fail/T3811b.stderr b/testsuite/tests/parser/should_fail/T3811b.stderr new file mode 100644 index 0000000000..342354dd84 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811b.stderr @@ -0,0 +1,3 @@ + +T3811b.hs:4:14: + parse error in constructor in data/newtype declaration: !B diff --git a/testsuite/tests/parser/should_fail/T3811c.hs b/testsuite/tests/parser/should_fail/T3811c.hs new file mode 100644 index 0000000000..d2b063c54f --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811c.hs @@ -0,0 +1,7 @@ + +module T3811c where + +data D = D + +instance !Show D + diff --git a/testsuite/tests/parser/should_fail/T3811c.stderr b/testsuite/tests/parser/should_fail/T3811c.stderr new file mode 100644 index 0000000000..9b61341152 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811c.stderr @@ -0,0 +1,2 @@ + +T3811c.hs:6:10: Malformed instance header: !Show D diff --git a/testsuite/tests/parser/should_fail/T3811d.hs b/testsuite/tests/parser/should_fail/T3811d.hs new file mode 100644 index 0000000000..ee95cd862d --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811d.hs @@ -0,0 +1,7 @@ + +module T3811d where + +data D a = D a + +class C b (D Char) b + diff --git a/testsuite/tests/parser/should_fail/T3811d.stderr b/testsuite/tests/parser/should_fail/T3811d.stderr new file mode 100644 index 0000000000..6f6e6c4267 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811d.stderr @@ -0,0 +1,5 @@ + +T3811d.hs:6:11: + Type found: D Char + where type variable expected, in: b (D Char) b + diff --git a/testsuite/tests/parser/should_fail/T3811e.hs b/testsuite/tests/parser/should_fail/T3811e.hs new file mode 100644 index 0000000000..69a559c9c4 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811e.hs @@ -0,0 +1,6 @@ + +{-# LANGUAGE NoDatatypeContexts #-} + +module T3811e where + +data (Show a, Read a) => D a = D a diff --git a/testsuite/tests/parser/should_fail/T3811e.stderr b/testsuite/tests/parser/should_fail/T3811e.stderr new file mode 100644 index 0000000000..f2acc84706 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811e.stderr @@ -0,0 +1,5 @@ + +T3811e.hs:6:6: + Illegal datatype context (use -XDatatypeContexts): (Show a, + Read a) => + diff --git a/testsuite/tests/parser/should_fail/T3811f.hs b/testsuite/tests/parser/should_fail/T3811f.hs new file mode 100644 index 0000000000..a047feed72 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811f.hs @@ -0,0 +1,4 @@ + +module T3811f where + +class !Foo a diff --git a/testsuite/tests/parser/should_fail/T3811f.stderr b/testsuite/tests/parser/should_fail/T3811f.stderr new file mode 100644 index 0000000000..882ae06706 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811f.stderr @@ -0,0 +1,2 @@ + +T3811f.hs:4:7: Malformed head of type or class declaration: !Foo a diff --git a/testsuite/tests/parser/should_fail/T3811g.hs b/testsuite/tests/parser/should_fail/T3811g.hs new file mode 100644 index 0000000000..8b901f49e3 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811g.hs @@ -0,0 +1,7 @@ + +module T3811g where + +f :: IO () +f = do _ <- return () + _ <- return () + diff --git a/testsuite/tests/parser/should_fail/T3811g.stderr b/testsuite/tests/parser/should_fail/T3811g.stderr new file mode 100644 index 0000000000..94917e52ae --- /dev/null +++ b/testsuite/tests/parser/should_fail/T3811g.stderr @@ -0,0 +1,4 @@ + +T3811g.hs:6:8: + The last statement in a 'do' block must be an expression + _ <- return () diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T new file mode 100644 index 0000000000..31ec0d9a3e --- /dev/null +++ b/testsuite/tests/parser/should_fail/all.T @@ -0,0 +1,71 @@ + +test('readFail001', normal, compile_fail, ['']) +test('readFail002', normal, compile_fail, ['']) +test('readFail003', normal, compile_fail, ['']) +test('readFail004', normal, compile_fail, ['']) +test('readFail005', normal, compile_fail, ['']) +test('readFail006', normal, compile_fail, ['']) +test('readFail007', normal, compile_fail, ['']) +test('readFail008', normal, compile_fail, ['']) +test('readFail009', normal, compile_fail, ['']) +# test10: missing +test('readFail011', normal, compile_fail, ['']) +test('readFail012', normal, compile_fail, ['']) +test('readFail013', normal, compile_fail, ['']) +test('readFail014', normal, compile_fail, ['']) +test('readFail015', normal, compile_fail, ['']) +test('readFail016', normal, compile_fail, ['']) +test('readFail017', normal, compile_fail, ['']) +test('readFail018', normal, compile_fail, ['']) +test('readFail019', normal, compile_fail, ['']) +test('readFail020', normal, compile_fail, ['']) + +# empty file (length zero) is not a legal Haskell module. It fails to compile +# because it doesn't contain a definition of Main.main. GHC 5.02 crashed +# on this example. +test('readFail021', if_compiler_type('hugs', expect_fail), compile_fail, ['']) + +test('readFail022', normal, compile_fail, ['']) +test('readFail023', normal, compile_fail, ['']) +test('readFail024', normal, compile_fail, ['']) +test('readFail025', normal, compile_fail, ['']) +test('readFail026', normal, compile_fail, ['']) +test('readFail027', normal, compile_fail, ['']) +test('readFail028', normal, compile_fail, ['']) +test('readFail029', normal, compile_fail, ['']) +test('readFail030', normal, compile_fail, ['']) +test('readFail031', normal, compile_fail, ['']) +test('readFail032', expect_broken(314), compile_fail, ['-cpp']) +test('readFail033', normal, compile_fail, ['']) +test('readFail034', normal, compile_fail, ['']) +test('readFail035', normal, compile_fail, ['']) +test('readFail036', normal, compile_fail, ['']) +test('readFail037', normal, compile_fail, ['']) +test('readFail038', normal, compile_fail, ['']) +test('readFail039', normal, compile_fail, ['']) +test('readFail040', normal, compile_fail, ['']) +test('readFail041', normal, compile_fail, ['']) +test('readFail042', normal, compile_fail, ['']) +test('readFail043', normal, compile_fail, ['']) +test('readFail044', normal, compile_fail, ['']) +test('readFail046', normal, compile_fail, ['']) +test('readFail047', normal, compile_fail, ['']) +test('T3095', normal, compile_fail, ['']) +test('T3153', normal, compile_fail, ['']) +test('T3751', normal, compile_fail, ['']) + +test('position001', normal, compile_fail, ['']) +test('position002', normal, compile_fail, ['']) + +test('T1344a', normal, compile_fail, ['']) +test('T1344b', normal, compile_fail, ['']) +test('T1344c', normal, compile_fail, ['']) +test('T3811', normal, compile_fail, ['']) +test('T3811b', normal, compile_fail, ['']) +test('T3811c', normal, compile_fail, ['']) +test('T3811d', normal, compile_fail, ['']) +test('T3811e', normal, compile_fail, ['']) +test('T3811f', normal, compile_fail, ['']) +test('T3811g', normal, compile_fail, ['']) +test('NoDoAndIfThenElse', normal, compile_fail, ['']) +test('NondecreasingIndentationFail', normal, compile_fail, ['']) diff --git a/testsuite/tests/parser/should_fail/position001.hs b/testsuite/tests/parser/should_fail/position001.hs new file mode 100644 index 0000000000..c47ed60a1b --- /dev/null +++ b/testsuite/tests/parser/should_fail/position001.hs @@ -0,0 +1,7 @@ + +module T where + +-- We should get a parse error on column 33 +-- Indented with spaces: +foo = 123456 module + diff --git a/testsuite/tests/parser/should_fail/position001.stderr b/testsuite/tests/parser/should_fail/position001.stderr new file mode 100644 index 0000000000..0635c8d867 --- /dev/null +++ b/testsuite/tests/parser/should_fail/position001.stderr @@ -0,0 +1,2 @@ + +position001.hs:6:33: parse error on input `module' diff --git a/testsuite/tests/parser/should_fail/position002.hs b/testsuite/tests/parser/should_fail/position002.hs new file mode 100644 index 0000000000..861acf5344 --- /dev/null +++ b/testsuite/tests/parser/should_fail/position002.hs @@ -0,0 +1,7 @@ + +module T where + +-- We should get a parse error on column 33 +-- Indented with tabs: +foo = 123456 module + diff --git a/testsuite/tests/parser/should_fail/position002.stderr b/testsuite/tests/parser/should_fail/position002.stderr new file mode 100644 index 0000000000..9306d42fb8 --- /dev/null +++ b/testsuite/tests/parser/should_fail/position002.stderr @@ -0,0 +1,2 @@ + +position002.hs:6:33: parse error on input `module' diff --git a/testsuite/tests/parser/should_fail/readFail001.hs b/testsuite/tests/parser/should_fail/readFail001.hs new file mode 100644 index 0000000000..a996475efd --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail001.hs @@ -0,0 +1,113 @@ +-- !!! this module supposedly includes one of each Haskell construct + +-- HsImpExp stuff + +module OneOfEverything ( + fixn, + FooData, + FooDataB(..), + FooDataC( .. ), + Tree(Leaf, Branch), + EqClass(..), + OrdClass(orda, ordb), + module OneC , + module OneOfEverything + ) where + +import Prelude +import System.IO ( putStr ) +import System.Environment hiding ( getArgs ) +import Control.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 Tree a = Leaf a | Branch (Leaf a) (Leaf 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 (Tree 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) = 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 diff --git a/testsuite/tests/parser/should_fail/readFail001.stderr b/testsuite/tests/parser/should_fail/readFail001.stderr new file mode 100644 index 0000000000..719d4c12bd --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail001.stderr @@ -0,0 +1,24 @@ + +readFail001.hs:25:11: + The fixity signature for `+#' lacks an accompanying binding + +readFail001.hs:38:32: + Not in scope: type constructor or class `Leaf' + +readFail001.hs:38:41: + Not in scope: type constructor or class `Leaf' + +readFail001.hs:87:11: Not in scope: `x' + +readFail001.hs:88:19: Not in scope: `x' + +readFail001.hs:94:19: Not in scope: `isSpace' + +readFail001.hs:95:13: Not in scope: `foo' + +readFail001.hs:107:30: Not in scope: data constructor `Foo' + +readFail001.hs:107:42: Not in scope: data constructor `Bar' + +readFail001.hs:112:23: + Not in scope: type constructor or class `Foo' diff --git a/testsuite/tests/parser/should_fail/readFail001.stderr-hugs b/testsuite/tests/parser/should_fail/readFail001.stderr-hugs new file mode 100644 index 0000000000..ab30ff6dc0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail001.stderr-hugs @@ -0,0 +1 @@ +ERROR "read001.hs":38 - Undefined type constructor "EqLeaf" diff --git a/testsuite/tests/parser/should_fail/readFail001.stdout b/testsuite/tests/parser/should_fail/readFail001.stdout new file mode 100644 index 0000000000..a4d6758f8c --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail001.stdout @@ -0,0 +1,87 @@ + +==================== Parser ==================== +module OneOfEverything ( + module OneOfEverything, module OneC, OrdClass(orda, ordb), + EqClass(..), EqTree(EqLeaf, EqBranch), FooDataC(..), FooDataB(..), + FooData, fixn + ) where +import Prelude +import IO (putStr) +import System hiding (getArgs) +import Monad +bindwith :: (OrdClass a, OrdClass b) => a -> b -> b +g :: (Num a, Eq b) => Foo a -> [b] -> (a, a, a) -> b +g x y z = head y +f _ + x + 1 + 1.93 + 'c' + "dog" + ~y + (z@(Foo a b)) + (c Bar d) + [1, 2] + (3, 4) + ((n+42)) + = y +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 + PrelBase.[] + | 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])) +mat a b c d + | foof a b = d + | foof a c = d + | foof b c = d + where + foof a b = a == b +(~(a, b, c)) + | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null +recb a = reca a +reca a = recb a +bindwith a b = b +singlebind x = x +fixr x y = x +fixl x y = x +fixn x y = x +infix 6 fixn +infixl 7 +# +infixr 8 fixr +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; Just eqc x = '?' } +class (Ord a) => OrdClass a where { + orda = :: a -> Char; ordb = :: a -> Char; ordc = :: a -> Char; + Just + } +instance (Eq a) => {EqClass (EqTree a)} where + [] + eqc x = 'a' +default (Integer, Rational) + + diff --git a/testsuite/tests/parser/should_fail/readFail002.hs b/testsuite/tests/parser/should_fail/readFail002.hs new file mode 100644 index 0000000000..869cb86a33 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail002.hs @@ -0,0 +1,6 @@ +module ShouldFail where + +-- !!! newlines in strings aren't allowed + +f = " +" diff --git a/testsuite/tests/parser/should_fail/readFail002.stderr b/testsuite/tests/parser/should_fail/readFail002.stderr new file mode 100644 index 0000000000..d368fe302d --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail002.stderr @@ -0,0 +1,3 @@ + +readFail002.hs:5:6: + lexical error in string/character literal at character '\n' diff --git a/testsuite/tests/parser/should_fail/readFail002.stderr-hugs b/testsuite/tests/parser/should_fail/readFail002.stderr-hugs new file mode 100644 index 0000000000..12031904f7 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail002.stderr-hugs @@ -0,0 +1 @@ +ERROR "read002.hs":5 - Improperly terminated string diff --git a/testsuite/tests/parser/should_fail/readFail003.hs b/testsuite/tests/parser/should_fail/readFail003.hs new file mode 100644 index 0000000000..8595312137 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail003.hs @@ -0,0 +1,8 @@ +-- !!! Irrefutable patterns + guards +module Read003 where + +~(a,b,c) | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null diff --git a/testsuite/tests/parser/should_fail/readFail003.stderr b/testsuite/tests/parser/should_fail/readFail003.stderr new file mode 100644 index 0000000000..fe8ce00577 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail003.stderr @@ -0,0 +1,36 @@ + +readFail003.hs:4:27: + Occurs check: cannot construct the infinite type: + t0 = (t0, [a0], [a1]) + In the expression: a + In a pattern binding: + ~(a, b, c) + | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null + +readFail003.hs:5:27: + Occurs check: cannot construct the infinite type: + t0 = (t0, [a0], [a1]) + In the expression: a + In a pattern binding: + ~(a, b, c) + | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null + +readFail003.hs:6:27: + Occurs check: cannot construct the infinite type: + t0 = (t0, [a0], [a1]) + In the expression: a + In a pattern binding: + ~(a, b, c) + | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null diff --git a/testsuite/tests/parser/should_fail/readFail003.stderr-hugs b/testsuite/tests/parser/should_fail/readFail003.stderr-hugs new file mode 100644 index 0000000000..d89db6e928 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail003.stderr-hugs @@ -0,0 +1,5 @@ +ERROR "read003.hs":4 - Type error in right hand side +*** Term : a +*** Type : a +*** Does not match : (a,[b],[c]) +*** Because : unification would give infinite type diff --git a/testsuite/tests/parser/should_fail/readFail003.stdout b/testsuite/tests/parser/should_fail/readFail003.stdout new file mode 100644 index 0000000000..e1291a62a7 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail003.stdout @@ -0,0 +1,11 @@ + +==================== Parser ==================== +module Read003 where +~(a, b, c) + | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null + + diff --git a/testsuite/tests/parser/should_fail/readFail004.hs b/testsuite/tests/parser/should_fail/readFail004.hs new file mode 100644 index 0000000000..f5e1fb4304 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail004.hs @@ -0,0 +1,41 @@ +-- !!! string gaps +-- !!! +module Main(main) where + +----------- + +main = putStr "\ + +\Some girls give me money\n\ + +\Some girls buy me clothes\n\ + +\..." + +----------- + +main2 = putStr "\ +\ \ +..." + +----------- + +main3 = putStr "\ + +\Some girls give me money\n\ +-- and here is a comment +\Some girls buy me clothes\n\ + +\..." + +----------- + +main3 = putStr "\ +{- + and here is a nested {- comment -} +-} +\Some girls give me money\n\ + +\Some girls buy me clothes\n\ + +\..." diff --git a/testsuite/tests/parser/should_fail/readFail004.stderr b/testsuite/tests/parser/should_fail/readFail004.stderr new file mode 100644 index 0000000000..45ad7d7215 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail004.stderr @@ -0,0 +1,3 @@ + +readFail004.hs:19:1: + lexical error in string/character literal at character '.' diff --git a/testsuite/tests/parser/should_fail/readFail004.stderr-hugs b/testsuite/tests/parser/should_fail/readFail004.stderr-hugs new file mode 100644 index 0000000000..a737a0100e --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail004.stderr-hugs @@ -0,0 +1 @@ +ERROR "read004.hs":19 - Missing `\' terminating string literal gap diff --git a/testsuite/tests/parser/should_fail/readFail005.hs b/testsuite/tests/parser/should_fail/readFail005.hs new file mode 100644 index 0000000000..8ed88c0ea0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail005.hs @@ -0,0 +1,4 @@ +module Tests where + +-- this char is forbidden +c = '\&' diff --git a/testsuite/tests/parser/should_fail/readFail005.stderr b/testsuite/tests/parser/should_fail/readFail005.stderr new file mode 100644 index 0000000000..6b5b2ce9e2 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail005.stderr @@ -0,0 +1,3 @@ + +readFail005.hs:4:7: + lexical error in string/character literal at character '&' diff --git a/testsuite/tests/parser/should_fail/readFail005.stderr-hugs b/testsuite/tests/parser/should_fail/readFail005.stderr-hugs new file mode 100644 index 0000000000..bda4ebcd9d --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail005.stderr-hugs @@ -0,0 +1 @@ +ERROR "read005.hs":4 - Illegal use of `\&' in character constant diff --git a/testsuite/tests/parser/should_fail/readFail006.hs b/testsuite/tests/parser/should_fail/readFail006.hs new file mode 100644 index 0000000000..fa3d867c67 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail006.hs @@ -0,0 +1,9 @@ +-- !!! Using pattern syntax on RHS +module ShouldFail where + +f :: Int -> Int +f x = _ + +g :: Int -> Int +g x = 2 + 2@_ + diff --git a/testsuite/tests/parser/should_fail/readFail006.stderr b/testsuite/tests/parser/should_fail/readFail006.stderr new file mode 100644 index 0000000000..92ea7a484d --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail006.stderr @@ -0,0 +1,2 @@ + +readFail006.hs:8:12: parse error on input `@' diff --git a/testsuite/tests/parser/should_fail/readFail006.stderr-hugs b/testsuite/tests/parser/should_fail/readFail006.stderr-hugs new file mode 100644 index 0000000000..f39482998c --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail006.stderr-hugs @@ -0,0 +1 @@ +ERROR "read006.hs":8 - Syntax error in input (unexpected `@') diff --git a/testsuite/tests/parser/should_fail/readFail007.hs b/testsuite/tests/parser/should_fail/readFail007.hs new file mode 100644 index 0000000000..4466f17d18 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail007.hs @@ -0,0 +1,8 @@ +-- !!! Expressions as patterns inside do stmt blocks +module ShouldFail where + +f :: Int -> IO Int +f x = do + (2+2) <- 2 + return x + diff --git a/testsuite/tests/parser/should_fail/readFail007.stderr b/testsuite/tests/parser/should_fail/readFail007.stderr new file mode 100644 index 0000000000..3236824a78 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail007.stderr @@ -0,0 +1,2 @@ + +readFail007.hs:6:4: Parse error in pattern: 2 + 2 diff --git a/testsuite/tests/parser/should_fail/readFail007.stdout b/testsuite/tests/parser/should_fail/readFail007.stdout new file mode 100644 index 0000000000..c91365d679 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail007.stdout @@ -0,0 +1,9 @@ + +==================== Parser ==================== +module ShouldFail where +f :: Int -> IO Int +f x = do + (2 + 2) <- 2 + return x + + diff --git a/testsuite/tests/parser/should_fail/readFail008.hs b/testsuite/tests/parser/should_fail/readFail008.hs new file mode 100644 index 0000000000..606af912f0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail008.hs @@ -0,0 +1,5 @@ +module ShouldFail where + +-- strictness annotations on the argument to a newtype constructor +-- are not allowed. +newtype N a = T ![a] diff --git a/testsuite/tests/parser/should_fail/readFail008.stderr b/testsuite/tests/parser/should_fail/readFail008.stderr new file mode 100644 index 0000000000..a40ce01da0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail008.stderr @@ -0,0 +1,6 @@ + +readFail008.hs:5:15: + A newtype constructor cannot have a strictness annotation, + but `T' does + In the definition of data constructor `T' + In the newtype declaration for `N' diff --git a/testsuite/tests/parser/should_fail/readFail008.stderr-hugs b/testsuite/tests/parser/should_fail/readFail008.stderr-hugs new file mode 100644 index 0000000000..73edc248e9 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail008.stderr-hugs @@ -0,0 +1 @@ +ERROR "read008.hs":5 - Illegal strictness annotation for newtype constructor diff --git a/testsuite/tests/parser/should_fail/readFail009.hs b/testsuite/tests/parser/should_fail/readFail009.hs new file mode 100644 index 0000000000..93a7b84d5b --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail009.hs @@ -0,0 +1,15 @@ +module ShouldFail where + +-- !!! Test for parse error in do/let expression + +foo = do let foo = True + return () + + +-- Note the let binding at the end! +-- This gave a pattern-match failure in tcStmts in ghc-4.04proto + +h x = x + + + diff --git a/testsuite/tests/parser/should_fail/readFail009.stderr b/testsuite/tests/parser/should_fail/readFail009.stderr new file mode 100644 index 0000000000..7f5684e2c5 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail009.stderr @@ -0,0 +1,2 @@ + +readFail009.hs:12:1: parse error (possibly incorrect indentation) diff --git a/testsuite/tests/parser/should_fail/readFail009.stderr-hugs b/testsuite/tests/parser/should_fail/readFail009.stderr-hugs new file mode 100644 index 0000000000..698df240cc --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail009.stderr-hugs @@ -0,0 +1 @@ +ERROR "read009.hs":12 - Syntax error in declaration (unexpected `}', possibly due to bad layout) diff --git a/testsuite/tests/parser/should_fail/readFail009.stdout b/testsuite/tests/parser/should_fail/readFail009.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail009.stdout diff --git a/testsuite/tests/parser/should_fail/readFail011.hs b/testsuite/tests/parser/should_fail/readFail011.hs new file mode 100644 index 0000000000..4642061fcc --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail011.hs @@ -0,0 +1,7 @@ +-- !!! Test line numbers in presence of string gaps. + +main = print "a\ + \b\ + \c" + +wibble = = -- this is a parse error on line 7 diff --git a/testsuite/tests/parser/should_fail/readFail011.stderr b/testsuite/tests/parser/should_fail/readFail011.stderr new file mode 100644 index 0000000000..2570aa357e --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail011.stderr @@ -0,0 +1,2 @@ + +readFail011.hs:7:10: parse error on input `=' diff --git a/testsuite/tests/parser/should_fail/readFail011.stderr-hugs b/testsuite/tests/parser/should_fail/readFail011.stderr-hugs new file mode 100644 index 0000000000..03d0dda838 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail011.stderr-hugs @@ -0,0 +1 @@ +ERROR "read011.hs":7 - Syntax error in expression (unexpected `=') diff --git a/testsuite/tests/parser/should_fail/readFail012.hs b/testsuite/tests/parser/should_fail/readFail012.hs new file mode 100644 index 0000000000..4a780885f7 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail012.hs @@ -0,0 +1,9 @@ +-- !!! test parse errors due to tokens inserted by layout + +-- used to report "Parse error on input `'" in 4.04pl0. + +main = let + f = (a, + g = 1 + in f + diff --git a/testsuite/tests/parser/should_fail/readFail012.stderr b/testsuite/tests/parser/should_fail/readFail012.stderr new file mode 100644 index 0000000000..849e918204 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail012.stderr @@ -0,0 +1,2 @@ + +readFail012.hs:7:9: parse error (possibly incorrect indentation) diff --git a/testsuite/tests/parser/should_fail/readFail012.stderr-hugs b/testsuite/tests/parser/should_fail/readFail012.stderr-hugs new file mode 100644 index 0000000000..242a34ef34 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail012.stderr-hugs @@ -0,0 +1 @@ +ERROR "read012.hs":7 - Syntax error in expression (unexpected `;', possibly due to bad layout) diff --git a/testsuite/tests/parser/should_fail/readFail013.hs b/testsuite/tests/parser/should_fail/readFail013.hs new file mode 100644 index 0000000000..97e926d49c --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail013.hs @@ -0,0 +1,4 @@ +module Main where + +-- !!! unterminated `` +a = ``s`` diff --git a/testsuite/tests/parser/should_fail/readFail013.stderr b/testsuite/tests/parser/should_fail/readFail013.stderr new file mode 100644 index 0000000000..9be590d0b0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail013.stderr @@ -0,0 +1,2 @@ + +readFail013.hs:4:5: parse error on input ``' diff --git a/testsuite/tests/parser/should_fail/readFail013.stderr-hugs b/testsuite/tests/parser/should_fail/readFail013.stderr-hugs new file mode 100644 index 0000000000..11bb7156f5 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail013.stderr-hugs @@ -0,0 +1 @@ +ERROR "read013.hs":4 - Syntax error in expression (unexpected backquote) diff --git a/testsuite/tests/parser/should_fail/readFail014.hs b/testsuite/tests/parser/should_fail/readFail014.hs new file mode 100644 index 0000000000..23ef7954a6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail014.hs @@ -0,0 +1,3 @@ +main = f + where + f = f } diff --git a/testsuite/tests/parser/should_fail/readFail014.stderr b/testsuite/tests/parser/should_fail/readFail014.stderr new file mode 100644 index 0000000000..4bb5fff2da --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail014.stderr @@ -0,0 +1,2 @@ + +readFail014.hs:3:12: parse error on input `}' diff --git a/testsuite/tests/parser/should_fail/readFail014.stderr-hugs b/testsuite/tests/parser/should_fail/readFail014.stderr-hugs new file mode 100644 index 0000000000..73e29ecbb0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail014.stderr-hugs @@ -0,0 +1 @@ +ERROR "read014.hs":3 - Misplaced `}' diff --git a/testsuite/tests/parser/should_fail/readFail015.hs b/testsuite/tests/parser/should_fail/readFail015.hs new file mode 100644 index 0000000000..6920083483 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail015.hs @@ -0,0 +1,5 @@ +module Test where + +-- should fail; doesn't with happy 1.8. +f = f where b = f + c = (b diff --git a/testsuite/tests/parser/should_fail/readFail015.stderr b/testsuite/tests/parser/should_fail/readFail015.stderr new file mode 100644 index 0000000000..696167edca --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail015.stderr @@ -0,0 +1,2 @@ + +readFail015.hs:6:1: parse error (possibly incorrect indentation) diff --git a/testsuite/tests/parser/should_fail/readFail015.stderr-hugs b/testsuite/tests/parser/should_fail/readFail015.stderr-hugs new file mode 100644 index 0000000000..c66b668cf5 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail015.stderr-hugs @@ -0,0 +1 @@ +ERROR "read015.hs":6 - Syntax error in expression (unexpected `}', possibly due to bad layout) diff --git a/testsuite/tests/parser/should_fail/readFail016.hs b/testsuite/tests/parser/should_fail/readFail016.hs new file mode 100644 index 0000000000..493606a481 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail016.hs @@ -0,0 +1,7 @@ +-- !!! Infix decls w/ infix data constructors + +module ShouldFail where + +infix 6 |- + +ps |- q:qs = undefined diff --git a/testsuite/tests/parser/should_fail/readFail016.stderr b/testsuite/tests/parser/should_fail/readFail016.stderr new file mode 100644 index 0000000000..620d8505a2 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail016.stderr @@ -0,0 +1,4 @@ + +readFail016.hs:7:1: + Precedence parsing error + cannot mix `|-' [infix 6] and `:' [infixr 5] in the same infix expression diff --git a/testsuite/tests/parser/should_fail/readFail016.stdout b/testsuite/tests/parser/should_fail/readFail016.stdout new file mode 100644 index 0000000000..7c7f529466 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail016.stdout @@ -0,0 +1,7 @@ + +==================== Parser ==================== +module ShouldFail where +|- ps q : qs = undefined +infix 6 |- + + diff --git a/testsuite/tests/parser/should_fail/readFail017.hs b/testsuite/tests/parser/should_fail/readFail017.hs new file mode 100644 index 0000000000..1d710f5012 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail017.hs @@ -0,0 +1,6 @@ +module ShouldFail where + +-- GHC < 5.01 used to get the line number wrong. +f (f f) = f + +g = g diff --git a/testsuite/tests/parser/should_fail/readFail017.stderr b/testsuite/tests/parser/should_fail/readFail017.stderr new file mode 100644 index 0000000000..05f7c9931f --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail017.stderr @@ -0,0 +1,2 @@ + +readFail017.hs:4:4: Parse error in pattern: f diff --git a/testsuite/tests/parser/should_fail/readFail017.stderr-hugs b/testsuite/tests/parser/should_fail/readFail017.stderr-hugs new file mode 100644 index 0000000000..a83103a57b --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail017.stderr-hugs @@ -0,0 +1 @@ +ERROR "read017.hs":4 - Syntax error in declaration (unexpected symbol "f") diff --git a/testsuite/tests/parser/should_fail/readFail018.hs b/testsuite/tests/parser/should_fail/readFail018.hs new file mode 100644 index 0000000000..0086f50466 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail018.hs @@ -0,0 +1,8 @@ +-- !!! test the error message for an unterminated nested comment + +{- <-- this one is unterminated (line 3) + +{- +-} + +-- EOF diff --git a/testsuite/tests/parser/should_fail/readFail018.stderr b/testsuite/tests/parser/should_fail/readFail018.stderr new file mode 100644 index 0000000000..d07aa622c0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail018.stderr @@ -0,0 +1,2 @@ + +readFail018.hs:3:1: unterminated `{-' diff --git a/testsuite/tests/parser/should_fail/readFail018.stderr-hugs b/testsuite/tests/parser/should_fail/readFail018.stderr-hugs new file mode 100644 index 0000000000..57c04a5826 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail018.stderr-hugs @@ -0,0 +1 @@ +ERROR "read018.hs":3 - Unterminated nested comment {- ... diff --git a/testsuite/tests/parser/should_fail/readFail019.hs b/testsuite/tests/parser/should_fail/readFail019.hs new file mode 100644 index 0000000000..c9fdd15f75 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail019.hs @@ -0,0 +1,3 @@ +-- !!! cannot close an explicit layout context with a parse error +module ShouldFail where +f = let { x = 42 in x diff --git a/testsuite/tests/parser/should_fail/readFail019.stderr b/testsuite/tests/parser/should_fail/readFail019.stderr new file mode 100644 index 0000000000..65f7580599 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail019.stderr @@ -0,0 +1,2 @@ + +readFail019.hs:3:18: parse error on input `in' diff --git a/testsuite/tests/parser/should_fail/readFail019.stderr-hugs b/testsuite/tests/parser/should_fail/readFail019.stderr-hugs new file mode 100644 index 0000000000..fc021de327 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail019.stderr-hugs @@ -0,0 +1 @@ +ERROR "read019.hs":3 - Syntax error in declaration (unexpected keyword "in") diff --git a/testsuite/tests/parser/should_fail/readFail020.hs b/testsuite/tests/parser/should_fail/readFail020.hs new file mode 100644 index 0000000000..d7cf818e23 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail020.hs @@ -0,0 +1,3 @@ +-- !!! cannot close a layout context with an explicit close brace +module ShouldFail where +f = let x = 42 } in x diff --git a/testsuite/tests/parser/should_fail/readFail020.stderr b/testsuite/tests/parser/should_fail/readFail020.stderr new file mode 100644 index 0000000000..fb81cef861 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail020.stderr @@ -0,0 +1,2 @@ + +readFail020.hs:3:16: parse error on input `}' diff --git a/testsuite/tests/parser/should_fail/readFail020.stderr-hugs b/testsuite/tests/parser/should_fail/readFail020.stderr-hugs new file mode 100644 index 0000000000..2fe580ec23 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail020.stderr-hugs @@ -0,0 +1 @@ +ERROR "read020.hs":3 - Syntax error in expression (unexpected `}', possibly due to bad layout) diff --git a/testsuite/tests/parser/should_fail/readFail021.hs b/testsuite/tests/parser/should_fail/readFail021.hs new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail021.hs diff --git a/testsuite/tests/parser/should_fail/readFail021.stderr b/testsuite/tests/parser/should_fail/readFail021.stderr new file mode 100644 index 0000000000..a3f5e7b3f0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail021.stderr @@ -0,0 +1,2 @@ + +readFail021.hs:1:1: The function `main' is not defined in module `Main' diff --git a/testsuite/tests/parser/should_fail/readFail022.hs b/testsuite/tests/parser/should_fail/readFail022.hs new file mode 100644 index 0000000000..8d63b44b40 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail022.hs @@ -0,0 +1,4 @@ +module ShouldFail where + +-- !!! a parenthesised lhs must have at least one parameter +(a # b) = a diff --git a/testsuite/tests/parser/should_fail/readFail022.stderr b/testsuite/tests/parser/should_fail/readFail022.stderr new file mode 100644 index 0000000000..2c1b254229 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail022.stderr @@ -0,0 +1,2 @@ + +readFail022.hs:4:2: Parse error in pattern: a # b diff --git a/testsuite/tests/parser/should_fail/readFail022.stderr-hugs b/testsuite/tests/parser/should_fail/readFail022.stderr-hugs new file mode 100644 index 0000000000..d0315f1914 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail022.stderr-hugs @@ -0,0 +1 @@ +ERROR "read022.hs":4 - Syntax error in declaration (unexpected `=') diff --git a/testsuite/tests/parser/should_fail/readFail023.hs b/testsuite/tests/parser/should_fail/readFail023.hs new file mode 100644 index 0000000000..9c230f8a6a --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail023.hs @@ -0,0 +1,12 @@ +module ShouldFail where + +-- !!! Section precedences + +-- check that we're not translating out negative literals too early: +-- the following should be an illegal section because prefix '-' has +-- precedence 6: + +k = (-3 **) + where + (**) = const + infixl 7 ** diff --git a/testsuite/tests/parser/should_fail/readFail023.stderr b/testsuite/tests/parser/should_fail/readFail023.stderr new file mode 100644 index 0000000000..e1b6ceb83c --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail023.stderr @@ -0,0 +1,6 @@ + +readFail023.hs:9:5: + The operator `**' [infixl 7] of a section + must have lower precedence than that of the operand, + namely prefix `-' [infixl 6] + in the section: `- 3 **' diff --git a/testsuite/tests/parser/should_fail/readFail024.hs b/testsuite/tests/parser/should_fail/readFail024.hs new file mode 100644 index 0000000000..70f38329ae --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail024.hs @@ -0,0 +1,5 @@ +module ShouldFail where + +-- !!! this is not legal Haskell 98, but GHC parses it +f = f where g = g where + h = h diff --git a/testsuite/tests/parser/should_fail/readFail024.stderr b/testsuite/tests/parser/should_fail/readFail024.stderr new file mode 100644 index 0000000000..01d32ec450 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail024.stderr @@ -0,0 +1,2 @@ + +readFail024.hs:5:2: parse error on input `h' diff --git a/testsuite/tests/parser/should_fail/readFail024.stderr-hugs b/testsuite/tests/parser/should_fail/readFail024.stderr-hugs new file mode 100644 index 0000000000..542507b0a6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail024.stderr-hugs @@ -0,0 +1 @@ +ERROR "read024.hs":5 - Syntax error in input (unexpected symbol "h") diff --git a/testsuite/tests/parser/should_fail/readFail025.hs b/testsuite/tests/parser/should_fail/readFail025.hs new file mode 100644 index 0000000000..25e170d1ff --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail025.hs @@ -0,0 +1,5 @@ +module M where + +-- This one actually compiled right the way up to GHC 5.04.3 + +data T String = T String diff --git a/testsuite/tests/parser/should_fail/readFail025.stderr b/testsuite/tests/parser/should_fail/readFail025.stderr new file mode 100644 index 0000000000..313019147a --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail025.stderr @@ -0,0 +1,4 @@ + +readFail025.hs:5:8: + Type found: String + where type variable expected, in: String diff --git a/testsuite/tests/parser/should_fail/readFail025.stderr-hugs b/testsuite/tests/parser/should_fail/readFail025.stderr-hugs new file mode 100644 index 0000000000..176b7fd94e --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail025.stderr-hugs @@ -0,0 +1 @@ +ERROR "read025.hs":6 - Illegal left hand side in data type declaration diff --git a/testsuite/tests/parser/should_fail/readFail026.hs b/testsuite/tests/parser/should_fail/readFail026.hs new file mode 100644 index 0000000000..6d3f820151 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail026.hs @@ -0,0 +1,3 @@ +module ShouldFail where +data T = T{a::Int} +x = T{,a=42} diff --git a/testsuite/tests/parser/should_fail/readFail026.stderr b/testsuite/tests/parser/should_fail/readFail026.stderr new file mode 100644 index 0000000000..2249fa0b41 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail026.stderr @@ -0,0 +1,2 @@ + +readFail026.hs:3:7: parse error on input `,' diff --git a/testsuite/tests/parser/should_fail/readFail026.stderr-hugs b/testsuite/tests/parser/should_fail/readFail026.stderr-hugs new file mode 100644 index 0000000000..da743251d0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail026.stderr-hugs @@ -0,0 +1 @@ +ERROR "read026.hs":3 - Syntax error in expression (unexpected comma) diff --git a/testsuite/tests/parser/should_fail/readFail027.hs b/testsuite/tests/parser/should_fail/readFail027.hs new file mode 100644 index 0000000000..9a4754678a --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail027.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE NoRelaxedLayout #-} + +module ShouldFail where + +-- Erroneously allowed by GHC 6.2.x +f x = case x of + False -> do + { return x; } +-- this line should close the 'case' context and cause the 'do' to be empty. + +-- Update: arguably this should be allowed. The fix to the Haskell +-- layout rule to allow it is simple: in Section 9.3 in the rules that +-- govern the introduction of the <n> and {n} psuedo-tokens, we need +-- to prevent <n> being inserted before {. This could be a simple +-- side-condition on the rule that introduces <n>. diff --git a/testsuite/tests/parser/should_fail/readFail027.stderr b/testsuite/tests/parser/should_fail/readFail027.stderr new file mode 100644 index 0000000000..68f3d25755 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail027.stderr @@ -0,0 +1,2 @@ + +readFail027.hs:8:5: Missing block diff --git a/testsuite/tests/parser/should_fail/readFail028.hs b/testsuite/tests/parser/should_fail/readFail028.hs new file mode 100644 index 0000000000..ca0d27e10e --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail028.hs @@ -0,0 +1,4 @@ +module ShouldFail where + +-- !!! do must end in an expression +main = do x <- return () diff --git a/testsuite/tests/parser/should_fail/readFail028.stderr b/testsuite/tests/parser/should_fail/readFail028.stderr new file mode 100644 index 0000000000..651f778bb4 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail028.stderr @@ -0,0 +1,4 @@ + +readFail028.hs:4:11: + The last statement in a 'do' block must be an expression + x <- return () diff --git a/testsuite/tests/parser/should_fail/readFail029.hs b/testsuite/tests/parser/should_fail/readFail029.hs new file mode 100644 index 0000000000..d107cacc17 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail029.hs @@ -0,0 +1 @@ +{-# LANGUAGE wibble wibble wibble #-} diff --git a/testsuite/tests/parser/should_fail/readFail029.stderr b/testsuite/tests/parser/should_fail/readFail029.stderr new file mode 100644 index 0000000000..7f73291fe4 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail029.stderr @@ -0,0 +1,6 @@ + +readFail029.hs:1:14: + Cannot parse LANGUAGE pragma + Expecting comma-separated list of language options, + each starting with a capital letter + E.g. {-# LANGUAGE RecordPuns, Generics #-} diff --git a/testsuite/tests/parser/should_fail/readFail030.hs b/testsuite/tests/parser/should_fail/readFail030.hs new file mode 100644 index 0000000000..0829dc51ed --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail030.hs @@ -0,0 +1 @@ +{-# LANGUAGE ExtensibleRecords, RestrictedTypeSynonyms, HereDocuments, NamedFieldPuns #-} diff --git a/testsuite/tests/parser/should_fail/readFail030.stderr b/testsuite/tests/parser/should_fail/readFail030.stderr new file mode 100644 index 0000000000..e557a6b055 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail030.stderr @@ -0,0 +1,2 @@ + +readFail030.hs:1:14: Unsupported extension: ExtensibleRecords diff --git a/testsuite/tests/parser/should_fail/readFail031.hs b/testsuite/tests/parser/should_fail/readFail031.hs new file mode 100644 index 0000000000..d07f8979a6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail031.hs @@ -0,0 +1,4 @@ +module ShouldFail where
+
+class Foo o where
+ (:+) :: o -> o -> o
diff --git a/testsuite/tests/parser/should_fail/readFail031.stderr b/testsuite/tests/parser/should_fail/readFail031.stderr new file mode 100644 index 0000000000..628c8352f6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail031.stderr @@ -0,0 +1,4 @@ + +readFail031.hs:4:3: + Invalid type signature: (:+) :: o -> o -> o + Should be of form <variable> :: <type> diff --git a/testsuite/tests/parser/should_fail/readFail032.hs b/testsuite/tests/parser/should_fail/readFail032.hs new file mode 100644 index 0000000000..dec758a16f --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail032.hs @@ -0,0 +1,22 @@ + +-- Test for trac #314 + +{- +/* + This + uses + up + some + lines + This + uses + up + some + lines + */ +-} + +module ShouldFail where + +type_error = "Type error on line 21":"Type error on line 21" + diff --git a/testsuite/tests/parser/should_fail/readFail032.stderr b/testsuite/tests/parser/should_fail/readFail032.stderr new file mode 100644 index 0000000000..95852c5bbd --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail032.stderr @@ -0,0 +1,8 @@ + +readFail032.hs:21:38: + Couldn't match expected type `[Char]' with actual type `Char' + Expected type: [[Char]] + Actual type: [Char] + In the second argument of `(:)', namely `"Type error on line 21"' + In the expression: + "Type error on line 21" : "Type error on line 21" diff --git a/testsuite/tests/parser/should_fail/readFail033.hs b/testsuite/tests/parser/should_fail/readFail033.hs new file mode 100644 index 0000000000..6662563ff4 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail033.hs @@ -0,0 +1,2 @@ +-- TAB character in a string literal is disallowed: +x = " " diff --git a/testsuite/tests/parser/should_fail/readFail033.stderr b/testsuite/tests/parser/should_fail/readFail033.stderr new file mode 100644 index 0000000000..595323f3fd --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail033.stderr @@ -0,0 +1,3 @@ + +readFail033.hs:2:6: + lexical error in string/character literal at character '\t' diff --git a/testsuite/tests/parser/should_fail/readFail034.hs b/testsuite/tests/parser/should_fail/readFail034.hs new file mode 100644 index 0000000000..f92c33fcce --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail034.hs @@ -0,0 +1,5 @@ + +module Foo where + +foo# = 'a' + diff --git a/testsuite/tests/parser/should_fail/readFail034.stderr b/testsuite/tests/parser/should_fail/readFail034.stderr new file mode 100644 index 0000000000..19f428131f --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail034.stderr @@ -0,0 +1,2 @@ + +readFail034.hs:4:6: parse error on input `=' diff --git a/testsuite/tests/parser/should_fail/readFail035.hs b/testsuite/tests/parser/should_fail/readFail035.hs new file mode 100644 index 0000000000..6682e9ad8b --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail035.hs @@ -0,0 +1,7 @@ + +{-# LANGUAGE Haskell98 #-} + +module Foo where + +data Foo + diff --git a/testsuite/tests/parser/should_fail/readFail035.stderr b/testsuite/tests/parser/should_fail/readFail035.stderr new file mode 100644 index 0000000000..05f2d864ac --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail035.stderr @@ -0,0 +1,4 @@ + +readFail035.hs:6:1: + `Foo' has no constructors (-XEmptyDataDecls permits this) + In the data type declaration for `Foo' diff --git a/testsuite/tests/parser/should_fail/readFail036.hs b/testsuite/tests/parser/should_fail/readFail036.hs new file mode 100644 index 0000000000..2bb23149dd --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail036.hs @@ -0,0 +1,5 @@ + +module Foo where + +data Foo (a :: *) = Foo a + diff --git a/testsuite/tests/parser/should_fail/readFail036.stderr b/testsuite/tests/parser/should_fail/readFail036.stderr new file mode 100644 index 0000000000..8c89f29e34 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail036.stderr @@ -0,0 +1,4 @@ + +readFail036.hs:4:1: + Illegal kind signature for `a' + Perhaps you intended to use -XKindSignatures diff --git a/testsuite/tests/parser/should_fail/readFail037.hs b/testsuite/tests/parser/should_fail/readFail037.hs new file mode 100644 index 0000000000..499f5cc0f3 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail037.hs @@ -0,0 +1,5 @@ + +module Foo where + +class Foo a b + diff --git a/testsuite/tests/parser/should_fail/readFail037.stderr b/testsuite/tests/parser/should_fail/readFail037.stderr new file mode 100644 index 0000000000..4c900d66b1 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail037.stderr @@ -0,0 +1,5 @@ + +readFail037.hs:4:1: + Too many parameters for class `Foo' + (Use -XMultiParamTypeClasses to allow multi-parameter classes) + In the class declaration for `Foo' diff --git a/testsuite/tests/parser/should_fail/readFail038.hs b/testsuite/tests/parser/should_fail/readFail038.hs new file mode 100644 index 0000000000..cc60436f2f --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail038.hs @@ -0,0 +1,8 @@ + +module Foo where + +foo = [ () + | () <- foo + | () <- foo + ] + diff --git a/testsuite/tests/parser/should_fail/readFail038.stderr b/testsuite/tests/parser/should_fail/readFail038.stderr new file mode 100644 index 0000000000..6933463b8f --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail038.stderr @@ -0,0 +1,4 @@ + +readFail038.hs:6:7: + Unexpected parallel statement in a list comprehension + Use -XParallelListComp diff --git a/testsuite/tests/parser/should_fail/readFail039.hs b/testsuite/tests/parser/should_fail/readFail039.hs new file mode 100644 index 0000000000..c6cbdb9968 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail039.hs @@ -0,0 +1,9 @@ + +module Foo where + +class C a +instance C Int + +newtype Foo = Foo Int + deriving C + diff --git a/testsuite/tests/parser/should_fail/readFail039.stderr b/testsuite/tests/parser/should_fail/readFail039.stderr new file mode 100644 index 0000000000..1c7cb6b975 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail039.stderr @@ -0,0 +1,6 @@ +
+readFail039.hs:8:14:
+ Can't make a derived instance of `C Foo':
+ `C' is not a derivable class
+ Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension
+ In the newtype declaration for `Foo'
diff --git a/testsuite/tests/parser/should_fail/readFail040.hs b/testsuite/tests/parser/should_fail/readFail040.hs new file mode 100644 index 0000000000..5279f166ea --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail040.hs @@ -0,0 +1,9 @@ + +module Foo where + +import Control.Monad.Fix + +z :: Maybe [Int] +z = mdo x <- return (1:x) + return (take 4 x) + diff --git a/testsuite/tests/parser/should_fail/readFail040.stderr b/testsuite/tests/parser/should_fail/readFail040.stderr new file mode 100644 index 0000000000..794899898d --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail040.stderr @@ -0,0 +1,2 @@ + +readFail040.hs:7:11: parse error on input `<-' diff --git a/testsuite/tests/parser/should_fail/readFail041.hs b/testsuite/tests/parser/should_fail/readFail041.hs new file mode 100644 index 0000000000..032e05e816 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail041.hs @@ -0,0 +1,7 @@ + +{-# OPTIONS_GHC -XMultiParamTypeClasses #-} + +module Foo where + +class Foo a b | a -> b + diff --git a/testsuite/tests/parser/should_fail/readFail041.stderr b/testsuite/tests/parser/should_fail/readFail041.stderr new file mode 100644 index 0000000000..fbe49b1153 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail041.stderr @@ -0,0 +1,5 @@ + +readFail041.hs:6:1: + Fundeps in class `Foo' + (Use -XFunctionalDependencies to allow fundeps) + In the class declaration for `Foo' diff --git a/testsuite/tests/parser/should_fail/readFail042.hs b/testsuite/tests/parser/should_fail/readFail042.hs new file mode 100644 index 0000000000..bdd9f97094 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail042.hs @@ -0,0 +1,12 @@ +-- Check error message for transforms if we don't have the right extension turned on
+
+module Foo where
+
+import Data.List
+import GHC.Exts
+
+foo = [ ()
+ | x <- [1..10]
+ , then take 5
+ , then sortWith by x
+ ]
\ No newline at end of file diff --git a/testsuite/tests/parser/should_fail/readFail042.stderr b/testsuite/tests/parser/should_fail/readFail042.stderr new file mode 100644 index 0000000000..8fbb9bf1f7 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail042.stderr @@ -0,0 +1,12 @@ + +readFail042.hs:10:9: + Unexpected transform statement in a list comprehension + Use -XTransformListComp + +readFail042.hs:11:9: + Unexpected transform statement in a list comprehension + Use -XTransformListComp + +readFail042.hs:11:23: Not in scope: `by' + +readFail042.hs:11:26: Not in scope: `x' diff --git a/testsuite/tests/parser/should_fail/readFail043.hs b/testsuite/tests/parser/should_fail/readFail043.hs new file mode 100644 index 0000000000..e6304bea9a --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail043.hs @@ -0,0 +1,14 @@ +-- Check error message for groups if we don't have the right extension turned on
+
+module Foo where
+
+import Data.List
+import GHC.Exts
+
+foo = [ ()
+ | x <- [1..10]
+ , then group by x
+ , then group by x using groupWith
+ , then group using inits
+ ]
+
diff --git a/testsuite/tests/parser/should_fail/readFail043.stderr b/testsuite/tests/parser/should_fail/readFail043.stderr new file mode 100644 index 0000000000..1b2b1abc15 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail043.stderr @@ -0,0 +1,24 @@ + +readFail043.hs:10:9: + Unexpected transform statement in a list comprehension + Use -XTransformListComp + +readFail043.hs:10:20: Not in scope: `by' + +readFail043.hs:10:23: Not in scope: `x' + +readFail043.hs:11:9: + Unexpected transform statement in a list comprehension + Use -XTransformListComp + +readFail043.hs:11:20: Not in scope: `by' + +readFail043.hs:11:23: Not in scope: `x' + +readFail043.hs:11:25: Not in scope: `using' + +readFail043.hs:12:9: + Unexpected transform statement in a list comprehension + Use -XTransformListComp + +readFail043.hs:12:20: Not in scope: `using' diff --git a/testsuite/tests/parser/should_fail/readFail044.hs b/testsuite/tests/parser/should_fail/readFail044.hs new file mode 100644 index 0000000000..2735d3363b --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail044.hs @@ -0,0 +1,9 @@ + +-- We should get an error message, including a location, for these flags: +{-# OPTIONS_GHC -this-flag-does-not-exist -nor-does-this-one #-} + +module Foo where + +foo :: () +foo = () + diff --git a/testsuite/tests/parser/should_fail/readFail044.stderr b/testsuite/tests/parser/should_fail/readFail044.stderr new file mode 100644 index 0000000000..27becac67c --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail044.stderr @@ -0,0 +1,6 @@ + +readFail044.hs:3:16: + unknown flag in {-# OPTIONS_GHC #-} pragma: -this-flag-does-not-exist + +readFail044.hs:3:16: + unknown flag in {-# OPTIONS_GHC #-} pragma: -nor-does-this-one diff --git a/testsuite/tests/parser/should_fail/readFail045.stderr-ghc-7.0 b/testsuite/tests/parser/should_fail/readFail045.stderr-ghc-7.0 new file mode 100644 index 0000000000..3c25e2347c --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail045.stderr-ghc-7.0 @@ -0,0 +1,2 @@ + +readFail045.hs:6:21: parse error on input `.+' diff --git a/testsuite/tests/parser/should_fail/readFail046.hs b/testsuite/tests/parser/should_fail/readFail046.hs new file mode 100644 index 0000000000..9441694dd0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail046.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ExistientialQuantification #-} +-- tests for mis-spelled LANGUAGE pragma error message + +module ShouldFail where diff --git a/testsuite/tests/parser/should_fail/readFail046.stderr b/testsuite/tests/parser/should_fail/readFail046.stderr new file mode 100644 index 0000000000..a303d7798e --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail046.stderr @@ -0,0 +1,4 @@ + +readFail046.hs:1:14: + Unsupported extension: ExistientialQuantification + Perhaps you meant `ExistentialQuantification' or `NoExistentialQuantification' diff --git a/testsuite/tests/parser/should_fail/readFail047.hs b/testsuite/tests/parser/should_fail/readFail047.hs new file mode 100644 index 0000000000..5692e780fd --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail047.hs @@ -0,0 +1,9 @@ + +module ShouldFail where + +foo = let + x = (1, 2 + y = 3 + in + fst x + y + diff --git a/testsuite/tests/parser/should_fail/readFail047.stderr b/testsuite/tests/parser/should_fail/readFail047.stderr new file mode 100644 index 0000000000..53af11cf0c --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail047.stderr @@ -0,0 +1,2 @@ + +readFail047.hs:6:5: parse error (possibly incorrect indentation) diff --git a/testsuite/tests/parser/should_run/Makefile b/testsuite/tests/parser/should_run/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/parser/should_run/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/parser/should_run/T1344.hs b/testsuite/tests/parser/should_run/T1344.hs new file mode 100644 index 0000000000..cba7f3fdf6 --- /dev/null +++ b/testsuite/tests/parser/should_run/T1344.hs @@ -0,0 +1,10 @@ +-- Just new test. This would work without the bug being fixed. + +a = '\x10ffff' +b = "Hello\x000000002c\32World\o00000000000000000000000000000000041" +c = "♯\00\&00\0" + +main = do print a + putStrLn b + print c + diff --git a/testsuite/tests/parser/should_run/T1344.stdout b/testsuite/tests/parser/should_run/T1344.stdout new file mode 100644 index 0000000000..a83f165d74 --- /dev/null +++ b/testsuite/tests/parser/should_run/T1344.stdout @@ -0,0 +1,3 @@ +'\1114111' +Hello, World! +"\9839\NUL00\NUL" diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T new file mode 100644 index 0000000000..17d6bc0199 --- /dev/null +++ b/testsuite/tests/parser/should_run/all.T @@ -0,0 +1,7 @@ +test('readRun001', normal, compile_and_run, ['']) +test('readRun002', normal, compile_and_run, ['']) +test('readRun003', normal, compile_and_run, ['']) +test('readRun004', expect_broken_for(1257, ['ghci']), compile_and_run, ['']) +test('T1344', normal, compile_and_run, ['']) +test('operator', normal, compile_and_run, ['']) +test('operator2', normal, compile_and_run, ['']) diff --git a/testsuite/tests/parser/should_run/operator.hs b/testsuite/tests/parser/should_run/operator.hs new file mode 100644 index 0000000000..5a7bcf9e97 --- /dev/null +++ b/testsuite/tests/parser/should_run/operator.hs @@ -0,0 +1,23 @@ +module Main where + +data Hash = Hash { (#) :: Int } + deriving (Show,Read) + +main = do + let h = Hash 3 + s = show h + x = read s :: Hash + y = show x + print h + putStrLn s + print x + putStrLn y + let h' = Hash { (#) = 3 } + s' = show h' + x' = read s' :: Hash + y' = show x' + print h' + putStrLn s' + print x' + putStrLn y' + diff --git a/testsuite/tests/parser/should_run/operator.stdout b/testsuite/tests/parser/should_run/operator.stdout new file mode 100644 index 0000000000..b56f190ce6 --- /dev/null +++ b/testsuite/tests/parser/should_run/operator.stdout @@ -0,0 +1,8 @@ +Hash {(#) = 3} +Hash {(#) = 3} +Hash {(#) = 3} +Hash {(#) = 3} +Hash {(#) = 3} +Hash {(#) = 3} +Hash {(#) = 3} +Hash {(#) = 3} diff --git a/testsuite/tests/parser/should_run/operator2.hs b/testsuite/tests/parser/should_run/operator2.hs new file mode 100644 index 0000000000..f38ebc3bc8 --- /dev/null +++ b/testsuite/tests/parser/should_run/operator2.hs @@ -0,0 +1,7 @@ + +(|..) :: a -> a -> a +x |.. y = y + +f = [2|..3] + +main = putStrLn (show f) diff --git a/testsuite/tests/parser/should_run/operator2.stdout b/testsuite/tests/parser/should_run/operator2.stdout new file mode 100644 index 0000000000..048026337a --- /dev/null +++ b/testsuite/tests/parser/should_run/operator2.stdout @@ -0,0 +1 @@ +[3] diff --git a/testsuite/tests/parser/should_run/readRun001.hs b/testsuite/tests/parser/should_run/readRun001.hs new file mode 100644 index 0000000000..d80f2adb7c --- /dev/null +++ b/testsuite/tests/parser/should_run/readRun001.hs @@ -0,0 +1,57 @@ +-- !!! Haskell-98 prefix negate operator + +-- Make sure the parsing is actually the correct +-- one by running this after it's compiled. + +negatedExpression = - (3 + 4) + +negatedTightlyBinding = -3^4 + +negatedNonSection = (- 3) + +negatedNonSectionWithHighPrecedenceOp = + let { f = (+); infix 9 `f` } in ( -3 `f` 4 ) + +negatedNonSectionWithLowPrecedenceOp = + let { f = (+); infix 1 `f` } in ( -3 `f` 4 ) + +negatedRightHandSide = +-- This is actually not legal syntax: 3 * - 4 +-- However, lower-precedence binary ops work. +-- (see H98 syntax for exp, or imagine it's because it +-- would parse differently as 3 * 0 - 4) + let { f = (+); infix 1 `f` } in ( 3 `f` - 4 ) + + +subtractionNotNegation = 3 -4 + +negativePattern = + case -3 of { (- 3) -> + case -4 of { - 4 -> + True } } +-- not legal H98 syntax: case -4 of { _x @ -4 -> +-- (parentheses needed) case -5 of { ~ -5 -> + +subtractionNotNegationPattern = + -- defines infix '-' (shadowing Prelude definition) + let { 3 -4 = True } in (3 - 4) + +precedenceOfNegationCantBeChanged = + let { (-) = undefined; infix 9 - } in (- 3 * 4) + +negationCantBeQualified = + (Prelude.-3) 4 + +main = do + print negatedExpression + print negatedTightlyBinding + print negatedNonSection + print negatedNonSectionWithHighPrecedenceOp + print negatedNonSectionWithLowPrecedenceOp + print negatedRightHandSide + print subtractionNotNegation + print negativePattern + print subtractionNotNegationPattern + print precedenceOfNegationCantBeChanged + print negationCantBeQualified + diff --git a/testsuite/tests/parser/should_run/readRun001.stdout b/testsuite/tests/parser/should_run/readRun001.stdout new file mode 100644 index 0000000000..08d7d27203 --- /dev/null +++ b/testsuite/tests/parser/should_run/readRun001.stdout @@ -0,0 +1,11 @@ +-7 +-81 +-3 +-7 +1 +-1 +-1 +True +True +-12 +1 diff --git a/testsuite/tests/parser/should_run/readRun002.hs b/testsuite/tests/parser/should_run/readRun002.hs new file mode 100644 index 0000000000..58ba8861ab --- /dev/null +++ b/testsuite/tests/parser/should_run/readRun002.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE MagicHash #-} +-- !!! Negative unboxed literals, part 1 +-- They don't have to be as standards-compliant +-- or follow so many weird cases as the normal +-- boxed version. In particular, normal unboxed +-- subtraction is -#, `minusFloat#`, -##, `minusInteger#` +-- and unboxed negation is negate{Int,Float,Double}# +-- . (-) and negate are kind errors. So we will +-- assume that we don't need to parse infix (-) nicely +-- when unboxed numbers are involved (even though someone +-- "could" hide the Prelude's version and define (-) themself). +-- Also we won't care here whether having a space (- 3#) works. + +-- Make sure the parsing is actually the correct +-- one by running this after it's compiled. + +import GHC.Exts + +--is floating-point consistently safe to test like this, +--if we stick to integral values? +main = do + --These work with any ghc + print (I# (negateInt# (-3# -# -4#))) + print (F# (negateFloat# (-3.0# `minusFloat#` -4.0#))) + print (D# (negateDouble# (-3.0## -## -4.0##))) + print (I# (-3# ^# 4#)) --different from (boxed) Haskell98 (-3 ^ 4) + print ( case -1# of { -1# -> True } ) + print ( case 1# of { -1# -> True; _ -> False } ) + print ( case -0# of { 0# -> True } ) + +infixr 8 ^# --just like ^, binds tighter than - (which is infixl 6) +( ^# ) :: Int# -> Int# -> Int# +base ^# 0# = 1# +base ^# exponent = base *# (base ^# ( exponent -# 1# )) + diff --git a/testsuite/tests/parser/should_run/readRun002.stdout b/testsuite/tests/parser/should_run/readRun002.stdout new file mode 100644 index 0000000000..fc761860c4 --- /dev/null +++ b/testsuite/tests/parser/should_run/readRun002.stdout @@ -0,0 +1,7 @@ +-1 +-1.0 +-1.0 +81 +True +False +True diff --git a/testsuite/tests/parser/should_run/readRun003.hs b/testsuite/tests/parser/should_run/readRun003.hs new file mode 100644 index 0000000000..578e2d18db --- /dev/null +++ b/testsuite/tests/parser/should_run/readRun003.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +-- !!! Negative unboxed literals, part 2 + +import GHC.Exts + +main = do + --Newly implemented: don't parse this as subtraction (Prelude.-): + print (I# (negateInt# -3#)) + print (F# (negateFloat# -3.0#)) + print (D# (negateDouble# -3.0##)) + --nor this as let (-) f 1# = ... + print (let { f -1# = True } in f (-1#)) + diff --git a/testsuite/tests/parser/should_run/readRun003.stdout b/testsuite/tests/parser/should_run/readRun003.stdout new file mode 100644 index 0000000000..5953eb3a28 --- /dev/null +++ b/testsuite/tests/parser/should_run/readRun003.stdout @@ -0,0 +1,4 @@ +3 +3.0 +3.0 +True diff --git a/testsuite/tests/parser/should_run/readRun004.hs b/testsuite/tests/parser/should_run/readRun004.hs new file mode 100644 index 0000000000..5e6545adb1 --- /dev/null +++ b/testsuite/tests/parser/should_run/readRun004.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE UnboxedTuples, MagicHash #-} + +-- should_run to make sure linking succeeds +-- (curried unboxed tuples with both boxed +-- and unboxed components). +-- See Trac #1509; also Note [Primop wrappers] in Id.lhs + +import GHC.Exts + +main = do + case curried 9.0## 't'# of + (# i#, u@(), d1#, c1#, f#, w#, d2#, c2# #) + -> print ( I# i#, u, D# d1#, C# c1#, F# f#, W# w#, D# d2#, C# c2# ) + print $ map_ ((#,#) True) ['a','b','c'] + +-- try NOINLINE to make sure the currying isn't eliminated +-- too soon, but also test the other one without NOINLINE +-- for variety of testing +{-# NOINLINE curried #-} +curried :: Double# -> Char# -> + (# Int#, (), Double#, Char#, Float#, Word#, Double#, Char# #) +curried = (#,,,,,,,#) 3# () 4.0## 'f'# 5.0# 32## + +map_ :: (a -> (# b, c #)) -> [a] -> [(b,c)] +map_ f [] = [] +map_ f (a:as) = case f a of + (# b, c #) -> (b, c) : map_ f as + diff --git a/testsuite/tests/parser/should_run/readRun004.stdout b/testsuite/tests/parser/should_run/readRun004.stdout new file mode 100644 index 0000000000..9c27fdf9d5 --- /dev/null +++ b/testsuite/tests/parser/should_run/readRun004.stdout @@ -0,0 +1,2 @@ +(3,(),4.0,'f',5.0,32,9.0,'t') +[(True,'a'),(True,'b'),(True,'c')] diff --git a/testsuite/tests/parser/unicode/1103.hs b/testsuite/tests/parser/unicode/1103.hs new file mode 100644 index 0000000000..6d10064056 --- /dev/null +++ b/testsuite/tests/parser/unicode/1103.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE UnicodeSyntax #-} +{- + Three kinds of Unicode tests for our purposes. +-} + +module UniTest where + +-- Non working Japanese Unicode test. + +てすと3 ∷ IO () +てすと3 = do + putStrLn $ show 人間虫 where + 人間虫 = "humasect" diff --git a/testsuite/tests/parser/unicode/1744.hs b/testsuite/tests/parser/unicode/1744.hs new file mode 100644 index 0000000000..90273741da --- /dev/null +++ b/testsuite/tests/parser/unicode/1744.hs @@ -0,0 +1,3 @@ +main = print hello
+-- test that layout has not been screwed up
+hello = "こんにちは 世界"
diff --git a/testsuite/tests/parser/unicode/1744.stdout b/testsuite/tests/parser/unicode/1744.stdout new file mode 100644 index 0000000000..f127f8d21d --- /dev/null +++ b/testsuite/tests/parser/unicode/1744.stdout @@ -0,0 +1 @@ +"\12371\12435\12395\12385\12399 \19990\30028" diff --git a/testsuite/tests/parser/unicode/2302.hs b/testsuite/tests/parser/unicode/2302.hs new file mode 100644 index 0000000000..c40c704cc3 --- /dev/null +++ b/testsuite/tests/parser/unicode/2302.hs @@ -0,0 +1 @@ +f = À diff --git a/testsuite/tests/parser/unicode/2302.stderr b/testsuite/tests/parser/unicode/2302.stderr new file mode 100644 index 0000000000..608c9ef0bd --- /dev/null +++ b/testsuite/tests/parser/unicode/2302.stderr @@ -0,0 +1,2 @@ + +2302.hs:1:5: Not in scope: data constructor `À' diff --git a/testsuite/tests/parser/unicode/4373.hs b/testsuite/tests/parser/unicode/4373.hs new file mode 100644 index 0000000000..a753432a41 --- /dev/null +++ b/testsuite/tests/parser/unicode/4373.hs @@ -0,0 +1,3 @@ +module ShouldCompile where + +test = let v₂ = (+) in v₂ 1 3 diff --git a/testsuite/tests/parser/unicode/Makefile b/testsuite/tests/parser/unicode/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/parser/unicode/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/parser/unicode/all.T b/testsuite/tests/parser/unicode/all.T new file mode 100644 index 0000000000..e5375a361e --- /dev/null +++ b/testsuite/tests/parser/unicode/all.T @@ -0,0 +1,22 @@ +# test that we catch UTF-8 decoding errors + +test('utf8_002', normal, compile_fail, ['']) +test('utf8_003', normal, compile_fail, ['']) +test('utf8_004', normal, compile_fail, ['']) +test('utf8_005', normal, compile_fail, ['']) + +test('utf8_010', normal, compile_fail, ['']) +test('utf8_011', normal, compile_fail, ['']) + +test('utf8_020', normal, compile_fail, ['']) +test('utf8_021', normal, compile_fail, ['']) +test('utf8_022', normal, compile_fail, ['']) + +# test that we can understand unicode characters in lexemes + +test('utf8_024', normal, compile_and_run, ['']) + +test('1744', normal, compile_and_run, ['']) +test('1103', normal, compile, ['']) +test('2302', only_ways(['normal']), compile_fail, ['']) +test('4373', normal, compile, ['']) diff --git a/testsuite/tests/parser/unicode/utf8_001.hs b/testsuite/tests/parser/unicode/utf8_001.hs new file mode 100644 index 0000000000..371e89e1fa --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_001.hs @@ -0,0 +1,2 @@ +-- 0x80 is an invalid character +bad = '' diff --git a/testsuite/tests/parser/unicode/utf8_001.stderr b/testsuite/tests/parser/unicode/utf8_001.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_001.stderr diff --git a/testsuite/tests/parser/unicode/utf8_002.hs b/testsuite/tests/parser/unicode/utf8_002.hs new file mode 100644 index 0000000000..589da832f2 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_002.hs @@ -0,0 +1,2 @@ +-- buffer ends in 0xC0 +
\ No newline at end of file diff --git a/testsuite/tests/parser/unicode/utf8_002.stderr b/testsuite/tests/parser/unicode/utf8_002.stderr new file mode 100644 index 0000000000..d8083f0c89 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_002.stderr @@ -0,0 +1,2 @@ + +utf8_002.hs:2:1: lexical error (UTF-8 decoding error) diff --git a/testsuite/tests/parser/unicode/utf8_003.hs b/testsuite/tests/parser/unicode/utf8_003.hs new file mode 100644 index 0000000000..bd8e2f552c --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_003.hs @@ -0,0 +1,2 @@ +-- buffer ends in 0xD0 +
\ No newline at end of file diff --git a/testsuite/tests/parser/unicode/utf8_003.stderr b/testsuite/tests/parser/unicode/utf8_003.stderr new file mode 100644 index 0000000000..be433d9141 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_003.stderr @@ -0,0 +1,2 @@ + +utf8_003.hs:2:1: lexical error (UTF-8 decoding error) diff --git a/testsuite/tests/parser/unicode/utf8_004.hs b/testsuite/tests/parser/unicode/utf8_004.hs new file mode 100644 index 0000000000..6a1a839246 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_004.hs @@ -0,0 +1,2 @@ +-- buffer ends in 0xE0 +
\ No newline at end of file diff --git a/testsuite/tests/parser/unicode/utf8_004.stderr b/testsuite/tests/parser/unicode/utf8_004.stderr new file mode 100644 index 0000000000..aff8256549 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_004.stderr @@ -0,0 +1,2 @@ + +utf8_004.hs:2:1: lexical error (UTF-8 decoding error) diff --git a/testsuite/tests/parser/unicode/utf8_005.hs b/testsuite/tests/parser/unicode/utf8_005.hs new file mode 100644 index 0000000000..e88fec5a4f --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_005.hs @@ -0,0 +1,2 @@ +-- buffer ends in 0xF0 +
\ No newline at end of file diff --git a/testsuite/tests/parser/unicode/utf8_005.stderr b/testsuite/tests/parser/unicode/utf8_005.stderr new file mode 100644 index 0000000000..3d551bae44 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_005.stderr @@ -0,0 +1,2 @@ + +utf8_005.hs:2:1: lexical error (UTF-8 decoding error) diff --git a/testsuite/tests/parser/unicode/utf8_010.hs b/testsuite/tests/parser/unicode/utf8_010.hs new file mode 100644 index 0000000000..371e89e1fa --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_010.hs @@ -0,0 +1,2 @@ +-- 0x80 is an invalid character +bad = '' diff --git a/testsuite/tests/parser/unicode/utf8_010.stderr b/testsuite/tests/parser/unicode/utf8_010.stderr new file mode 100644 index 0000000000..a2bb9b52e2 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_010.stderr @@ -0,0 +1,3 @@ + +utf8_010.hs:2:8: + lexical error in string/character literal (UTF-8 decoding error) diff --git a/testsuite/tests/parser/unicode/utf8_011.hs b/testsuite/tests/parser/unicode/utf8_011.hs new file mode 100644 index 0000000000..5700e1db45 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_011.hs @@ -0,0 +1,2 @@ +-- 0xbf is an invalid character +bad = '' diff --git a/testsuite/tests/parser/unicode/utf8_011.stderr b/testsuite/tests/parser/unicode/utf8_011.stderr new file mode 100644 index 0000000000..0b34980303 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_011.stderr @@ -0,0 +1,3 @@ + +utf8_011.hs:2:8: + lexical error in string/character literal (UTF-8 decoding error) diff --git a/testsuite/tests/parser/unicode/utf8_020.hs b/testsuite/tests/parser/unicode/utf8_020.hs new file mode 100644 index 0000000000..eaefe622fa --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_020.hs @@ -0,0 +1,2 @@ +-- A start sequence byte (0xC0) followed by an invalid continuation: +bad = "." diff --git a/testsuite/tests/parser/unicode/utf8_020.stderr b/testsuite/tests/parser/unicode/utf8_020.stderr new file mode 100644 index 0000000000..7254106142 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_020.stderr @@ -0,0 +1,3 @@ + +utf8_020.hs:2:8: + lexical error in string/character literal (UTF-8 decoding error) diff --git a/testsuite/tests/parser/unicode/utf8_021.hs b/testsuite/tests/parser/unicode/utf8_021.hs new file mode 100644 index 0000000000..639e0bfc63 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_021.hs @@ -0,0 +1,2 @@ +-- A start sequence byte (0xE0) followed by an invalid continuation: +bad = "." diff --git a/testsuite/tests/parser/unicode/utf8_021.stderr b/testsuite/tests/parser/unicode/utf8_021.stderr new file mode 100644 index 0000000000..2867239846 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_021.stderr @@ -0,0 +1,3 @@ + +utf8_021.hs:2:8: + lexical error in string/character literal (UTF-8 decoding error) diff --git a/testsuite/tests/parser/unicode/utf8_022.hs b/testsuite/tests/parser/unicode/utf8_022.hs new file mode 100644 index 0000000000..6484a03c40 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_022.hs @@ -0,0 +1,2 @@ +-- A start sequence byte (0xE0) followed by an invalid continuation: +bad = "." diff --git a/testsuite/tests/parser/unicode/utf8_022.stderr b/testsuite/tests/parser/unicode/utf8_022.stderr new file mode 100644 index 0000000000..3f84d06de2 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_022.stderr @@ -0,0 +1,3 @@ + +utf8_022.hs:2:8: + lexical error in string/character literal (UTF-8 decoding error) diff --git a/testsuite/tests/parser/unicode/utf8_023.hs b/testsuite/tests/parser/unicode/utf8_023.hs new file mode 100644 index 0000000000..255d48b741 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_023.hs @@ -0,0 +1,2 @@ +-- some incomplete sequences concatenated +bad = "" diff --git a/testsuite/tests/parser/unicode/utf8_023.stderr b/testsuite/tests/parser/unicode/utf8_023.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_023.stderr diff --git a/testsuite/tests/parser/unicode/utf8_024.hs b/testsuite/tests/parser/unicode/utf8_024.hs new file mode 100644 index 0000000000..1e491f75ec --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_024.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE ExplicitForAll, UnicodeSyntax #-} +{- +Test for valid unicode identifiers + +*** This file is UTF-8 encoded. + +*** BE CAREFUL WHEN EDITING THIS FILE WITH EMACS. Emacs' UTF-8 engine + has several times got the encoding wrong for me and inserted bogus + bytes, especially in the 4-byte characters. Edit the file literally + (M-x find-file-literally). By all means view it in Emacs' UTF-8 + mode (C-x RET c utf-8, C-x f unicode001.hs), but don't edit and save. + +Here's a selection of characters I pulled from UnicodeData.txt that we +can use to test with: + +-- upper/lower case letters +À LATIN CAPITAL LETTER A WITH GRAVE;Lu;0;L;0041 0300;;;;N;LATIN CAPITAL LETTER A GRAVE;;;00E0; +à LATIN SMALL LETTER A WITH GRAVE;Ll;0;L;0061 0300;;;;N;LATIN SMALL LETTER A GRAVE;;00C0;;00C0 + +Α GREEK CAPITAL LETTER ALPHA;Lu;0;L;;;;;N;;;;03B1; +α GREEK SMALL LETTER ALPHA;Ll;0;L;;;;;N;;;0391;;0391 +α GREEK SMALL LETTER ALPHA;Ll;0;L;;;;;N;;;0391;;0391 +β GREEK SMALL LETTER BETA;Ll;0;L;;;;;N;;;0392;;0392 +γ GREEK SMALL LETTER GAMMA;Ll;0;L;;;;;N;;;0393;;0393 +δ GREEK SMALL LETTER DELTA;Ll;0;L;;;;;N;;;0394;;0394 + +Ⴀ GEORGIAN CAPITAL LETTER AN;Lu;0;L;;;;;N;;Khutsuri;;; +ა GEORGIAN LETTER AN;Lo;0;L;;;;;N;GEORGIAN SMALL LETTER AN;;;; + +Ϣ COPTIC CAPITAL LETTER SHEI;Lu;0;L;;;;;N;GREEK CAPITAL LETTER SHEI;;;03E3; +ϣ COPTIC SMALL LETTER SHEI;Ll;0;L;;;;;N;GREEK SMALL LETTER SHEI;;03E2;;03E2 + +А CYRILLIC CAPITAL LETTER A;Lu;0;L;;;;;N;;;;0430; +а CYRILLIC SMALL LETTER A;Ll;0;L;;;;;N;;;0410;;0410 + +Ա ARMENIAN CAPITAL LETTER AYB;Lu;0;L;;;;;N;;;;0561; +ա ARMENIAN SMALL LETTER AYB;Ll;0;L;;;;;N;;;0531;;0531 + +𝐴 MATHEMATICAL ITALIC CAPITAL A;Lu;0;L;<font> 0041;;;;N;;;;; +𝑎 MATHEMATICAL ITALIC SMALL A;Ll;0;L;<font> 0061;;;;N;;;;; + +𝔸 MATHEMATICAL DOUBLE-STRUCK CAPITAL A;Lu;0;L;<font> 0041;;;;N;;;;; +𝕒 MATHEMATICAL DOUBLE-STRUCK SMALL A;Ll;0;L;<font> 0061;;;;N;;;;; + +-- title case letters +Dž LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON;Lt;0;L;<compat> 0044 017E;;;;N;LATIN LETTER CAPITAL D SMALL Z HACEK;;01C4;01C6;01C5 +Lj LATIN CAPITAL LETTER L WITH SMALL LETTER J;Lt;0;L;<compat> 004C 006A;;;;N;LATIN LETTER CAPITAL L SMALL J;;01C7;01C9;01C8 + +-- small caps +ᴀ LATIN LETTER SMALL CAPITAL A;Ll;0;L;;;;;N;;;;; +ᴦ GREEK LETTER SMALL CAPITAL GAMMA;Ll;0;L;;;;;N;;;;; + +-- caseless letters +ଅ ;ORIYA LETTER A;Lo;0;L;;;;;N;;;;; +அ TAMIL LETTER A;Lo;0;L;;;;;N;;;;; +అ TELUGU LETTER A;Lo;0;L;;;;;N;;;;; +ಅ KANNADA LETTER A;Lo;0;L;;;;;N;;;;; +അ MALAYALAM LETTER A;Lo;0;L;;;;;N;;;;; +අ SINHALA LETTER AYANNA;Lo;0;L;;;;;N;;;;; +ก THAI CHARACTER KO KAI;Lo;0;L;;;;;N;THAI LETTER KO KAI;;;; +ກ LAO LETTER KO;Lo;0;L;;;;;N;;;;; +ཀ TIBETAN LETTER KA;Lo;0;L;;;;;N;;;;; +က MYANMAR LETTER KA;Lo;0;L;;;;;N;;;;; +ᄀ HANGUL CHOSEONG KIYEOK;Lo;0;L;;;;;N;;g *;;; +ሀ ETHIOPIC SYLLABLE HA;Lo;0;L;;;;;N;;;;; +Ꭰ CHEROKEE LETTER A;Lo;0;L;;;;;N;;;;; +ᐁ CANADIAN SYLLABICS E;Lo;0;L;;;;;N;;;;; +ᚁ OGHAM LETTER BEITH;Lo;0;L;;;;;N;;;;; +ᚠ RUNIC LETTER FEHU FEOH FE F;Lo;0;L;;;;;N;;;;; +ᜀ TAGALOG LETTER A;Lo;0;L;;;;;N;;;;; +ᜠ HANUNOO LETTER A;Lo;0;L;;;;;N;;;;; +ᝀ BUHID LETTER A;Lo;0;L;;;;;N;;;;; +ᝠ TAGBANWA LETTER A;Lo;0;L;;;;;N;;;;; +ក KHMER LETTER KA;Lo;0;L;;;;;N;;;;; +ᠠ MONGOLIAN LETTER A;Lo;0;L;;;;;N;;;;; +ᤁ LIMBU LETTER KA;Lo;0;L;;;;;N;;;;; +ᥐ TAI LE LETTER KA;Lo;0;L;;;;;N;;;;; +ぁ HIRAGANA LETTER SMALL A;Lo;0;L;;;;;N;;;;; +ア KATAKANA LETTER A;Lo;0;L;;;;;N;;;;; +ㄅ BOPOMOFO LETTER B;Lo;0;L;;;;;N;;;;; +ㄱ HANGUL LETTER KIYEOK;Lo;0;L;<compat> 1100;;;;N;HANGUL LETTER GIYEOG;;;; +ㆠ BOPOMOFO LETTER BU;Lo;0;L;;;;;N;;;;; +ꀀ YI SYLLABLE IT;Lo;0;L;;;;;N;;;;; + +-- spaces + NO-BREAK SPACE;Zs;0;CS;<noBreak> 0020;;;;N;NON-BREAKING SPACE;;;; + EN QUAD;Zs;0;WS;2002;;;;N;;;;; + EN SPACE;Zs;0;WS;<compat> 0020;;;;N;;;;; + THIN SPACE;Zs;0;WS;<compat> 0020;;;;N;;;;; + ZERO WIDTH SPACE;Zs;0;BN;;;;;N;;;;; + +-- some symbols we might find useful in Haskell +← LEFTWARDS ARROW;Sm;0;ON;;;;;N;LEFT ARROW;;;; +→ RIGHTWARDS ARROW;Sm;0;ON;;;;;N;RIGHT ARROW;;;; +‖ DOUBLE VERTICAL LINE;Po;0;ON;;;;;N;DOUBLE VERTICAL BAR;;;; +∀ FOR ALL;Sm;0;ON;;;;;N;;;;; +∁ COMPLEMENT;Sm;0;ON;;;;;Y;;;;; +∃ THERE EXISTS;Sm;0;ON;;;;;Y;;;;; +∄ THERE DOES NOT EXIST;Sm;0;ON;2203 0338;;;;Y;;;;; +∅ EMPTY SET;Sm;0;ON;;;;;N;;;;; +∆ INCREMENT;Sm;0;ON;;;;;N;;;;; +∇ NABLA;Sm;0;ON;;;;;N;;;;; +∈ ELEMENT OF;Sm;0;ON;;;;;Y;;;;; +∉ NOT AN ELEMENT OF;Sm;0;ON;2208 0338;;;;Y;;;;; +∏ N-ARY PRODUCT;Sm;0;ON;;;;;N;;;;; +∑ N-ARY SUMMATION;Sm;0;ON;;;;;Y;;;;; +− MINUS SIGN;Sm;0;ET;;;;;N;;;;; +∓ MINUS-OR-PLUS SIGN;Sm;0;ET;;;;;N;;;;; +∕ DIVISION SLASH;Sm;0;ON;;;;;Y;;;;; +∘ RING OPERATOR;Sm;0;ON;;;;;N;;;;; +∙ BULLET OPERATOR;Sm;0;ON;;;;;N;;;;; +√ SQUARE ROOT;Sm;0;ON;;;;;Y;;;;; +∧ LOGICAL AND;Sm;0;ON;;;;;N;;;;; +∨ LOGICAL OR;Sm;0;ON;;;;;N;;;;; +∩ INTERSECTION;Sm;0;ON;;;;;N;;;;; +∪ UNION;Sm;0;ON;;;;;N;;;;; +≃ ASYMPTOTICALLY EQUAL TO;Sm;0;ON;;;;;Y;;;;; +≈ ALMOST EQUAL TO;Sm;0;ON;;;;;Y;;;;; +≠ NOT EQUAL TO;Sm;0;ON;003D 0338;;;;Y;;;;; +≙ ESTIMATES;Sm;0;ON;;;;;N;;;;; +≤ LESS-THAN OR EQUAL TO;Sm;0;ON;;;;;Y;LESS THAN OR EQUAL TO;;;; +≥ GREATER-THAN OR EQUAL TO;Sm;0;ON;;;;;Y;GREATER THAN OR EQUAL TO;;;; +≪ MUCH LESS-THAN;Sm;0;ON;;;;;Y;MUCH LESS THAN;;;; +≫ MUCH GREATER-THAN;Sm;0;ON;;;;;Y;MUCH GREATER THAN;;;; +⊂ SUBSET OF;Sm;0;ON;;;;;Y;;;;; +⊃ SUPERSET OF;Sm;0;ON;;;;;Y;;;;; +⊄ NOT A SUBSET OF;Sm;0;ON;2282 0338;;;;Y;;;;; +⊅ NOT A SUPERSET OF;Sm;0;ON;2283 0338;;;;Y;;;;; +⊆ SUBSET OF OR EQUAL TO;Sm;0;ON;;;;;Y;;;;; +⊇ SUPERSET OF OR EQUAL TO;Sm;0;ON;;;;;Y;;;;; +⊕ CIRCLED PLUS;Sm;0;ON;;;;;N;;;;; +⊖ CIRCLED MINUS;Sm;0;ON;;;;;N;;;;; +⊗ CIRCLED TIMES;Sm;0;ON;;;;;N;;;;; +⊘ CIRCLED DIVISION SLASH;Sm;0;ON;;;;;Y;;;;; +⊙ CIRCLED DOT OPERATOR;Sm;0;ON;;;;;N;;;;; +⊢ RIGHT TACK;Sm;0;ON;;;;;Y;;;;; +⊣ LEFT TACK;Sm;0;ON;;;;;Y;;;;; +⊤ DOWN TACK;Sm;0;ON;;;;;N;;;;; +⊥ UP TACK;Sm;0;ON;;;;;N;;;;; +⊦ ASSERTION;Sm;0;ON;;;;;Y;;;;; +⊧ MODELS;Sm;0;ON;;;;;Y;;;;; +⊨ TRUE;Sm;0;ON;;;;;Y;;;;; +⋂ N-ARY INTERSECTION;Sm;0;ON;;;;;N;;;;; +⋃ N-ARY UNION;Sm;0;ON;;;;;N;;;;; +⋅ DOT OPERATOR;Sm;0;ON;;;;;N;;;;; +⋯ MIDLINE HORIZONTAL ELLIPSIS;Sm;0;ON;;;;;N;;;;; +〈 LEFT-POINTING ANGLE BRACKET;Ps;0;ON;3008;;;;Y;BRA;;;; +〉 RIGHT-POINTING ANGLE BRACKET;Pe;0;ON;3009;;;;Y;KET;;;; +☹ WHITE FROWNING FACE;So;0;ON;;;;;N;;;;; +☺ WHITE SMILING FACE;So;0;ON;;;;;N;;;;; +⧺ DOUBLE PLUS;Sm;0;ON;;;;;N;;;;; + +-- other random symbols +☣ BIOHAZARD SIGN;So;0;ON;;;;;N;;;;; +𝄬 MUSICAL SYMBOL FLAT UP;So;0;L;;;;;N;;;;; +𝌋 TETRAGRAM FOR CONTRARIETY;So;0;ON;;;;;N;;;;; + +-- braille +⡍ ;BRAILLE PATTERN DOTS-1347;So;0;ON;;;;;N;;;;; +⣿ ;BRAILLE PATTERN DOTS-12345678;So;0;ON;;;;;N;;;;; + +-- numbers +Ⅰ ;ROMAN NUMERAL ONE;Nl;0;L;<compat> 0049;;;1;N;;;;2170; +Ⅼ ;ROMAN NUMERAL FIFTY;Nl;0;L;<compat> 004C;;;50;N;;;;217C; +① ;CIRCLED DIGIT ONE;No;0;EN;<circle> 0031;;1;1;N;;;;; +⑴ ;PARENTHESIZED DIGIT ONE;No;0;EN;<compat> 0028 0031 0029;;1;1;N;;;;; +⒈ ;DIGIT ONE FULL STOP;No;0;EN;<compat> 0031 002E;;1;1;N;DIGIT ONE PERIOD;;;; +-} + +module Main where + +-- Test upper-case recognition: +data T + = À -- latin + | Α -- greek + | Ⴀ -- georgian + | Ϣ -- coptic + | А -- cyrillic + | Ա -- armenian + | 𝐴 -- maths italic + | 𝔸 -- maths double-struck + | Dž -- title case latin + +-- Test lower-case recognition: +à α ϣ а ա 𝑎 𝕒 ᴀ ᴦ = undefined + +-- Caseless characters in a string: +string = "ଅஅఅಅഅඅกກཀကᄀሀᎠᐁᚁᚠᜀᜠᝀᝠកᠠᤁᥐぁアㄅㄱㆠ" -- 29 chars + +-- composition using a ring, greek type variables, and right arrows +(∘) :: ∀ α β γ . (β → γ) → (α → β) → (α → γ) +(f ∘ g) x = f (g x) + +main = print ∘ length $ string diff --git a/testsuite/tests/parser/unicode/utf8_024.stdout b/testsuite/tests/parser/unicode/utf8_024.stdout new file mode 100644 index 0000000000..f04c001f3f --- /dev/null +++ b/testsuite/tests/parser/unicode/utf8_024.stdout @@ -0,0 +1 @@ +29 |