diff options
Diffstat (limited to 'testsuite/tests/parser/should_fail')
51 files changed, 301 insertions, 40 deletions
diff --git a/testsuite/tests/parser/should_fail/InfixAppPatErr.hs b/testsuite/tests/parser/should_fail/InfixAppPatErr.hs new file mode 100644 index 0000000000..5a56f711eb --- /dev/null +++ b/testsuite/tests/parser/should_fail/InfixAppPatErr.hs @@ -0,0 +1,5 @@ +main = do + f $ do + a <- return 3 + c <- do + return 5 diff --git a/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr b/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr new file mode 100644 index 0000000000..69839e3920 --- /dev/null +++ b/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr @@ -0,0 +1,4 @@ + +InfixAppPatErr.hs:2:3: error: + Parse error in pattern: f $ do a <- return 3 c + Possibly caused by a missing 'do'? diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.hs b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.hs new file mode 100644 index 0000000000..6c791b0f95 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.hs @@ -0,0 +1,7 @@ +module NoBlockArgumentsFail where + +import Control.Monad + +foo :: IO () +foo = when True do + return () diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.stderr b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.stderr new file mode 100644 index 0000000000..813271bdb9 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.stderr @@ -0,0 +1,6 @@ + +NoBlockArgumentsFail.hs:6:17: error: + Unexpected do block in function application: + do return () + You could write it with parentheses + Or perhaps you meant to enable BlockArguments? diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.hs b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.hs new file mode 100644 index 0000000000..752df24081 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.hs @@ -0,0 +1,6 @@ +module NoBlockArgumentsFail2 where + +import Control.Monad + +foo :: IO () +foo = forM [1 .. 10] \x -> print x diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.stderr b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.stderr new file mode 100644 index 0000000000..0361369774 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.stderr @@ -0,0 +1,6 @@ + +NoBlockArgumentsFail2.hs:6:22: error: + Unexpected lambda expression in function application: + \ x -> print x + You could write it with parentheses + Or perhaps you meant to enable BlockArguments? diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.hs b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.hs new file mode 100644 index 0000000000..91bd6e5dec --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE LambdaCase #-} +module NoBlockArgumentsFail3 where + +import Control.Monad + +foo :: IO () +foo = forM [1 .. 10] \case + Just 3 -> print x diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.stderr b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.stderr new file mode 100644 index 0000000000..e285e6ea72 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.stderr @@ -0,0 +1,6 @@ + +NoBlockArgumentsFail3.hs:7:22: error: + Unexpected lambda-case expression in function application: + \case Just 3 -> print x + You could write it with parentheses + Or perhaps you meant to enable BlockArguments? diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores0.hs b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.hs new file mode 100644 index 0000000000..5e6821124a --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoNumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for integer literal +-- in NO NumericUnderscores extension. + +module NoNumericUnderscores0 where + +f :: Int -> () +f 1_000 = () +f _ = () diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores0.stderr b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.stderr new file mode 100644 index 0000000000..af59581c14 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.stderr @@ -0,0 +1,3 @@ + +NoNumericUnderscores0.hs:11:3: error: + Use NumericUnderscores to allow underscores in integer literals diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores1.hs b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.hs new file mode 100644 index 0000000000..017f20528b --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoNumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for floating literal +-- in NO NumericUnderscores extension. + +module NoNumericUnderscores1 where + +f :: Float -> () +f 1_000.0_1 = () +f _ = () diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores1.stderr b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.stderr new file mode 100644 index 0000000000..0dfbaa409e --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.stderr @@ -0,0 +1,3 @@ + +NoNumericUnderscores1.hs:11:3: error: + Use NumericUnderscores to allow underscores in floating literals diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.hs b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.hs new file mode 100644 index 0000000000..1f04184365 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE NumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for invalid case of NumericUnderscores. + +main :: IO () +main = do + print [ + -- integer + 1000000_, + _1000000 + ] diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.stderr b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.stderr new file mode 100644 index 0000000000..8c872575a5 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.stderr @@ -0,0 +1,4 @@ +NumericUnderscoresFail0.hs:9:5: error: +NumericUnderscoresFail0.hs:11:13: error: +NumericUnderscoresFail0.hs:11:20: error: +NumericUnderscoresFail0.hs:12:13: error: diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.hs b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.hs new file mode 100644 index 0000000000..0a6a3051d6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for invalid case of NumericUnderscores. + +main :: IO () +main = do + print [ + -- float + 0_.0001, + _0.0001, + 0.0001_, + 0._0001, + + -- float with exponent + 1e_+23, + 1e+23_, + 1e+_23 + ] diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.stderr b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.stderr new file mode 100644 index 0000000000..e1c91de091 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.stderr @@ -0,0 +1,7 @@ +NumericUnderscoresFail1.hs:11:14: error: +NumericUnderscoresFail1.hs:13:19: error: +NumericUnderscoresFail1.hs:14:15: error: +NumericUnderscoresFail1.hs:17:14: error: Variable not in scope: e_ +NumericUnderscoresFail1.hs:18:18: error: +NumericUnderscoresFail1.hs:19:14: error: Variable not in scope: e +NumericUnderscoresFail1.hs:19:16: error: diff --git a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr index 5eb8b539a3..24d5cfc168 100644 --- a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr +++ b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr @@ -1,2 +1,2 @@ - -ParserNoLambdaCase.hs:3:6: error: parse error on input ‘case’ +ParserNoLambdaCase.hs:3:6: + Illegal lambda-case (use -XLambdaCase) diff --git a/testsuite/tests/parser/should_fail/T13450.hs b/testsuite/tests/parser/should_fail/T13450.hs new file mode 100644 index 0000000000..b36cca0719 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T13450.hs @@ -0,0 +1,4 @@ +module T13450 where + +example = foo + where foo = '' diff --git a/testsuite/tests/parser/should_fail/T13450.stderr b/testsuite/tests/parser/should_fail/T13450.stderr new file mode 100644 index 0000000000..6e0beb32cc --- /dev/null +++ b/testsuite/tests/parser/should_fail/T13450.stderr @@ -0,0 +1,4 @@ + +T13450.hs:4:15: error: + Parser error on `''` + Character literals may not be empty diff --git a/testsuite/tests/parser/should_fail/T13450TH.hs b/testsuite/tests/parser/should_fail/T13450TH.hs new file mode 100644 index 0000000000..c851049582 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T13450TH.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T13450TH where + +example = foo + where foo = '' diff --git a/testsuite/tests/parser/should_fail/T13450TH.stderr b/testsuite/tests/parser/should_fail/T13450TH.stderr new file mode 100644 index 0000000000..11733c5c91 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T13450TH.stderr @@ -0,0 +1,6 @@ + +T13450TH.hs:6:15: error: + Parser error on `''` + Character literals may not be empty + Or perhaps you intended to use quotation syntax of TemplateHaskell, + but the type variable or constructor is missing diff --git a/testsuite/tests/parser/should_fail/T14588.hs b/testsuite/tests/parser/should_fail/T14588.hs new file mode 100644 index 0000000000..8a0bcecd7b --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14588.hs @@ -0,0 +1,3 @@ +module T14588 where + +main = print (let !x = 1 + 2 in x) diff --git a/testsuite/tests/parser/should_fail/T14588.stderr b/testsuite/tests/parser/should_fail/T14588.stderr new file mode 100644 index 0000000000..cb64103814 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14588.stderr @@ -0,0 +1,4 @@ + +T14588.hs:3:19: error: + Illegal bang-pattern (use BangPatterns): + ! x diff --git a/testsuite/tests/parser/should_fail/T14740.hs b/testsuite/tests/parser/should_fail/T14740.hs new file mode 100644 index 0000000000..b56687f051 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14740.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE UnboxedTuples #-} + +module T14740 where + +x :: ((##)) => () +x = () diff --git a/testsuite/tests/parser/should_fail/T14740.stderr b/testsuite/tests/parser/should_fail/T14740.stderr new file mode 100644 index 0000000000..8827873e25 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14740.stderr @@ -0,0 +1,4 @@ + +T14740.hs:5:7: + Expecting a lifted type, but ‘(# #)’ is unlifted + In the type signature: x :: ((# #)) => () diff --git a/testsuite/tests/parser/should_fail/T15053.hs b/testsuite/tests/parser/should_fail/T15053.hs new file mode 100644 index 0000000000..44154a48c0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15053.hs @@ -0,0 +1,3 @@ +{-# OPTIONS_GHC -O1 } +" + #-} diff --git a/testsuite/tests/parser/should_fail/T15053.stderr b/testsuite/tests/parser/should_fail/T15053.stderr new file mode 100644 index 0000000000..0544327c5e --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15053.stderr @@ -0,0 +1,5 @@ +T15053.hs:1:16: + Error while parsing OPTIONS_GHC pragma. + Expecting whitespace-separated list of GHC options. + E.g. {-# OPTIONS_GHC -Wall -O2 #-} + Input was: " -O1 }/n/"/n " diff --git a/testsuite/tests/parser/should_fail/T15209.hs b/testsuite/tests/parser/should_fail/T15209.hs new file mode 100644 index 0000000000..1679d80ba6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15209.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs, TypeOperators #-} +module T15209 where + +import GHC.Prim + +foo :: a ~# Int -> () +foo = () diff --git a/testsuite/tests/parser/should_fail/T15209.stderr b/testsuite/tests/parser/should_fail/T15209.stderr new file mode 100644 index 0000000000..9d1e151cf2 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15209.stderr @@ -0,0 +1,2 @@ + +T15209.hs:6:10: error: Not in scope: type constructor or class ‘~#’ diff --git a/testsuite/tests/parser/should_fail/T3811c.stderr b/testsuite/tests/parser/should_fail/T3811c.stderr index 4a371165fb..dd219184e7 100644 --- a/testsuite/tests/parser/should_fail/T3811c.stderr +++ b/testsuite/tests/parser/should_fail/T3811c.stderr @@ -1,2 +1,5 @@ -T3811c.hs:6:10: Malformed instance: !Show D +T3811c.hs:6:10: error: + • Unexpected strictness annotation: !Show + strictness annotation cannot appear nested inside a type + • In the instance declaration for ‘!Show D’ diff --git a/testsuite/tests/parser/should_fail/T7848.hs b/testsuite/tests/parser/should_fail/T7848.hs index 25f0af7ee0..920f28e8c9 100644 --- a/testsuite/tests/parser/should_fail/T7848.hs +++ b/testsuite/tests/parser/should_fail/T7848.hs @@ -8,4 +8,4 @@ x (+) ((&)@z) ((:&&) a b) (c :&& d) (e `A` f) (A g h) = y y _ = (&) {-# INLINE (&) #-} {-# SPECIALIZE (&) :: a #-} - (&) = x + (&) = 'c' diff --git a/testsuite/tests/parser/should_fail/T7848.stderr b/testsuite/tests/parser/should_fail/T7848.stderr index 95ac7374ef..413920dbe6 100644 --- a/testsuite/tests/parser/should_fail/T7848.stderr +++ b/testsuite/tests/parser/should_fail/T7848.stderr @@ -1,13 +1,7 @@ -T7848.hs:6:1: error: - • Occurs check: cannot construct the infinite type: - t ~ p0 -> p1 -> A -> A -> A -> A -> p2 -> t - • Relevant bindings include x :: t (bound at T7848.hs:6:1) - T7848.hs:10:9: error: - • Couldn't match expected type ‘t’ with actual type ‘a’ - because type variable ‘a’ would escape its scope - This (rigid, skolem) type variable is bound by + • Couldn't match expected type ‘Char’ with actual type ‘a’ + ‘a’ is a rigid type variable bound by the type signature for: (&) :: forall a. a at T7848.hs:10:9-35 @@ -20,5 +14,4 @@ T7848.hs:10:9: error: y _ = (&) {-# INLINE (&) #-} {-# SPECIALIZE (&) :: a #-} - (&) = x - • Relevant bindings include x :: t (bound at T7848.hs:6:1) + (&) = 'c' diff --git a/testsuite/tests/parser/should_fail/T8258NoGADTs.hs b/testsuite/tests/parser/should_fail/T8258NoGADTs.hs new file mode 100644 index 0000000000..1080233bcd --- /dev/null +++ b/testsuite/tests/parser/should_fail/T8258NoGADTs.hs @@ -0,0 +1,3 @@ +module T8258NoGADTs where + +data T where diff --git a/testsuite/tests/parser/should_fail/T8258NoGADTs.stderr b/testsuite/tests/parser/should_fail/T8258NoGADTs.stderr new file mode 100644 index 0000000000..35f5306274 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T8258NoGADTs.stderr @@ -0,0 +1,5 @@ + +T8258NoGADTs.hs:3:8: error: + Illegal keyword 'where' in data declaration + Perhaps you intended to use GADTs or a similar language + extension to enable syntax: data T where diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index abe3da9775..960144c9cb 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -35,7 +35,8 @@ 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('readFail032', when(opsys('darwin'), expect_broken(15662)), + compile_fail, ['-cpp']) test('readFail033', normal, compile_fail, ['']) test('readFail034', normal, compile_fail, ['']) test('readFail035', normal, compile_fail, ['']) @@ -50,6 +51,8 @@ test('readFail043', normal, compile_fail, ['']) test('readFail044', normal, compile_fail, ['']) test('readFail046', normal, compile_fail, ['']) test('readFail047', normal, compile_fail, ['']) +test('readFail048', when(opsys('darwin'), expect_broken(15662)), + compile_fail, ['-cpp -haddock']) test('T3095', normal, compile_fail, ['']) test('T3153', normal, compile_fail, ['']) test('T3751', normal, compile_fail, ['']) @@ -69,6 +72,9 @@ test('T3811f', normal, compile_fail, ['']) test('T3811g', normal, compile_fail, ['']) test('NoDoAndIfThenElse', normal, compile_fail, ['']) test('NoPatternSynonyms', normal, compile_fail, ['']) +test('NoBlockArgumentsFail', normal, compile_fail, ['']) +test('NoBlockArgumentsFail2', normal, compile_fail, ['']) +test('NoBlockArgumentsFail3', normal, compile_fail, ['']) test('NondecreasingIndentationFail', normal, compile_fail, ['']) test('readFailTraditionalRecords1', normal, compile_fail, ['']) test('readFailTraditionalRecords2', normal, compile_fail, ['']) @@ -84,6 +90,7 @@ test('T5425', normal, compile_fail, ['']) test('T984', normal, compile_fail, ['']) test('T7848', normal, compile_fail, ['-dppr-user-length=100']) test('ExportCommaComma', normal, compile_fail, ['']) +test('T8258NoGADTs', normal, compile_fail, ['']) test('T8430', literate, compile_fail, ['']) test('T8431', compile_timeout_multiplier(0.05), compile_fail, ['-XAlternativeLayoutRule']) @@ -102,3 +109,23 @@ test('T8501a', normal, compile_fail, ['']) test('T8501b', normal, compile_fail, ['']) test('T8501c', normal, compile_fail, ['']) test('T12610', normal, compile_fail, ['']) +test('T13450', normal, compile_fail, ['']) +test('T13450TH', normal, compile_fail, ['']) +test('T14588', normal, compile_fail, ['']) +test('T14740', normal, compile_fail, ['']) +test('T15209', normal, compile_fail, ['']) + +test('NoNumericUnderscores0', normal, compile_fail, ['']) +test('NoNumericUnderscores1', normal, compile_fail, ['']) +test('NumericUnderscoresFail0', + grep_errmsg(r'^NumericUnderscoresFail0.hs:'), compile_fail, ['']) +test('NumericUnderscoresFail1', + grep_errmsg(r'^NumericUnderscoresFail1.hs:'), compile_fail, ['']) + +test('InfixAppPatErr', normal, compile_fail, ['']) + +test('typeops_A', normal, compile_fail, ['']) +test('typeops_B', normal, compile_fail, ['']) +test('typeops_C', normal, compile_fail, ['']) +test('typeops_D', normal, compile_fail, ['']) +test('T15053', normal, compile_fail, ['']) diff --git a/testsuite/tests/parser/should_fail/readFail032.hs b/testsuite/tests/parser/should_fail/readFail032.hs index dec758a16f..93e7181033 100644 --- a/testsuite/tests/parser/should_fail/readFail032.hs +++ b/testsuite/tests/parser/should_fail/readFail032.hs @@ -1,4 +1,3 @@ - -- Test for trac #314 {- @@ -8,15 +7,19 @@ up some lines - This - uses - up - some - lines + The + following + pragmas + should + not + be + parsed */ +# 23 +#pragma + -} module ShouldFail where -type_error = "Type error on line 21":"Type error on line 21" - +type_error = "Type error on line 25":"Type error on line 25" diff --git a/testsuite/tests/parser/should_fail/readFail032.stderr b/testsuite/tests/parser/should_fail/readFail032.stderr index 95852c5bbd..7cd106d69a 100644 --- a/testsuite/tests/parser/should_fail/readFail032.stderr +++ b/testsuite/tests/parser/should_fail/readFail032.stderr @@ -1,8 +1,11 @@ -readFail032.hs:21:38: - Couldn't match expected type `[Char]' with actual type `Char' +readFail032.hs:25:38: + Couldn't match type ‘Char’ with ‘[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" + In the second argument of ‘(:)’, namely ‘"Type error on line 25"’ + In the expression: + "Type error on line 25" : "Type error on line 25" + In an equation for ‘type_error’: + type_error = "Type error on line 25" : "Type error on line 25" + diff --git a/testsuite/tests/parser/should_fail/readFail036.hs b/testsuite/tests/parser/should_fail/readFail036.hs index 2bb23149dd..15afd980f8 100644 --- a/testsuite/tests/parser/should_fail/readFail036.hs +++ b/testsuite/tests/parser/should_fail/readFail036.hs @@ -1,5 +1,5 @@ - module Foo where -data Foo (a :: *) = Foo a +import Data.Kind (Type) +data Foo (a :: Type) = Foo a diff --git a/testsuite/tests/parser/should_fail/readFail036.stderr b/testsuite/tests/parser/should_fail/readFail036.stderr index 0d22eb8363..a66afacacf 100644 --- a/testsuite/tests/parser/should_fail/readFail036.stderr +++ b/testsuite/tests/parser/should_fail/readFail036.stderr @@ -1,5 +1,5 @@ -readFail036.hs:4:16: - Illegal kind signature: ‘*’ +readFail036.hs:5:16: error: + Illegal kind signature: ‘Type’ Perhaps you intended to use KindSignatures In the data type declaration for ‘Foo’ diff --git a/testsuite/tests/parser/should_fail/readFail037.stderr b/testsuite/tests/parser/should_fail/readFail037.stderr index 6fcd2db206..6b317eb051 100644 --- a/testsuite/tests/parser/should_fail/readFail037.stderr +++ b/testsuite/tests/parser/should_fail/readFail037.stderr @@ -1,5 +1,5 @@ -readFail037.hs:4:1: - Too many parameters for class ‘Foo’ - (Use MultiParamTypeClasses to allow multi-parameter classes) - In the class declaration for ‘Foo’ +readFail037.hs:4:1: error: + • Too many parameters for class ‘Foo’ + (Enable MultiParamTypeClasses to allow multi-parameter classes) + • In the class declaration for ‘Foo’ diff --git a/testsuite/tests/parser/should_fail/readFail041.stderr b/testsuite/tests/parser/should_fail/readFail041.stderr index c5b28a6f0f..028b96510b 100644 --- a/testsuite/tests/parser/should_fail/readFail041.stderr +++ b/testsuite/tests/parser/should_fail/readFail041.stderr @@ -1,5 +1,5 @@ -readFail041.hs:6:1: - Fundeps in class ‘Foo’ - (Use FunctionalDependencies to allow fundeps) - In the class declaration for ‘Foo’ +readFail041.hs:6:1: error: + • Fundeps in class ‘Foo’ + (Enable FunctionalDependencies to allow fundeps) + • In the class declaration for ‘Foo’ diff --git a/testsuite/tests/parser/should_fail/readFail048.hs b/testsuite/tests/parser/should_fail/readFail048.hs new file mode 100644 index 0000000000..2985e5e66f --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail048.hs @@ -0,0 +1,25 @@ +-- Test for trac #314 + +{-| +/* + This + uses + up + some + lines + The + following + pragmas + should + not + be + parsed + */ +# 23 +#pragma + +-} + +module ShouldFail where + +type_error = "Type error on line 25":"Type error on line 25" diff --git a/testsuite/tests/parser/should_fail/readFail048.stderr b/testsuite/tests/parser/should_fail/readFail048.stderr new file mode 100644 index 0000000000..62276db0c9 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail048.stderr @@ -0,0 +1,11 @@ + +readFail048.hs:25:38: + Couldn't match type ‘Char’ with ‘[Char]’ + Expected type: [[Char]] + Actual type: [Char] + In the second argument of ‘(:)’, namely ‘"Type error on line 25"’ + In the expression: + "Type error on line 25" : "Type error on line 25" + In an equation for ‘type_error’: + type_error = "Type error on line 25" : "Type error on line 25" + diff --git a/testsuite/tests/parser/should_fail/typeops_A.hs b/testsuite/tests/parser/should_fail/typeops_A.hs new file mode 100644 index 0000000000..abd7f528c6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_A.hs @@ -0,0 +1 @@ +type X = 1 + diff --git a/testsuite/tests/parser/should_fail/typeops_A.stderr b/testsuite/tests/parser/should_fail/typeops_A.stderr new file mode 100644 index 0000000000..69f7aac6be --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_A.stderr @@ -0,0 +1,2 @@ + +typeops_A.hs:1:12: error: Operator applied to too few arguments: + diff --git a/testsuite/tests/parser/should_fail/typeops_B.hs b/testsuite/tests/parser/should_fail/typeops_B.hs new file mode 100644 index 0000000000..ac65f872de --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_B.hs @@ -0,0 +1 @@ +type X = + 1 diff --git a/testsuite/tests/parser/should_fail/typeops_B.stderr b/testsuite/tests/parser/should_fail/typeops_B.stderr new file mode 100644 index 0000000000..030516a27f --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_B.stderr @@ -0,0 +1,2 @@ + +typeops_B.hs:1:10: error: Operator applied to too few arguments: + diff --git a/testsuite/tests/parser/should_fail/typeops_C.hs b/testsuite/tests/parser/should_fail/typeops_C.hs new file mode 100644 index 0000000000..e55838934a --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_C.hs @@ -0,0 +1 @@ +type X = 1 + + 2 diff --git a/testsuite/tests/parser/should_fail/typeops_C.stderr b/testsuite/tests/parser/should_fail/typeops_C.stderr new file mode 100644 index 0000000000..280323bb67 --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_C.stderr @@ -0,0 +1,2 @@ + +typeops_C.hs:1:12: error: Operator applied to too few arguments: + diff --git a/testsuite/tests/parser/should_fail/typeops_D.hs b/testsuite/tests/parser/should_fail/typeops_D.hs new file mode 100644 index 0000000000..655b2f15f0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_D.hs @@ -0,0 +1 @@ +type X = + diff --git a/testsuite/tests/parser/should_fail/typeops_D.stderr b/testsuite/tests/parser/should_fail/typeops_D.stderr new file mode 100644 index 0000000000..0ce7e29559 --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_D.stderr @@ -0,0 +1,2 @@ + +typeops_D.hs:1:10: error: Operator applied to too few arguments: + |