diff options
Diffstat (limited to 'testsuite/tests/rename/should_fail')
169 files changed, 1227 insertions, 0 deletions
diff --git a/testsuite/tests/rename/should_fail/Makefile b/testsuite/tests/rename/should_fail/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/rename/should_fail/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/rename/should_fail/RnFail047_A.hs b/testsuite/tests/rename/should_fail/RnFail047_A.hs new file mode 100644 index 0000000000..dfe63adbaa --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnFail047_A.hs @@ -0,0 +1,8 @@ + +module RnFail047_A (x) where + +import RnFail047 + +x :: Int +x = 3 + diff --git a/testsuite/tests/rename/should_fail/RnFail047_A.hs-boot b/testsuite/tests/rename/should_fail/RnFail047_A.hs-boot new file mode 100644 index 0000000000..5bfff40b96 --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnFail047_A.hs-boot @@ -0,0 +1,6 @@ + +module RnFail047_A (x, y) where + +x::Int +y::Int + diff --git a/testsuite/tests/rename/should_fail/RnFail055.hs b/testsuite/tests/rename/should_fail/RnFail055.hs new file mode 100644 index 0000000000..bd95add36b --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnFail055.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE MultiParamTypeClasses,RankNTypes,ExistentialQuantification,DatatypeContexts #-} +module RnFail055 where + +import RnFail055_aux + +-- Id with different type +f1 :: Int -> Float +f1 = undefined + +-- type synonym with different arity +type S1 a b = (a,b) + +-- type synonym with different rhs +type S2 a b = forall a. (a,b) + +-- type synonym with alpha-renaming (should be ok) +type S3 a = [a] + +-- datatype with different fields +data T1 a b = T1 [b] [a] + +-- datatype with different stupid theta +data (Eq b) => T2 a b = T2 a + +-- different constructor name +data T3' = T3 +data T3 = T3' + +-- check alpha equivalence +data T4 a = T4 (forall b. a -> b) + +-- different field labels +data T5 a = T5 { field5 :: a } + +-- different strict marks +data T6 = T6 Int + +-- different existential quantification +data T7 a = forall a . T7 a + +-- extra method in the hs-boot +class C1 a b where {} + +-- missing method in the hs-boot +class C2 a b where { m2 :: a -> b; m2' :: a -> b } + +-- different superclasses +class (Eq a, Ord a) => C3 a where { } diff --git a/testsuite/tests/rename/should_fail/RnFail055.hs-boot b/testsuite/tests/rename/should_fail/RnFail055.hs-boot new file mode 100644 index 0000000000..57a97d3695 --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnFail055.hs-boot @@ -0,0 +1,29 @@ +{-# LANGUAGE MultiParamTypeClasses,RankNTypes,ExistentialQuantification,DatatypeContexts #-} +module RnFail055 where + +f1 :: Float -> Int + +type S1 a b c = (a,b) + +type S2 a b = forall b. (a,b) + +type S3 t = [t] + +data T1 a b = T1 [a] [b] + +data (Eq a) => T2 a b = T2 a + +data T3 = T3 +data T3' = T3' + +data T4 b = T4 (forall a. b -> a) + +data T5 a = T5 a + +data T6 = T6 !Int + +data T7 a = forall b . T7 a + +class C1 a b where { m1 :: a -> b } +class C2 a b where { m2 :: a -> b } +class (Ord a, Eq a) => C3 a where { } diff --git a/testsuite/tests/rename/should_fail/RnFail055_aux.hs b/testsuite/tests/rename/should_fail/RnFail055_aux.hs new file mode 100644 index 0000000000..4e1f12bf81 --- /dev/null +++ b/testsuite/tests/rename/should_fail/RnFail055_aux.hs @@ -0,0 +1,3 @@ +module RnFail055_aux where + +import {-# SOURCE #-} RnFail055 diff --git a/testsuite/tests/rename/should_fail/Rnfail040_A.hs b/testsuite/tests/rename/should_fail/Rnfail040_A.hs new file mode 100644 index 0000000000..6de0f88ac9 --- /dev/null +++ b/testsuite/tests/rename/should_fail/Rnfail040_A.hs @@ -0,0 +1,2 @@ +module Rnfail040_A( nub ) where + nub = True diff --git a/testsuite/tests/rename/should_fail/T1595a.hs b/testsuite/tests/rename/should_fail/T1595a.hs new file mode 100644 index 0000000000..5497a7a269 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T1595a.hs @@ -0,0 +1,5 @@ +module T1595a where + +a, b :: Integer -> Tpyo +a = undefined +b = undefined diff --git a/testsuite/tests/rename/should_fail/T1595a.stderr b/testsuite/tests/rename/should_fail/T1595a.stderr new file mode 100644 index 0000000000..3c9adca7f7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T1595a.stderr @@ -0,0 +1,2 @@ + +T1595a.hs:3:20: Not in scope: type constructor or class `Tpyo' diff --git a/testsuite/tests/rename/should_fail/T2310.hs b/testsuite/tests/rename/should_fail/T2310.hs new file mode 100644 index 0000000000..6094b8e211 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2310.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -XScopedTypeVariables #-} + +module Foo where + +foo = let c = \ x :: a -> (x :: a) in co diff --git a/testsuite/tests/rename/should_fail/T2310.stderr b/testsuite/tests/rename/should_fail/T2310.stderr new file mode 100644 index 0000000000..6500eef1fc --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2310.stderr @@ -0,0 +1,10 @@ + +T2310.hs:5:22: + Illegal result type signature `a' + Result signatures are no longer supported in pattern matches + In a lambda abstraction: \ x :: a -> (x :: a) + +T2310.hs:5:39: + Not in scope: `co' + Perhaps you meant one of these: + `c' (line 5), `cos' (imported from Prelude) diff --git a/testsuite/tests/rename/should_fail/T2490.hs b/testsuite/tests/rename/should_fail/T2490.hs new file mode 100644 index 0000000000..31afc0987a --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2490.hs @@ -0,0 +1,10 @@ +-- Trac #2490 +module ShouldFail where + +-- All these sections are illegal + +f x = [ (`head` x, ()) + , (+ x, ()) + , ((), + x) + , ((), + x, ()) + , ((), x +) ] diff --git a/testsuite/tests/rename/should_fail/T2490.stderr b/testsuite/tests/rename/should_fail/T2490.stderr new file mode 100644 index 0000000000..15beadab1e --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2490.stderr @@ -0,0 +1,15 @@ + +T2490.hs:6:10: + A section must be enclosed in parentheses thus: (`head` x) + +T2490.hs:7:10: + A section must be enclosed in parentheses thus: (+ x) + +T2490.hs:8:14: + A section must be enclosed in parentheses thus: (+ x) + +T2490.hs:9:14: + A section must be enclosed in parentheses thus: (+ x) + +T2490.hs:10:14: + A section must be enclosed in parentheses thus: (x +) diff --git a/testsuite/tests/rename/should_fail/T2723.hs b/testsuite/tests/rename/should_fail/T2723.hs new file mode 100644 index 0000000000..74f11af778 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2723.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -fwarn-name-shadowing -XNamedFieldPuns -XRecordWildCards #-}
+module WildCard where
+
+data Record = Record {field1 :: Int, field2 :: Double}
+
+field3 :: Int
+field3 = 3
+
+test1 (Record {field1, field2}) = let test = 1 in field1
+
+test2 :: (Record, Int)
+test2 = let
+ field1 = 10
+ field2 = 10.0
+ field3 = 8
+ in (Record {..}, field3)
diff --git a/testsuite/tests/rename/should_fail/T2723.stderr b/testsuite/tests/rename/should_fail/T2723.stderr new file mode 100644 index 0000000000..7ede041658 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2723.stderr @@ -0,0 +1,4 @@ + +T2723.hs:15:5: + Warning: This binding for `field3' shadows the existing binding + defined at T2723.hs:7:1 diff --git a/testsuite/tests/rename/should_fail/T2901.hs b/testsuite/tests/rename/should_fail/T2901.hs new file mode 100644 index 0000000000..a703a5e53d --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2901.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +-- Trac #2901 + +module T2901 where + +f = F.Foo { F.field = "" } diff --git a/testsuite/tests/rename/should_fail/T2901.stderr b/testsuite/tests/rename/should_fail/T2901.stderr new file mode 100644 index 0000000000..7b3e9d5145 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2901.stderr @@ -0,0 +1,5 @@ + +T2901.hs:6:5: Not in scope: data constructor `F.Foo' + +T2901.hs:6:13: + `F.field' is not a (visible) field of constructor `Foo' diff --git a/testsuite/tests/rename/should_fail/T2993.hs b/testsuite/tests/rename/should_fail/T2993.hs new file mode 100644 index 0000000000..99f2a89ca1 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2993.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeOperators #-} + +-- Trac #2993 + +module T2993 where + +foo b a = a <$> b . b + diff --git a/testsuite/tests/rename/should_fail/T2993.stderr b/testsuite/tests/rename/should_fail/T2993.stderr new file mode 100644 index 0000000000..0ba55ddd36 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T2993.stderr @@ -0,0 +1,2 @@ + +T2993.hs:7:13: Not in scope: `<$>' diff --git a/testsuite/tests/rename/should_fail/T3265.hs b/testsuite/tests/rename/should_fail/T3265.hs new file mode 100644 index 0000000000..e938bbc34d --- /dev/null +++ b/testsuite/tests/rename/should_fail/T3265.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + +-- Test Trac #3265 + +module T3265 where + +data a :+: b = Left a | Right b + +class a :*: b where {} diff --git a/testsuite/tests/rename/should_fail/T3265.stderr b/testsuite/tests/rename/should_fail/T3265.stderr new file mode 100644 index 0000000000..37642ff16b --- /dev/null +++ b/testsuite/tests/rename/should_fail/T3265.stderr @@ -0,0 +1,8 @@ + +T3265.hs:7:8: + Illegal declaration of a type or class operator `:+:' + Use -XTypeOperators to declare operators in type and declarations + +T3265.hs:9:9: + Illegal declaration of a type or class operator `:*:' + Use -XTypeOperators to declare operators in type and declarations diff --git a/testsuite/tests/rename/should_fail/T3792.hs b/testsuite/tests/rename/should_fail/T3792.hs new file mode 100644 index 0000000000..e01efb9418 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T3792.hs @@ -0,0 +1,4 @@ +module T3792 where
+
+import Prelude( Prelude.map ) -- Illegal
+
diff --git a/testsuite/tests/rename/should_fail/T3792.stderr b/testsuite/tests/rename/should_fail/T3792.stderr new file mode 100644 index 0000000000..892fb11083 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T3792.stderr @@ -0,0 +1,2 @@ +
+T3792.hs:3:17: Illegal qualified name in import item: Prelude.map
diff --git a/testsuite/tests/rename/should_fail/T4042.hs b/testsuite/tests/rename/should_fail/T4042.hs new file mode 100644 index 0000000000..221b5519ef --- /dev/null +++ b/testsuite/tests/rename/should_fail/T4042.hs @@ -0,0 +1,12 @@ +-- Test Trac #4042 + +module T4042 where + +f :: A -> A +f +-- The above line is a naked Template Haskell splice +-- When compiling without -XTemplateHaskell we don't +-- want a confusing error messsage saying "A is not in scope" + +data A = A + diff --git a/testsuite/tests/rename/should_fail/T4042.stderr b/testsuite/tests/rename/should_fail/T4042.stderr new file mode 100644 index 0000000000..f8c7e433a6 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T4042.stderr @@ -0,0 +1,2 @@ + +T4042.hs:6:1: Parse error: naked expression at top level diff --git a/testsuite/tests/rename/should_fail/T5211.hs b/testsuite/tests/rename/should_fail/T5211.hs new file mode 100644 index 0000000000..2d0e69af7b --- /dev/null +++ b/testsuite/tests/rename/should_fail/T5211.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -fwarn-unused-imports #-}
+module RedundantImport where
+
+-- this import is redundant, but GHC does not spot it
+import qualified Foreign.Storable
+
+import Foreign.Storable (Storable, sizeOf, alignment, peek, poke, )
+import Foreign.Ptr (castPtr, )
+
+newtype T a = Cons a
+
+instance Storable a => Storable (T a) where
+ sizeOf (Cons a) = sizeOf a
+ alignment (Cons a) = alignment a
+ peek = fmap Cons . peek . castPtr
+ poke p (Cons a) = poke (castPtr p) a
diff --git a/testsuite/tests/rename/should_fail/T5211.stderr b/testsuite/tests/rename/should_fail/T5211.stderr new file mode 100644 index 0000000000..a33a02750c --- /dev/null +++ b/testsuite/tests/rename/should_fail/T5211.stderr @@ -0,0 +1,5 @@ +
+T5211.hs:5:1:
+ Warning: The import of `Foreign.Storable' is redundant
+ except perhaps to import instances from `Foreign.Storable'
+ To import instances alone, use: import Foreign.Storable()
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T new file mode 100644 index 0000000000..78d35ce37c --- /dev/null +++ b/testsuite/tests/rename/should_fail/all.T @@ -0,0 +1,83 @@ + +test('rnfail001', normal, compile_fail, ['']) +test('rnfail002', normal, compile_fail, ['']) +test('rnfail003', normal, compile_fail, ['']) +test('rnfail004', normal, compile_fail, ['']) +test('rnfail007', normal, compile_fail, ['']) +test('rnfail008', normal, compile_fail, ['']) +test('rnfail009', normal, compile_fail, ['']) +test('rnfail010', normal, compile_fail, ['']) +test('rnfail011', normal, compile_fail, ['']) +test('rnfail012', normal, compile_fail, ['']) +test('rnfail013', normal, compile_fail, ['']) + +test('rnfail015', normal, compile_fail, ['']) +test('rnfail016', normal, compile_fail, ['']) +test('rnfail017', normal, compile_fail, ['']) +test('rnfail018', normal, compile_fail, ['']) +test('rnfail019', normal, compile_fail, ['']) +test('rnfail020', normal, compile, ['']) # Succeeds now (Jan07) +test('rnfail021', normal, compile_fail, ['']) +test('rnfail022', normal, compile_fail, ['']) +test('rnfail023', normal, compile_fail, ['']) +test('rnfail024', normal, compile_fail, ['']) +test('rnfail025', normal, compile_fail, ['']) +test('rnfail026', normal, compile_fail, ['']) +test('rnfail027', normal, compile_fail, ['']) +test('rnfail028', normal, compile_fail, ['']) +test('rnfail029', normal, compile_fail, ['']) +test('rnfail030', normal, compile_fail, ['']) +test('rnfail031', normal, compile_fail, ['']) +test('rnfail032', normal, compile_fail, ['']) +test('rnfail033', normal, compile_fail, ['']) +test('rnfail034', normal, compile_fail, ['']) +test('rnfail035', normal, compile_fail, ['']) + +# Missing: +# test('rnfail037', normal, compile_fail, ['']) + +test('rnfail038', normal, compile_fail, ['']) +test('rnfail039', normal, compile_fail, ['']) + +test('rnfail040', + extra_clean(['Rnfail040_A.hi', 'Rnfail040_A.o']), + multimod_compile_fail, ['rnfail040', '-v0']) +test('rnfail041', normal, compile_fail, ['']) +test('rnfail042', normal, compile_fail, ['']) + +test('rnfail043', skip_if_no_ghci, compile_fail, ['-v0']) +test('rnfail044', normal, compile_fail, ['']) +test('rnfail045', normal, compile_fail, ['']) +test('rnfail046', normal, compile_fail, ['']) +test('rnfail047', + extra_clean(['RnFail047_A.hi-boot', 'RnFail047_A.o-boot']), + multimod_compile_fail, + ['rnfail047', '-v0']) +test('rnfail048', normal, compile_fail, ['']) +test('rnfail049', normal, compile_fail, ['']) +test('rnfail050', normal, compile_fail, ['']) +test('rnfail051', normal, compile_fail, ['']) +test('rnfail052', normal, compile_fail, ['']) +test('rnfail053', normal, compile_fail, ['']) +test('rnfail054', normal, compile_fail, ['']) +test('rnfail055', + extra_clean(['RnFail055.hi-boot', 'RnFail055.o-boot', + 'RnFail055_aux.hi', 'RnFail055_aux.o']), + multimod_compile_fail, + ['RnFail055','-v0']) +test('rnfail056', normal, compile_fail, ['']) + +test('rn_dup', normal, compile_fail, ['']) +test('T2310', normal, compile_fail, ['']) +test('T2490', normal, compile_fail, ['']) +test('T2901', normal, compile_fail, ['']) +test('T2723', normal, compile, ['']) # Warnings only +test('T2993', normal, compile_fail, ['']) +test('T3265', normal, compile_fail, ['']) +test('T3792', normal, compile_fail, ['']) +test('T4042', normal, compile_fail, ['']) + +test('mc13', normal, compile_fail, ['']) +test('mc14', normal, compile_fail, ['']) +test('T5211', normal, compile, ['']) # Warnings only +test('T1595a', normal, compile_fail, ['']) diff --git a/testsuite/tests/rename/should_fail/mc13.hs b/testsuite/tests/rename/should_fail/mc13.hs new file mode 100644 index 0000000000..2686005f7f --- /dev/null +++ b/testsuite/tests/rename/should_fail/mc13.hs @@ -0,0 +1,14 @@ +-- Test for transform list comp which should work for monad comp aswell: +-- +-- Test trying to use a function bound in the list comprehension as the transform function + +{-# OPTIONS_GHC -XRank2Types -XMonadComprehensions -XTransformListComp #-} + +module RnFail048 where + +functions :: [forall a. [a] -> [a]] +functions = [take 4, take 5] + +output = [() | f <- functions, then f] + + diff --git a/testsuite/tests/rename/should_fail/mc13.stderr b/testsuite/tests/rename/should_fail/mc13.stderr new file mode 100644 index 0000000000..82f8dd5f18 --- /dev/null +++ b/testsuite/tests/rename/should_fail/mc13.stderr @@ -0,0 +1,2 @@ + +mc13.hs:12:37: Not in scope: `f' diff --git a/testsuite/tests/rename/should_fail/mc14.hs b/testsuite/tests/rename/should_fail/mc14.hs new file mode 100644 index 0000000000..e2cf74cbf5 --- /dev/null +++ b/testsuite/tests/rename/should_fail/mc14.hs @@ -0,0 +1,16 @@ +-- Test for transform list comp which should work for monad comp aswell: +-- +-- Test trying to use a function bound in the list comprehension as the group function + +{-# OPTIONS_GHC -XRank2Types -XMonadComprehensions -XTransformListComp #-} + +module RnFail049 where + +import Data.List(inits, tails) + +functions :: [forall a. [a] -> [[a]]] +functions = [inits, tails] + +output = [() | f <- functions, then group using f] + + diff --git a/testsuite/tests/rename/should_fail/mc14.stderr b/testsuite/tests/rename/should_fail/mc14.stderr new file mode 100644 index 0000000000..1eadb9d4b7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/mc14.stderr @@ -0,0 +1,2 @@ + +mc14.hs:14:49: Not in scope: `f' diff --git a/testsuite/tests/rename/should_fail/rn_dup.hs b/testsuite/tests/rename/should_fail/rn_dup.hs new file mode 100644 index 0000000000..927e15ff32 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rn_dup.hs @@ -0,0 +1,19 @@ + + +-- Test for top-level duplicates + +module Dup where + +data T = MkT | MkT + +data S = MkT + +data P = MkP { rf :: Int, rf :: Int } +data Q = MkQ { rf :: Int } + +class C a where + data CT a + f :: CT a -> a + data CT a + f :: CT a -> a + diff --git a/testsuite/tests/rename/should_fail/rn_dup.stderr b/testsuite/tests/rename/should_fail/rn_dup.stderr new file mode 100644 index 0000000000..88e2f86413 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rn_dup.stderr @@ -0,0 +1,22 @@ + +rn_dup.hs:9:10: + Multiple declarations of `Dup.MkT' + Declared at: rn_dup.hs:7:10 + rn_dup.hs:7:16 + rn_dup.hs:9:10 + +rn_dup.hs:12:16: + Multiple declarations of `Dup.rf' + Declared at: rn_dup.hs:11:16 + rn_dup.hs:11:27 + rn_dup.hs:12:16 + +rn_dup.hs:17:8: + Multiple declarations of `Dup.CT' + Declared at: rn_dup.hs:15:8 + rn_dup.hs:17:8 + +rn_dup.hs:18:3: + Multiple declarations of `Dup.f' + Declared at: rn_dup.hs:16:3 + rn_dup.hs:18:3 diff --git a/testsuite/tests/rename/should_fail/rnfail001.hs b/testsuite/tests/rename/should_fail/rnfail001.hs new file mode 100644 index 0000000000..f6758a1b2b --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail001.hs @@ -0,0 +1,3 @@ +module ShouldFail where + +f x x = 2 diff --git a/testsuite/tests/rename/should_fail/rnfail001.stderr b/testsuite/tests/rename/should_fail/rnfail001.stderr new file mode 100644 index 0000000000..5414f93f27 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail001.stderr @@ -0,0 +1,6 @@ + +rnfail001.hs:3:3: + Conflicting definitions for `x' + Bound at: rnfail001.hs:3:3 + rnfail001.hs:3:5 + In an equation for `f' diff --git a/testsuite/tests/rename/should_fail/rnfail001.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail001.stderr-hugs new file mode 100644 index 0000000000..9103ec5b64 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail001.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail001.hs":3 - Repeated variable "x" in pattern diff --git a/testsuite/tests/rename/should_fail/rnfail002.hs b/testsuite/tests/rename/should_fail/rnfail002.hs new file mode 100644 index 0000000000..ab387223fc --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail002.hs @@ -0,0 +1,10 @@ +-- !!! rn001: super-simple set of bindings, +-- !!! incl wildcard pattern-bindings and *duplicates* + +x = [] +y = [] +y = [] +_ = [] +_ = 1 +z = [] +_ = [] diff --git a/testsuite/tests/rename/should_fail/rnfail002.stderr b/testsuite/tests/rename/should_fail/rnfail002.stderr new file mode 100644 index 0000000000..db236f3073 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail002.stderr @@ -0,0 +1,5 @@ + +rnfail002.hs:6:1: + Multiple declarations of `Main.y' + Declared at: rnfail002.hs:5:1 + rnfail002.hs:6:1 diff --git a/testsuite/tests/rename/should_fail/rnfail002.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail002.stderr-hugs new file mode 100644 index 0000000000..46f18320e9 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail002.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail002.hs":5 - "y" multiply defined diff --git a/testsuite/tests/rename/should_fail/rnfail003.hs b/testsuite/tests/rename/should_fail/rnfail003.hs new file mode 100644 index 0000000000..fb62bac074 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail003.hs @@ -0,0 +1,4 @@ +-- !!! split definition of f (error) +f [] = [] +g x = x +f (x:xs) = [] diff --git a/testsuite/tests/rename/should_fail/rnfail003.stderr b/testsuite/tests/rename/should_fail/rnfail003.stderr new file mode 100644 index 0000000000..0398a4d9c7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail003.stderr @@ -0,0 +1,5 @@ + +rnfail003.hs:4:1: + Multiple declarations of `Main.f' + Declared at: rnfail003.hs:2:1 + rnfail003.hs:4:1 diff --git a/testsuite/tests/rename/should_fail/rnfail003.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail003.stderr-hugs new file mode 100644 index 0000000000..9ebafc363e --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail003.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail003.hs":2 - "f" multiply defined diff --git a/testsuite/tests/rename/should_fail/rnfail004.hs b/testsuite/tests/rename/should_fail/rnfail004.hs new file mode 100644 index 0000000000..90a97f894c --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail004.hs @@ -0,0 +1,8 @@ +-- !!! multiple definitions, but hidden in patterns +module Foo where + +f x = x + where + a = [] + (b,c,a) = ([],[],d) + [d,b,_] = ([],a,[]) diff --git a/testsuite/tests/rename/should_fail/rnfail004.stderr b/testsuite/tests/rename/should_fail/rnfail004.stderr new file mode 100644 index 0000000000..edff58cf6f --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail004.stderr @@ -0,0 +1,10 @@ + +rnfail004.hs:6:5: + Conflicting definitions for `a' + Bound at: rnfail004.hs:6:5 + rnfail004.hs:7:10 + +rnfail004.hs:7:6: + Conflicting definitions for `b' + Bound at: rnfail004.hs:7:6 + rnfail004.hs:8:8 diff --git a/testsuite/tests/rename/should_fail/rnfail004.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail004.stderr-hugs new file mode 100644 index 0000000000..3ad3a13469 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail004.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail004.hs":7 - "b" multiply defined diff --git a/testsuite/tests/rename/should_fail/rnfail005.stderr b/testsuite/tests/rename/should_fail/rnfail005.stderr new file mode 100644 index 0000000000..9ad30e8755 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail005.stderr @@ -0,0 +1,8 @@ + +rnfail005.hs:4: + Conflicting definitions for: `v' + Defined at rnfail005.hs:20 + Defined at rnfail005.hs:19 + + +Compilation had errors diff --git a/testsuite/tests/rename/should_fail/rnfail007.hs b/testsuite/tests/rename/should_fail/rnfail007.hs new file mode 100644 index 0000000000..272abcf9fb --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail007.hs @@ -0,0 +1,5 @@ +-- !!! Main module with no definition of main + +module Main where + +f x = x diff --git a/testsuite/tests/rename/should_fail/rnfail007.stderr b/testsuite/tests/rename/should_fail/rnfail007.stderr new file mode 100644 index 0000000000..a00dc892d5 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail007.stderr @@ -0,0 +1,3 @@ + +rnfail007.hs:1:1: + The function `main' is not defined in module `Main' diff --git a/testsuite/tests/rename/should_fail/rnfail008.hs b/testsuite/tests/rename/should_fail/rnfail008.hs new file mode 100644 index 0000000000..196214a840 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail008.hs @@ -0,0 +1,19 @@ +-- !!! Class and instance decl + +module Test where + +class K a where + op1 :: a -> a -> a + op2 :: Int -> a + +instance K Int where + op1 a b = a+b + op2 x = x + +instance K Bool where + op1 a b = a + -- Pick up the default decl for op2 + +instance K [a] where + op3 a = a -- Oops! Isn't a class op of K + diff --git a/testsuite/tests/rename/should_fail/rnfail008.stderr b/testsuite/tests/rename/should_fail/rnfail008.stderr new file mode 100644 index 0000000000..91818fc656 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail008.stderr @@ -0,0 +1,2 @@ + +rnfail008.hs:18:9: `op3' is not a (visible) method of class `K' diff --git a/testsuite/tests/rename/should_fail/rnfail008.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail008.stderr-hugs new file mode 100644 index 0000000000..cd6711a842 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail008.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail008.hs":18 - No member "op3" in class "K" diff --git a/testsuite/tests/rename/should_fail/rnfail009.hs b/testsuite/tests/rename/should_fail/rnfail009.hs new file mode 100644 index 0000000000..1557f48c7b --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail009.hs @@ -0,0 +1,5 @@ +module Foo where + +data F = A | B + +data G = A | C diff --git a/testsuite/tests/rename/should_fail/rnfail009.stderr b/testsuite/tests/rename/should_fail/rnfail009.stderr new file mode 100644 index 0000000000..9cddc115d6 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail009.stderr @@ -0,0 +1,5 @@ + +rnfail009.hs:5:10: + Multiple declarations of `Foo.A' + Declared at: rnfail009.hs:3:10 + rnfail009.hs:5:10 diff --git a/testsuite/tests/rename/should_fail/rnfail009.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail009.stderr-hugs new file mode 100644 index 0000000000..2775982760 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail009.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail009.hs":3 - Multiple declarations for data constructor "A" diff --git a/testsuite/tests/rename/should_fail/rnfail010.hs b/testsuite/tests/rename/should_fail/rnfail010.hs new file mode 100644 index 0000000000..d5e51ed4fd --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail010.hs @@ -0,0 +1,6 @@ + +f x = 2 + +g x = 6 + +f x = 3 diff --git a/testsuite/tests/rename/should_fail/rnfail010.stderr b/testsuite/tests/rename/should_fail/rnfail010.stderr new file mode 100644 index 0000000000..0855b4b731 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail010.stderr @@ -0,0 +1,5 @@ + +rnfail010.hs:6:1: + Multiple declarations of `Main.f' + Declared at: rnfail010.hs:2:1 + rnfail010.hs:6:1 diff --git a/testsuite/tests/rename/should_fail/rnfail010.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail010.stderr-hugs new file mode 100644 index 0000000000..1a35934d4c --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail010.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail010.hs":2 - "f" multiply defined diff --git a/testsuite/tests/rename/should_fail/rnfail011.hs b/testsuite/tests/rename/should_fail/rnfail011.hs new file mode 100644 index 0000000000..b342618e15 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail011.hs @@ -0,0 +1,6 @@ + +type A = Int + +type B = Bool + +type A = [Bool] diff --git a/testsuite/tests/rename/should_fail/rnfail011.stderr b/testsuite/tests/rename/should_fail/rnfail011.stderr new file mode 100644 index 0000000000..d76a63a410 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail011.stderr @@ -0,0 +1,5 @@ + +rnfail011.hs:6:6: + Multiple declarations of `Main.A' + Declared at: rnfail011.hs:2:6 + rnfail011.hs:6:6 diff --git a/testsuite/tests/rename/should_fail/rnfail011.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail011.stderr-hugs new file mode 100644 index 0000000000..3ed800c263 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail011.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail011.hs":6 - Multiple declarations of type constructor "A" diff --git a/testsuite/tests/rename/should_fail/rnfail012.hs b/testsuite/tests/rename/should_fail/rnfail012.hs new file mode 100644 index 0000000000..725b0d1632 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail012.hs @@ -0,0 +1,9 @@ + +class A a where + op1 :: a + +class B a where + op2 :: b -> b + +class A a where + op3 :: a diff --git a/testsuite/tests/rename/should_fail/rnfail012.stderr b/testsuite/tests/rename/should_fail/rnfail012.stderr new file mode 100644 index 0000000000..93bfec9346 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail012.stderr @@ -0,0 +1,5 @@ + +rnfail012.hs:8:7: + Multiple declarations of `Main.A' + Declared at: rnfail012.hs:2:7 + rnfail012.hs:8:7 diff --git a/testsuite/tests/rename/should_fail/rnfail012.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail012.stderr-hugs new file mode 100644 index 0000000000..5908cb6f67 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail012.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail012.hs":8 - Multiple declarations of class "A" diff --git a/testsuite/tests/rename/should_fail/rnfail013.hs b/testsuite/tests/rename/should_fail/rnfail013.hs new file mode 100644 index 0000000000..4d30ded185 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail013.hs @@ -0,0 +1,9 @@ +-- !!! Conflicting constructors from two data type decls + +module Foo where + +data T1 = MkT Int + +data T2 = MkT Bool + +f (MkT x) = x diff --git a/testsuite/tests/rename/should_fail/rnfail013.stderr b/testsuite/tests/rename/should_fail/rnfail013.stderr new file mode 100644 index 0000000000..761f2f0a0e --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail013.stderr @@ -0,0 +1,5 @@ + +rnfail013.hs:7:11: + Multiple declarations of `Foo.MkT' + Declared at: rnfail013.hs:5:11 + rnfail013.hs:7:11 diff --git a/testsuite/tests/rename/should_fail/rnfail013.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail013.stderr-hugs new file mode 100644 index 0000000000..3342f19b3c --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail013.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail013.hs":5 - Multiple declarations for data constructor "MkT" diff --git a/testsuite/tests/rename/should_fail/rnfail015.hs b/testsuite/tests/rename/should_fail/rnfail015.hs new file mode 100644 index 0000000000..20f9934f4b --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail015.hs @@ -0,0 +1,20 @@ +module ShouldFail where + +-- !!! duplicate constructors in datatype +-- (bug report from Alex Ferguson, c. 2.06) + +data Token + = TokNewline + | TokLiteral + | TokCount + | TokCheck + | TokIs + | TokDeref + | TokFind + | TokLiteral -- Duplicated! + | TokThe + + deriving Show + +main = print TokCount + diff --git a/testsuite/tests/rename/should_fail/rnfail015.stderr b/testsuite/tests/rename/should_fail/rnfail015.stderr new file mode 100644 index 0000000000..bf1e382f6c --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail015.stderr @@ -0,0 +1,5 @@ + +rnfail015.hs:14:9: + Multiple declarations of `ShouldFail.TokLiteral' + Declared at: rnfail015.hs:8:9 + rnfail015.hs:14:9 diff --git a/testsuite/tests/rename/should_fail/rnfail015.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail015.stderr-hugs new file mode 100644 index 0000000000..a91ae7cb04 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail015.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail015.hs":7 - Multiple declarations for data constructor "TokLiteral" diff --git a/testsuite/tests/rename/should_fail/rnfail016.hs b/testsuite/tests/rename/should_fail/rnfail016.hs new file mode 100644 index 0000000000..1fa71c583a --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail016.hs @@ -0,0 +1,8 @@ +module ShouldFail where + +-- !!! Pattern syntax in expressions + +f x = x @ x +g x = ~ x +h x = _ + diff --git a/testsuite/tests/rename/should_fail/rnfail016.stderr b/testsuite/tests/rename/should_fail/rnfail016.stderr new file mode 100644 index 0000000000..ed9debda77 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail016.stderr @@ -0,0 +1,6 @@ + +rnfail016.hs:5:7: Pattern syntax in expression context: x@x + +rnfail016.hs:6:7: Pattern syntax in expression context: ~x + +rnfail016.hs:7:7: Pattern syntax in expression context: _ diff --git a/testsuite/tests/rename/should_fail/rnfail016.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail016.stderr-hugs new file mode 100644 index 0000000000..76c2827039 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail016.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail016.hs":5 - Illegal `@' in expression diff --git a/testsuite/tests/rename/should_fail/rnfail017.hs b/testsuite/tests/rename/should_fail/rnfail017.hs new file mode 100644 index 0000000000..327a9d6abd --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail017.hs @@ -0,0 +1,17 @@ +module ShouldFail where + +-- !!! Precedence of unary negation + +f1 x y = x + -y -- Fails +f2 x y = x * -y -- Fails + + +f3 x y = -x + y -- OK: means (-x) + y + -- since - is left associative + +f4 x y = - x*y -- OK: means -(x*y) + -- since - binds less tightly than * + +f5 x y = x >= -y -- OK means x >= (-y) + + diff --git a/testsuite/tests/rename/should_fail/rnfail017.stderr b/testsuite/tests/rename/should_fail/rnfail017.stderr new file mode 100644 index 0000000000..f04b1d0990 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail017.stderr @@ -0,0 +1,8 @@ + +rnfail017.hs:5:10: + Precedence parsing error + cannot mix `+' [infixl 6] and prefix `-' [infixl 6] in the same infix expression + +rnfail017.hs:6:10: + Precedence parsing error + cannot mix `*' [infixl 7] and prefix `-' [infixl 6] in the same infix expression diff --git a/testsuite/tests/rename/should_fail/rnfail018.hs b/testsuite/tests/rename/should_fail/rnfail018.hs new file mode 100644 index 0000000000..1b3ad82762 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail018.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE MultiParamTypeClasses, ExplicitForAll #-} + +module ShouldFail where + +-- !!! For-all with parens + +-- This one crashed ghc-4.04proto; the parens after the for-all fooled it + +class Monad m => StateMonad s m where + getState :: m s + +setState0 :: forall b. (StateMonad (a,b) m => m a) +setState0 = getState >>= \ (l,_r) -> return l + + diff --git a/testsuite/tests/rename/should_fail/rnfail018.stderr b/testsuite/tests/rename/should_fail/rnfail018.stderr new file mode 100644 index 0000000000..3bae3eb527 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail018.stderr @@ -0,0 +1,8 @@ + +rnfail018.hs:12:37: Not in scope: type variable `a' + +rnfail018.hs:12:42: Not in scope: type variable `m' + +rnfail018.hs:12:47: Not in scope: type variable `m' + +rnfail018.hs:12:49: Not in scope: type variable `a' diff --git a/testsuite/tests/rename/should_fail/rnfail019.hs b/testsuite/tests/rename/should_fail/rnfail019.hs new file mode 100644 index 0000000000..ec97efe1cf --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail019.hs @@ -0,0 +1,7 @@ +module ShouldFail where + +-- !!! Section with with a bad precedence + +f x y = (x:y:) + +-- GHC 4.04 (as released) let this by, but it's a precedence error. diff --git a/testsuite/tests/rename/should_fail/rnfail019.stderr b/testsuite/tests/rename/should_fail/rnfail019.stderr new file mode 100644 index 0000000000..f990e2d2cd --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail019.stderr @@ -0,0 +1,6 @@ + +rnfail019.hs:5:9: + The operator `:' [infixr 5] of a section + must have lower precedence than that of the operand, + namely `:' [infixr 5] + in the section: `x : y :' diff --git a/testsuite/tests/rename/should_fail/rnfail019.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail019.stderr-hugs new file mode 100644 index 0000000000..1e09963ae1 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail019.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail019.hs":5 - Syntax error in expression (unexpected `)') diff --git a/testsuite/tests/rename/should_fail/rnfail020.hs b/testsuite/tests/rename/should_fail/rnfail020.hs new file mode 100644 index 0000000000..decd2e80ad --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail020.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +-- !!! Error messages with scoped type variables + +module Foo where + +data Set a = Set a + +unionSetB :: Eq a => Set a -> Set a -> Set a +unionSetB (s1 :: Set a) s2 = unionSets s1 s2 + where + unionSets :: Eq a => Set a -> Set a -> Set a + unionSets a b = a + + +{- In GHC 4.04 this gave the terrible message: + + None of the type variable(s) in the constraint `Eq a' + appears in the type `Set a -> Set a -> Set a' + In the type signature for `unionSets' +-} diff --git a/testsuite/tests/rename/should_fail/rnfail020.stderr b/testsuite/tests/rename/should_fail/rnfail020.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail020.stderr diff --git a/testsuite/tests/rename/should_fail/rnfail021.hs b/testsuite/tests/rename/should_fail/rnfail021.hs new file mode 100644 index 0000000000..a8062967e1 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail021.hs @@ -0,0 +1,6 @@ +-- !!! Qualified names in binding positions are rejected + +module Foo where + +(Baz.f, x) = True + diff --git a/testsuite/tests/rename/should_fail/rnfail021.stderr b/testsuite/tests/rename/should_fail/rnfail021.stderr new file mode 100644 index 0000000000..1cf26eca36 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail021.stderr @@ -0,0 +1,2 @@ + +rnfail021.hs:5:2: Qualified name in binding position: Baz.f diff --git a/testsuite/tests/rename/should_fail/rnfail021.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail021.stderr-hugs new file mode 100644 index 0000000000..cb4c6c422a --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail021.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail021.hs":5 - Syntax error in declaration (unexpected symbol "Baz.f") diff --git a/testsuite/tests/rename/should_fail/rnfail022.hs b/testsuite/tests/rename/should_fail/rnfail022.hs new file mode 100644 index 0000000000..05c842e770 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail022.hs @@ -0,0 +1,9 @@ +-- !!! Check that 'qualified' doesn't bring the unqual'ed name into scope. +module ShouldFail where + +import qualified Data.List as L ( intersperse ) + +x = L.intersperse + +y = intersperse + diff --git a/testsuite/tests/rename/should_fail/rnfail022.stderr b/testsuite/tests/rename/should_fail/rnfail022.stderr new file mode 100644 index 0000000000..011d6790d7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail022.stderr @@ -0,0 +1,4 @@ + +rnfail022.hs:8:5: + Not in scope: `intersperse' + Perhaps you meant `L.intersperse' (imported from Data.List) diff --git a/testsuite/tests/rename/should_fail/rnfail022.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail022.stderr-hugs new file mode 100644 index 0000000000..b58124c912 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail022.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail022.hs":8 - Undefined variable "intersperse" diff --git a/testsuite/tests/rename/should_fail/rnfail023.hs b/testsuite/tests/rename/should_fail/rnfail023.hs new file mode 100644 index 0000000000..bf7c4a2f20 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail023.hs @@ -0,0 +1,15 @@ +-- !!! Check that type signatures and pragmas that +-- !!! don't have a "parent" are correctly reported + +module ShouldFail where + +-- Top level test +f :: Int -> Int +{-# INLINE f #-} + +-- Nested test +h :: Int -> Int -- This one is ok +h x = x + where + g :: Int -> Int -- Bogus + diff --git a/testsuite/tests/rename/should_fail/rnfail023.stderr b/testsuite/tests/rename/should_fail/rnfail023.stderr new file mode 100644 index 0000000000..ec9d81ab76 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail023.stderr @@ -0,0 +1,9 @@ + +rnfail023.hs:7:1: + The type signature for `f' lacks an accompanying binding + +rnfail023.hs:8:12: + The INLINE pragma for `f' lacks an accompanying binding + +rnfail023.hs:14:7: + The type signature for `g' lacks an accompanying binding diff --git a/testsuite/tests/rename/should_fail/rnfail023.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail023.stderr-hugs new file mode 100644 index 0000000000..1f8191015d --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail023.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail023.hs":7 - Missing binding for variable "f" in type signature diff --git a/testsuite/tests/rename/should_fail/rnfail024.hs b/testsuite/tests/rename/should_fail/rnfail024.hs new file mode 100644 index 0000000000..4663319ce9 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail024.hs @@ -0,0 +1,6 @@ +module ShouldFail where + +sig_without_a_defn :: a -> b + +f :: a -> b +f = sig_without_a_defn diff --git a/testsuite/tests/rename/should_fail/rnfail024.stderr b/testsuite/tests/rename/should_fail/rnfail024.stderr new file mode 100644 index 0000000000..19b9f33921 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail024.stderr @@ -0,0 +1,6 @@ + +rnfail024.hs:3:1: + The type signature for `sig_without_a_defn' + lacks an accompanying binding + +rnfail024.hs:6:5: Not in scope: `sig_without_a_defn' diff --git a/testsuite/tests/rename/should_fail/rnfail024.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail024.stderr-hugs new file mode 100644 index 0000000000..1b89d6825a --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail024.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail024.hs":3 - Missing binding for variable "sig_without_a_defn" in type signature diff --git a/testsuite/tests/rename/should_fail/rnfail025.hs b/testsuite/tests/rename/should_fail/rnfail025.hs new file mode 100644 index 0000000000..42cf3d76f5 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail025.hs @@ -0,0 +1,6 @@ +module ShouldFail where + +sig_without_a_defn :: a -> b + +-- We don't even refer to the variable. This compiled without error +-- in ghc-4.08. diff --git a/testsuite/tests/rename/should_fail/rnfail025.stderr b/testsuite/tests/rename/should_fail/rnfail025.stderr new file mode 100644 index 0000000000..4c2e25a07c --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail025.stderr @@ -0,0 +1,4 @@ + +rnfail025.hs:3:1: + The type signature for `sig_without_a_defn' + lacks an accompanying binding diff --git a/testsuite/tests/rename/should_fail/rnfail025.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail025.stderr-hugs new file mode 100644 index 0000000000..7a2bcb5945 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail025.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail025.hs":3 - Missing binding for variable "sig_without_a_defn" in type signature diff --git a/testsuite/tests/rename/should_fail/rnfail026.hs b/testsuite/tests/rename/should_fail/rnfail026.hs new file mode 100644 index 0000000000..3256876e68 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail026.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE Rank2Types, FlexibleInstances #-} + +-- This one made ghc-4.08 crash +-- rename/RnEnv.lhs:239: Non-exhaustive patterns in function get_tycon_key +-- The type in the Monad instance is utterly bogus, of course + +module ShouldCompile ( Set ) where + + +data Set a = Set [a] + deriving (Eq, Ord, Read, Show) + +instance Functor Set where + f `fmap` (Set xs) = Set $ f `fmap` xs + +instance Monad (forall a. Eq a => Set a) where + return x = Set [x] + +instance Eq (forall a. [a]) where diff --git a/testsuite/tests/rename/should_fail/rnfail026.stderr b/testsuite/tests/rename/should_fail/rnfail026.stderr new file mode 100644 index 0000000000..6aa899b36d --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail026.stderr @@ -0,0 +1,10 @@ +
+rnfail026.hs:16:17:
+ Kind mis-match
+ The first argument of `Monad' should have kind `* -> *',
+ but `Set a' has kind `*'
+ In the instance declaration for `Monad (forall a. Eq a => Set a)'
+
+rnfail026.hs:19:10:
+ Illegal polymorphic or qualified type: forall a. [a]
+ In the instance declaration for `Eq (forall a. [a])'
diff --git a/testsuite/tests/rename/should_fail/rnfail026.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail026.stderr-hugs new file mode 100644 index 0000000000..245ba83337 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail026.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail026.hs":16 - Syntax error in type expression (unexpected keyword "forall") diff --git a/testsuite/tests/rename/should_fail/rnfail027.hs b/testsuite/tests/rename/should_fail/rnfail027.hs new file mode 100644 index 0000000000..fc6d8c87d4 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail027.hs @@ -0,0 +1,5 @@ +-- !!! infix declarations for unknown identifiers aren't allowed + +module ShouldFail where + +infixl 9 `wibble` diff --git a/testsuite/tests/rename/should_fail/rnfail027.stderr b/testsuite/tests/rename/should_fail/rnfail027.stderr new file mode 100644 index 0000000000..31214a1a42 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail027.stderr @@ -0,0 +1,3 @@ + +rnfail027.hs:5:10: + The fixity signature for `wibble' lacks an accompanying binding diff --git a/testsuite/tests/rename/should_fail/rnfail027.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail027.stderr-hugs new file mode 100644 index 0000000000..df1f912339 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail027.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail027.hs":5 - Cannot find binding for operator "wibble" in fixity declaration diff --git a/testsuite/tests/rename/should_fail/rnfail028.hs b/testsuite/tests/rename/should_fail/rnfail028.hs new file mode 100644 index 0000000000..13e2237aba --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail028.hs @@ -0,0 +1,2 @@ +-- !!! illegal to export a module we haven't imported. +module ShouldFail ( module List ) where diff --git a/testsuite/tests/rename/should_fail/rnfail028.stderr b/testsuite/tests/rename/should_fail/rnfail028.stderr new file mode 100644 index 0000000000..f09cda3f33 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail028.stderr @@ -0,0 +1,2 @@ + +rnfail028.hs:2:21: The export item `module List' is not imported diff --git a/testsuite/tests/rename/should_fail/rnfail028.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail028.stderr-hugs new file mode 100644 index 0000000000..d1aa3d5903 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail028.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail028.hs" - Unknown module "List" exported from module "ShouldFail" diff --git a/testsuite/tests/rename/should_fail/rnfail029.hs b/testsuite/tests/rename/should_fail/rnfail029.hs new file mode 100644 index 0000000000..8d8608e41f --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail029.hs @@ -0,0 +1,4 @@ +-- !!! conflicting exports for a function name +module ShouldFail ( Data.List.map, module ShouldFail ) where +import qualified Data.List +map = undefined diff --git a/testsuite/tests/rename/should_fail/rnfail029.stderr b/testsuite/tests/rename/should_fail/rnfail029.stderr new file mode 100644 index 0000000000..e22f4c33ae --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail029.stderr @@ -0,0 +1,5 @@ + +rnfail029.hs:2:36: + Conflicting exports for `map': + `Data.List.map' exports `Data.List.map' imported from Data.List at rnfail029.hs:3:1-26 + `module ShouldFail' exports `ShouldFail.map' defined at rnfail029.hs:4:1 diff --git a/testsuite/tests/rename/should_fail/rnfail029.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail029.stderr-hugs new file mode 100644 index 0000000000..a2f0265916 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail029.stderr-hugs @@ -0,0 +1,2 @@ +ERROR "rnfail029.hs" - Conflicting exports of entity "map" +*** Could refer to Hugs.Prelude.map or ShouldFail.map diff --git a/testsuite/tests/rename/should_fail/rnfail030.hs b/testsuite/tests/rename/should_fail/rnfail030.hs new file mode 100644 index 0000000000..23c54c8feb --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail030.hs @@ -0,0 +1,3 @@ +-- !!! check that unqualified imports don't bring qualified names into scope +module ShouldFail ( Data.List.map ) where +import Data.List () diff --git a/testsuite/tests/rename/should_fail/rnfail030.stderr b/testsuite/tests/rename/should_fail/rnfail030.stderr new file mode 100644 index 0000000000..749206a814 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail030.stderr @@ -0,0 +1,2 @@ + +rnfail030.hs:2:21: Not in scope: `Data.List.map' diff --git a/testsuite/tests/rename/should_fail/rnfail030.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail030.stderr-hugs new file mode 100644 index 0000000000..eb846ddfac --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail030.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail030.hs" - Unknown entity "List.map" exported from module "ShouldFail" diff --git a/testsuite/tests/rename/should_fail/rnfail031.hs b/testsuite/tests/rename/should_fail/rnfail031.hs new file mode 100644 index 0000000000..ce86cf935a --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail031.hs @@ -0,0 +1,3 @@ +-- !!! check that qualified imports can be restricted to certain names +module ShouldFail ( Data.List.map ) where +import qualified Data.List ( foldr ) diff --git a/testsuite/tests/rename/should_fail/rnfail031.stderr b/testsuite/tests/rename/should_fail/rnfail031.stderr new file mode 100644 index 0000000000..ad04461dc3 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail031.stderr @@ -0,0 +1,2 @@ + +rnfail031.hs:2:21: Not in scope: `Data.List.map' diff --git a/testsuite/tests/rename/should_fail/rnfail031.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail031.stderr-hugs new file mode 100644 index 0000000000..2036937995 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail031.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail031.hs" - Unknown entity "List.map" exported from module "ShouldFail" diff --git a/testsuite/tests/rename/should_fail/rnfail032.hs b/testsuite/tests/rename/should_fail/rnfail032.hs new file mode 100644 index 0000000000..2970030ab0 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail032.hs @@ -0,0 +1,3 @@ +-- !!! check that hiding works with qualified imports +module ShouldFail ( Data.List.map ) where +import qualified Data.List hiding ( map ) diff --git a/testsuite/tests/rename/should_fail/rnfail032.stderr b/testsuite/tests/rename/should_fail/rnfail032.stderr new file mode 100644 index 0000000000..ea80202dd0 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail032.stderr @@ -0,0 +1,7 @@ + +rnfail032.hs:2:21: + Not in scope: `Data.List.map' + Perhaps you meant one of these: + `Data.List.zip' (imported from Data.List), + `Data.List.sum' (imported from Data.List), + `Data.List.all' (imported from Data.List) diff --git a/testsuite/tests/rename/should_fail/rnfail032.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail032.stderr-hugs new file mode 100644 index 0000000000..fef6e8e210 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail032.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail032.hs" - Unknown entity "List.map" exported from module "ShouldFail" diff --git a/testsuite/tests/rename/should_fail/rnfail033.hs b/testsuite/tests/rename/should_fail/rnfail033.hs new file mode 100644 index 0000000000..7d8b4c4fdc --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail033.hs @@ -0,0 +1,3 @@ +-- !!! check that hiding on an unqualified import also hides the qualified name +module ShouldFail ( Data.List.map ) where +import Data.List hiding ( map ) diff --git a/testsuite/tests/rename/should_fail/rnfail033.stderr b/testsuite/tests/rename/should_fail/rnfail033.stderr new file mode 100644 index 0000000000..c9abd0f87a --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail033.stderr @@ -0,0 +1,7 @@ + +rnfail033.hs:2:21: + Not in scope: `Data.List.map' + Perhaps you meant one of these: + `Data.List.zip' (imported from Data.List), + `Data.List.sum' (imported from Data.List), + `Data.List.all' (imported from Data.List) diff --git a/testsuite/tests/rename/should_fail/rnfail033.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail033.stderr-hugs new file mode 100644 index 0000000000..d651e56ebe --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail033.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail033.hs" - Unknown entity "List.map" exported from module "ShouldFail" diff --git a/testsuite/tests/rename/should_fail/rnfail034.hs b/testsuite/tests/rename/should_fail/rnfail034.hs new file mode 100644 index 0000000000..25d9189472 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail034.hs @@ -0,0 +1,4 @@ +-- !!! qualified names aren't allowed in local binds either +-- (Haskell 98 (revised) section 5.5.1) +module M where +g x = let M.y = x + 1 in M.y diff --git a/testsuite/tests/rename/should_fail/rnfail034.stderr b/testsuite/tests/rename/should_fail/rnfail034.stderr new file mode 100644 index 0000000000..2ec0a3b8e5 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail034.stderr @@ -0,0 +1,6 @@ + +rnfail034.hs:4:11: Qualified name in binding position: M.y + +rnfail034.hs:4:26: + Not in scope: `M.y' + Perhaps you meant `M.g' (line 4) diff --git a/testsuite/tests/rename/should_fail/rnfail034.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail034.stderr-hugs new file mode 100644 index 0000000000..e1e0a9a566 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail034.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail034.hs":4 - Syntax error in expression (unexpected symbol "M.y") diff --git a/testsuite/tests/rename/should_fail/rnfail035.hs b/testsuite/tests/rename/should_fail/rnfail035.hs new file mode 100644 index 0000000000..4f57c06374 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail035.hs @@ -0,0 +1,3 @@ +-- !!! can't name a constructor in an export list +module ShouldFail ( C ) where +data T = C diff --git a/testsuite/tests/rename/should_fail/rnfail035.stderr b/testsuite/tests/rename/should_fail/rnfail035.stderr new file mode 100644 index 0000000000..83eb2d85e3 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail035.stderr @@ -0,0 +1,2 @@ + +rnfail035.hs:2:21: Not in scope: type constructor or class `C' diff --git a/testsuite/tests/rename/should_fail/rnfail035.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail035.stderr-hugs new file mode 100644 index 0000000000..105e56f36c --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail035.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail035.hs" - Illegal export of a lone data constructor "C" diff --git a/testsuite/tests/rename/should_fail/rnfail038.hs b/testsuite/tests/rename/should_fail/rnfail038.hs new file mode 100644 index 0000000000..b96000a873 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail038.hs @@ -0,0 +1,4 @@ +-- !!! It is now illegal to import a module hiding +-- !!! an entity that it doesn't export +module ShouldCompile where +import Data.List hiding ( wibble ) diff --git a/testsuite/tests/rename/should_fail/rnfail038.stderr b/testsuite/tests/rename/should_fail/rnfail038.stderr new file mode 100644 index 0000000000..71c31d6d1b --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail038.stderr @@ -0,0 +1,2 @@ + +rnfail038.hs:4:27: Module `Data.List' does not export `wibble' diff --git a/testsuite/tests/rename/should_fail/rnfail038.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail038.stderr-hugs new file mode 100644 index 0000000000..ee3487e0d4 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail038.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail038.hs" - Unknown entity "wibble" hidden from module "List" diff --git a/testsuite/tests/rename/should_fail/rnfail039.hs b/testsuite/tests/rename/should_fail/rnfail039.hs new file mode 100644 index 0000000000..428d8d9716 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail039.hs @@ -0,0 +1,12 @@ +-- !!! Checking that qualified method names are ILLEGAL +-- in the binding position instance body. +module ShouldFail where + +import Prelude hiding (Eq, (==)) +import Prelude as P (Eq,(==)) + +data Foo = Foo Int Integer + +instance P.Eq Foo where + (Foo a1 b1) P.== (Foo a2 b2) = a1 P.== a2 && b1 P.== b2 + diff --git a/testsuite/tests/rename/should_fail/rnfail039.stderr b/testsuite/tests/rename/should_fail/rnfail039.stderr new file mode 100644 index 0000000000..6283dccd33 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail039.stderr @@ -0,0 +1,2 @@ + +rnfail039.hs:11:15: Qualified name in binding position: P.== diff --git a/testsuite/tests/rename/should_fail/rnfail039.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail039.stderr-hugs new file mode 100644 index 0000000000..43c760998e --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail039.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail039.hs":11 - Syntax error in declaration (unexpected symbol "P.==") diff --git a/testsuite/tests/rename/should_fail/rnfail040.hs b/testsuite/tests/rename/should_fail/rnfail040.hs new file mode 100644 index 0000000000..5ba4d41bec --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail040.hs @@ -0,0 +1,11 @@ +-- This one should fail, because it exports +-- both Data.List:nub and Rnfail040_A:nub +-- +-- Data.List:nub is in scope as M.nub and nub +-- Rnfail040_A:nub is in scope as T.nub, M.nub, and nub + +module M1 (module M) where + + import qualified Rnfail040_A as M -- M.nub + import Data.List as M -- M.nub nub + import Rnfail040_A as T -- T.nub nub diff --git a/testsuite/tests/rename/should_fail/rnfail040.stderr b/testsuite/tests/rename/should_fail/rnfail040.stderr new file mode 100644 index 0000000000..25e3c1153f --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail040.stderr @@ -0,0 +1,6 @@ + +rnfail040.hs:7:12: + Conflicting exports for `nub': + `module M' exports `M.nub' imported from Data.List at rnfail040.hs:10:2-22 + `module M' exports `T.nub' imported from Rnfail040_A at rnfail040.hs:11:2-24 + (defined at Rnfail040_A.hs:2:3) diff --git a/testsuite/tests/rename/should_fail/rnfail040.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail040.stderr-hugs new file mode 100644 index 0000000000..913c1b455c --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail040.stderr-hugs @@ -0,0 +1,2 @@ +ERROR "rnfail040.hs" - Conflicting exports of entity "nub" +*** Could refer to Data.List.nub or Rnfail040_A.nub diff --git a/testsuite/tests/rename/should_fail/rnfail041.hs b/testsuite/tests/rename/should_fail/rnfail041.hs new file mode 100644 index 0000000000..57f79705b5 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail041.hs @@ -0,0 +1,7 @@ +f = 3 +g = 3 + +h :: Int +j :: Int + + diff --git a/testsuite/tests/rename/should_fail/rnfail041.stderr b/testsuite/tests/rename/should_fail/rnfail041.stderr new file mode 100644 index 0000000000..0c5c60d4d2 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail041.stderr @@ -0,0 +1,6 @@ + +rnfail041.hs:4:1: + The type signature for `h' lacks an accompanying binding + +rnfail041.hs:5:1: + The type signature for `j' lacks an accompanying binding diff --git a/testsuite/tests/rename/should_fail/rnfail041.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail041.stderr-hugs new file mode 100644 index 0000000000..2b8745ec9b --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail041.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail041.hs":4 - Missing binding for variable "h" in type signature diff --git a/testsuite/tests/rename/should_fail/rnfail042.hs b/testsuite/tests/rename/should_fail/rnfail042.hs new file mode 100644 index 0000000000..16c01f3450 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail042.hs @@ -0,0 +1,9 @@ +-- Uses of built-in syntax should provoke a decent error message + +module ShouldFail where + +data T0 = () +data T3= (,,,) +data Nil = [] +data List = Int : Bool + diff --git a/testsuite/tests/rename/should_fail/rnfail042.stderr b/testsuite/tests/rename/should_fail/rnfail042.stderr new file mode 100644 index 0000000000..9e030d7bf8 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail042.stderr @@ -0,0 +1,8 @@ + +rnfail042.hs:5:11: Illegal binding of built-in syntax: () + +rnfail042.hs:6:10: Illegal binding of built-in syntax: (,,,) + +rnfail042.hs:7:12: Illegal binding of built-in syntax: [] + +rnfail042.hs:8:17: Illegal binding of built-in syntax: : diff --git a/testsuite/tests/rename/should_fail/rnfail042.stderr-hugs b/testsuite/tests/rename/should_fail/rnfail042.stderr-hugs new file mode 100644 index 0000000000..66c517d13c --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail042.stderr-hugs @@ -0,0 +1 @@ +ERROR "rnfail042.hs":6 - Syntax error in data type declaration (unexpected `;', possibly due to bad layout) diff --git a/testsuite/tests/rename/should_fail/rnfail043.hs b/testsuite/tests/rename/should_fail/rnfail043.hs new file mode 100644 index 0000000000..492cebb516 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail043.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TemplateHaskell #-}
+
+-- Duplicate bindings introduced one at a time with TH
+module ShouldFail where
+
+f x = x
+
+$([d| h x = x |])
+
+f x = x
diff --git a/testsuite/tests/rename/should_fail/rnfail043.stderr b/testsuite/tests/rename/should_fail/rnfail043.stderr new file mode 100644 index 0000000000..428c1944dc --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail043.stderr @@ -0,0 +1,5 @@ + +rnfail043.hs:10:1: + Multiple declarations of `f' + Declared at: rnfail043.hs:6:1 + rnfail043.hs:10:1 diff --git a/testsuite/tests/rename/should_fail/rnfail044.hs b/testsuite/tests/rename/should_fail/rnfail044.hs new file mode 100644 index 0000000000..ed72b9abae --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail044.hs @@ -0,0 +1,8 @@ +-- Renamer test +-- The ambiguity is between the Prelude import and the defn +-- of splitAt. The import of Data.List has nothing to do with it. + +module A ( splitAt ) where + + import qualified Data.List + splitAt = undefined diff --git a/testsuite/tests/rename/should_fail/rnfail044.stderr b/testsuite/tests/rename/should_fail/rnfail044.stderr new file mode 100644 index 0000000000..2b27ad4fea --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail044.stderr @@ -0,0 +1,5 @@ + +rnfail044.hs:5:12: + Ambiguous occurrence `splitAt' + It could refer to either `A.splitAt', defined at rnfail044.hs:8:3 + or `Data.List.splitAt', imported from Prelude diff --git a/testsuite/tests/rename/should_fail/rnfail045.hs b/testsuite/tests/rename/should_fail/rnfail045.hs new file mode 100644 index 0000000000..641bec0a6a --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail045.hs @@ -0,0 +1,9 @@ +-- These crashed GHC 6.4.2 + +module ShouldFail where + +x `op1` y = True +op1 x = False + +op2 x = False +x `op2` y = True diff --git a/testsuite/tests/rename/should_fail/rnfail045.stderr b/testsuite/tests/rename/should_fail/rnfail045.stderr new file mode 100644 index 0000000000..d8c80008c0 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail045.stderr @@ -0,0 +1,10 @@ + +rnfail045.hs:5:1: + Equations for `op1' have different numbers of arguments + rnfail045.hs:5:1-16 + rnfail045.hs:6:1-13 + +rnfail045.hs:8:1: + Equations for `op2' have different numbers of arguments + rnfail045.hs:8:1-13 + rnfail045.hs:9:1-16 diff --git a/testsuite/tests/rename/should_fail/rnfail046.hs b/testsuite/tests/rename/should_fail/rnfail046.hs new file mode 100644 index 0000000000..f8aa7a734c --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail046.hs @@ -0,0 +1,4 @@ +-- Qualified name in binding position
+module ShouldFail where
+
+data Test = Map.Map Int Int
diff --git a/testsuite/tests/rename/should_fail/rnfail046.stderr b/testsuite/tests/rename/should_fail/rnfail046.stderr new file mode 100644 index 0000000000..49cfe356f4 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail046.stderr @@ -0,0 +1,2 @@ + +rnfail046.hs:4:13: Qualified name in binding position: Map.Map diff --git a/testsuite/tests/rename/should_fail/rnfail047.hs b/testsuite/tests/rename/should_fail/rnfail047.hs new file mode 100644 index 0000000000..55bd0b8d68 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail047.hs @@ -0,0 +1,9 @@ + +-- trac #924: RnFail047_A.hs-boot exports more than RnFail047_A.hs + +module RnFail047 where + +import {-# SOURCE #-} RnFail047_A + +v = x + diff --git a/testsuite/tests/rename/should_fail/rnfail047.stderr b/testsuite/tests/rename/should_fail/rnfail047.stderr new file mode 100644 index 0000000000..380bbd906b --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail047.stderr @@ -0,0 +1,3 @@ + +RnFail047_A.hs-boot:5:1: + RnFail047_A.y is exported by the hs-boot file, but not exported by the module diff --git a/testsuite/tests/rename/should_fail/rnfail048.hs b/testsuite/tests/rename/should_fail/rnfail048.hs new file mode 100644 index 0000000000..d1c8d73eb0 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail048.hs @@ -0,0 +1,13 @@ +-- Trac #1888 +-- Pretty printing for pragmas + +module ShouldFail where + +{-# NOINLINE[1] foo #-} +{-# NOINLINE[~2] foo #-} +{-# NOINLINE foo #-} +{-# INLINE[1] foo #-} +{-# INLINE[~2] foo #-} +{-# INLINE foo #-} + +foo n = foo (n+1) diff --git a/testsuite/tests/rename/should_fail/rnfail048.stderr b/testsuite/tests/rename/should_fail/rnfail048.stderr new file mode 100644 index 0000000000..885229d745 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail048.stderr @@ -0,0 +1,9 @@ + +rnfail048.hs:11:1: + Duplicate INLINE pragma: + rnfail048.hs:11:1-18: {-# INLINE foo #-} + rnfail048.hs:10:1-22: {-# INLINE[~2] foo #-} + rnfail048.hs:9:1-21: {-# INLINE[1] foo #-} + rnfail048.hs:8:1-20: {-# NOINLINE foo #-} + rnfail048.hs:7:1-24: {-# NOINLINE[~2] foo #-} + rnfail048.hs:6:1-23: {-# NOINLINE[1] foo #-} diff --git a/testsuite/tests/rename/should_fail/rnfail049.hs b/testsuite/tests/rename/should_fail/rnfail049.hs new file mode 100644 index 0000000000..7f4b6c7842 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail049.hs @@ -0,0 +1,14 @@ +-- Test trying to use a function bound in the list comprehension as the group function
+
+{-# OPTIONS_GHC -XRank2Types -XTransformListComp #-}
+
+module RnFail049 where
+
+import Data.List(inits, tails)
+
+functions :: [forall a. [a] -> [[a]]]
+functions = [inits, tails]
+
+output = [() | f <- functions, then group using f]
+
+
diff --git a/testsuite/tests/rename/should_fail/rnfail049.stderr b/testsuite/tests/rename/should_fail/rnfail049.stderr new file mode 100644 index 0000000000..6b753fbf2d --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail049.stderr @@ -0,0 +1,2 @@ + +rnfail049.hs:12:49: Not in scope: `f' diff --git a/testsuite/tests/rename/should_fail/rnfail050.hs b/testsuite/tests/rename/should_fail/rnfail050.hs new file mode 100644 index 0000000000..0c3b262a0f --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail050.hs @@ -0,0 +1,12 @@ +-- Test trying to use a function bound in the list comprehension as the transform function + +{-# OPTIONS_GHC -XRank2Types -XTransformListComp #-} + +module RnFail048 where + +functions :: [forall a. [a] -> [a]] +functions = [take 4, take 5] + +output = [() | f <- functions, then f] + + diff --git a/testsuite/tests/rename/should_fail/rnfail050.stderr b/testsuite/tests/rename/should_fail/rnfail050.stderr new file mode 100644 index 0000000000..d097fc5b44 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail050.stderr @@ -0,0 +1,2 @@ + +rnfail050.hs:10:37: Not in scope: `f' diff --git a/testsuite/tests/rename/should_fail/rnfail051.hs b/testsuite/tests/rename/should_fail/rnfail051.hs new file mode 100644 index 0000000000..227e040033 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail051.hs @@ -0,0 +1,11 @@ +-- trac #2033: This used to fail when the renamer didn't check for a view +-- /pattern/ being used in an /expression/ context + +module RnFail051 where + +main :: IO () +main = wrapper (_ -> putStrLn "_") + +wrapper :: (String -> IO ()) -> IO () +wrapper f = f "" + diff --git a/testsuite/tests/rename/should_fail/rnfail051.stderr b/testsuite/tests/rename/should_fail/rnfail051.stderr new file mode 100644 index 0000000000..36eccc5724 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail051.stderr @@ -0,0 +1,3 @@ + +rnfail051.hs:7:17: + Pattern syntax in expression context: _ -> putStrLn "_" diff --git a/testsuite/tests/rename/should_fail/rnfail052.hs b/testsuite/tests/rename/should_fail/rnfail052.hs new file mode 100644 index 0000000000..63a0dfd6d1 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail052.hs @@ -0,0 +1,15 @@ +-- Error messages when you use 'forall' *without* the RankN flags +-- Test cases similar to Trac #2114 + +module ShouldFail where + +f :: forall a. a->a +f = error "ur" + +g :: Int -> (forall a. a-> a) -> Int +g = error "ur" + +data S = MkS (forall a. a->a) + -- This one complains about 'a' and 'forall' not in scope + -- because they aren't implicitly quantified, + -- whereas implicit quantification deals with the first two diff --git a/testsuite/tests/rename/should_fail/rnfail052.stderr b/testsuite/tests/rename/should_fail/rnfail052.stderr new file mode 100644 index 0000000000..f6d0929bca --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail052.stderr @@ -0,0 +1,5 @@ + +rnfail052.hs:6:14: + Illegal symbol '.' in type + Perhaps you intended -XRankNTypes or similar flag + to enable explicit-forall syntax: forall <tvs>. <type> diff --git a/testsuite/tests/rename/should_fail/rnfail053.hs b/testsuite/tests/rename/should_fail/rnfail053.hs new file mode 100644 index 0000000000..dbc219271b --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail053.hs @@ -0,0 +1,6 @@ +-- Test Trac #2114 (error message) + +module ShouldFail where + +data T = forall a. MkT a + diff --git a/testsuite/tests/rename/should_fail/rnfail053.stderr b/testsuite/tests/rename/should_fail/rnfail053.stderr new file mode 100644 index 0000000000..47f44c4464 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail053.stderr @@ -0,0 +1,4 @@ + +rnfail053.hs:5:10: + Not a data constructor: `forall' + Perhaps you intended to use -XExistentialQuantification diff --git a/testsuite/tests/rename/should_fail/rnfail054.hs b/testsuite/tests/rename/should_fail/rnfail054.hs new file mode 100644 index 0000000000..f83a0f9970 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail054.hs @@ -0,0 +1,6 @@ +-- Test for trac #2141 + +module Foo where + +foo :: () -> () +foo x = x { foo = 1 } diff --git a/testsuite/tests/rename/should_fail/rnfail054.stderr b/testsuite/tests/rename/should_fail/rnfail054.stderr new file mode 100644 index 0000000000..ab952aadeb --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail054.stderr @@ -0,0 +1,5 @@ + +rnfail054.hs:6:13: + `foo' is not a record selector + In the expression: x {foo = 1} + In an equation for `foo': foo x = x {foo = 1} diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr new file mode 100644 index 0000000000..7c30e7828e --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail055.stderr @@ -0,0 +1,107 @@ + +RnFail055.hs:1:73: + Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. + +RnFail055.hs-boot:1:73: + Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. + +RnFail055.hs-boot:4:1: + Identifier `f1' has conflicting definitions in the module and its hs-boot file + Main module: f1 :: Int -> Float + Boot file: f1 :: Float -> Int + +RnFail055.hs-boot:6:6: + Type constructor `S1' has conflicting definitions in the module and its hs-boot file + Main module: type S1 a b + = (a, b) + FamilyInstance: none + Boot file: type S1 a b c + = (a, b) + FamilyInstance: none + +RnFail055.hs-boot:8:6: + Type constructor `S2' has conflicting definitions in the module and its hs-boot file + Main module: type S2 a b + = forall a. (a, b) + FamilyInstance: none + Boot file: type S2 a b + = forall b. (a, b) + FamilyInstance: none + +RnFail055.hs-boot:12:6: + Type constructor `T1' has conflicting definitions in the module and its hs-boot file + Main module: data T1 a b + RecFlag Recursive + = T1 :: forall a b. [b] -> [a] -> T1 a b Stricts: _ _ + FamilyInstance: none + Boot file: data T1 a b + RecFlag NonRecursive + = T1 :: forall a b. [a] -> [b] -> T1 a b Stricts: _ _ + FamilyInstance: none + +RnFail055.hs-boot:14:16: + Type constructor `T2' has conflicting definitions in the module and its hs-boot file + Main module: data Eq b => T2 a b + RecFlag Recursive + = T2 :: forall a b. a -> T2 a b Stricts: _ + FamilyInstance: none + Boot file: data Eq a => T2 a b + RecFlag NonRecursive + = T2 :: forall a b. a -> T2 a b Stricts: _ + FamilyInstance: none + +RnFail055.hs-boot:16:11: + T3 is exported by the hs-boot file, but not exported by the module + +RnFail055.hs-boot:17:12: + T3' is exported by the hs-boot file, but not exported by the module + +RnFail055.hs-boot:21:6: + Type constructor `T5' has conflicting definitions in the module and its hs-boot file + Main module: data T5 a + RecFlag Recursive + = T5 :: forall a. a -> T5 a Stricts: _ Fields: field5 + FamilyInstance: none + Boot file: data T5 a + RecFlag NonRecursive + = T5 :: forall a. a -> T5 a Stricts: _ + FamilyInstance: none + +RnFail055.hs-boot:23:6: + Type constructor `T6' has conflicting definitions in the module and its hs-boot file + Main module: data T6 + RecFlag Recursive + = T6 :: Int -> T6 Stricts: _ + FamilyInstance: none + Boot file: data T6 + RecFlag NonRecursive + = T6 :: Int -> T6 HasWrapper Stricts: ! + FamilyInstance: none + +RnFail055.hs-boot:25:6: + Type constructor `T7' has conflicting definitions in the module and its hs-boot file + Main module: data T7 a + RecFlag Recursive + = T7 :: forall a a. a -> T7 a Stricts: _ + FamilyInstance: none + Boot file: data T7 a + RecFlag NonRecursive + = T7 :: forall a b. a -> T7 a Stricts: _ + FamilyInstance: none + +RnFail055.hs-boot:27:22: + RnFail055.m1 is exported by the hs-boot file, but not exported by the module + +RnFail055.hs-boot:28:7: + Class `C2' has conflicting definitions in the module and its hs-boot file + Main module: class C2 a b + RecFlag NonRecursive + m2 :: a -> b m2' :: a -> b + Boot file: class C2 a b + RecFlag NonRecursive + m2 :: a -> b + +RnFail055.hs-boot:29:24: + Class `C3' has conflicting definitions in the module and its hs-boot file + Main module: class (Eq a, Ord a) => C3 a RecFlag NonRecursive + Boot file: class (Ord a, Eq a) => C3 a RecFlag NonRecursive diff --git a/testsuite/tests/rename/should_fail/rnfail056.hs b/testsuite/tests/rename/should_fail/rnfail056.hs new file mode 100644 index 0000000000..23ec008dc6 --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail056.hs @@ -0,0 +1,8 @@ +-- TupleSections not enabled +{-# LANGUAGE UnboxedTuples #-} + +module Foo where + +foo = (1,) + +bar = (# 1, #) diff --git a/testsuite/tests/rename/should_fail/rnfail056.stderr b/testsuite/tests/rename/should_fail/rnfail056.stderr new file mode 100644 index 0000000000..3ddf502dee --- /dev/null +++ b/testsuite/tests/rename/should_fail/rnfail056.stderr @@ -0,0 +1,4 @@ + +rnfail056.hs:6:7: Illegal tuple section: use -XTupleSections + +rnfail056.hs:8:7: Illegal tuple section: use -XTupleSections |