diff options
Diffstat (limited to 'testsuite/tests/ghc-regress')
236 files changed, 1157 insertions, 0 deletions
diff --git a/testsuite/tests/ghc-regress/module/Makefile b/testsuite/tests/ghc-regress/module/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/ghc-regress/module/Mod101_AuxA.hs b/testsuite/tests/ghc-regress/module/Mod101_AuxA.hs new file mode 100644 index 0000000000..39ff86868d --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod101_AuxA.hs @@ -0,0 +1,5 @@ +-- +-- Helper module for mod101.hs +module Mod101_AuxA where + +data DataA = ConA Int | ConB Bool diff --git a/testsuite/tests/ghc-regress/module/Mod101_AuxB.hs b/testsuite/tests/ghc-regress/module/Mod101_AuxB.hs new file mode 100644 index 0000000000..af05c72510 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod101_AuxB.hs @@ -0,0 +1,6 @@ +-- +-- Helper module for mod101.hs +-- +module Mod101_AuxB ( DataA(..) ) where + +import Mod101_AuxA ( DataA(ConA) ) diff --git a/testsuite/tests/ghc-regress/module/Mod102_AuxA.hs b/testsuite/tests/ghc-regress/module/Mod102_AuxA.hs new file mode 100644 index 0000000000..dfa478e542 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod102_AuxA.hs @@ -0,0 +1,9 @@ +-- +-- Helper module for mod102.hs +-- +module Mod102_AuxA where + +class ClassA a where + methA :: Int -> a + methB :: Bool -> a + diff --git a/testsuite/tests/ghc-regress/module/Mod102_AuxB.hs b/testsuite/tests/ghc-regress/module/Mod102_AuxB.hs new file mode 100644 index 0000000000..71fc071e78 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod102_AuxB.hs @@ -0,0 +1,6 @@ +-- +-- Helper module for mod102.hs +-- +module Mod102_AuxB ( ClassA(..) ) where + +import Mod102_AuxA ( ClassA(methA) ) diff --git a/testsuite/tests/ghc-regress/module/Mod114_Help.hs b/testsuite/tests/ghc-regress/module/Mod114_Help.hs new file mode 100644 index 0000000000..46e8fc53ea --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod114_Help.hs @@ -0,0 +1 @@ +module Mod114_Help(Stuff(Foo, Bar)) where data Stuff = Foo | Bar diff --git a/testsuite/tests/ghc-regress/module/Mod115_A.hs b/testsuite/tests/ghc-regress/module/Mod115_A.hs new file mode 100644 index 0000000000..77430951c1 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod115_A.hs @@ -0,0 +1,11 @@ +-- re-exporting m2 outside of C(..) +module Mod115_A( C(m1), m2) where + +class C a where + m1 :: a -> Int + m2 :: a -> Bool + +instance C Int where + m1 _ = 1 + m2 _ = True + diff --git a/testsuite/tests/ghc-regress/module/Mod115_B.hs b/testsuite/tests/ghc-regress/module/Mod115_B.hs new file mode 100644 index 0000000000..d344c442b6 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod115_B.hs @@ -0,0 +1,4 @@ +-- re-export all of C +module Mod115_B (C(..)) where + +import Mod115_A (C(m1), m2) diff --git a/testsuite/tests/ghc-regress/module/Mod117_A.hs b/testsuite/tests/ghc-regress/module/Mod117_A.hs new file mode 100644 index 0000000000..259bb76681 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod117_A.hs @@ -0,0 +1,5 @@ +-- re-exporting m2 outside of T(..) +module Mod117_A( T(T,m1), m2) where + +data T = T { m1 :: Int, m2 :: Int} + diff --git a/testsuite/tests/ghc-regress/module/Mod117_B.hs b/testsuite/tests/ghc-regress/module/Mod117_B.hs new file mode 100644 index 0000000000..d1711b1d89 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod117_B.hs @@ -0,0 +1,4 @@ +-- re-export all of T +module Mod117_B (T(..)) where + +import Mod117_A ( T(T,m1),m2 ) diff --git a/testsuite/tests/ghc-regress/module/Mod118_A.hs b/testsuite/tests/ghc-regress/module/Mod118_A.hs new file mode 100644 index 0000000000..b52fbfa7df --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod118_A.hs @@ -0,0 +1,11 @@ +-- re-exporting m2 outside of C(..) +module Mod118_A( C(m1), m2) where + +class C a where + m1 :: a -> Int + m2 :: a -> Bool + +instance C Int where + m1 _ = 1 + m2 _ = True + diff --git a/testsuite/tests/ghc-regress/module/Mod118_B.hs b/testsuite/tests/ghc-regress/module/Mod118_B.hs new file mode 100644 index 0000000000..21852215da --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod118_B.hs @@ -0,0 +1,5 @@ +-- re-export all of C +module Mod118_B (C(..)) where + +import Mod118_A hiding (C(m1)) +import Mod118_A (C) diff --git a/testsuite/tests/ghc-regress/module/Mod119_A.hs b/testsuite/tests/ghc-regress/module/Mod119_A.hs new file mode 100644 index 0000000000..b07646cee0 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod119_A.hs @@ -0,0 +1,2 @@ +module Mod119_A(f) where +f = id diff --git a/testsuite/tests/ghc-regress/module/Mod119_B.hs b/testsuite/tests/ghc-regress/module/Mod119_B.hs new file mode 100644 index 0000000000..79f1dfb732 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod119_B.hs @@ -0,0 +1,2 @@ +module Mod119_B (module Mod119_A) where +import Mod119_A diff --git a/testsuite/tests/ghc-regress/module/Mod120_A.hs b/testsuite/tests/ghc-regress/module/Mod120_A.hs new file mode 100644 index 0000000000..2ec3c2be55 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod120_A.hs @@ -0,0 +1,3 @@ +module Mod120_A(T) where + +data T = Foo diff --git a/testsuite/tests/ghc-regress/module/Mod121_A.hs b/testsuite/tests/ghc-regress/module/Mod121_A.hs new file mode 100644 index 0000000000..4648f3da08 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod121_A.hs @@ -0,0 +1,5 @@ +module Mod121_A(C(m1)) where + +class C a where + m1 :: a -> Int + m2 :: a -> Bool diff --git a/testsuite/tests/ghc-regress/module/Mod122_A.hs b/testsuite/tests/ghc-regress/module/Mod122_A.hs new file mode 100644 index 0000000000..93b7076551 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod122_A.hs @@ -0,0 +1,3 @@ +module Mod122_A (m1) where + +class C a where m1 :: a -> a diff --git a/testsuite/tests/ghc-regress/module/Mod123_A.hs b/testsuite/tests/ghc-regress/module/Mod123_A.hs new file mode 100644 index 0000000000..7ec23e6172 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod123_A.hs @@ -0,0 +1,3 @@ +module Mod123_A (f1) where + +data T = MkT { f1 :: Int } diff --git a/testsuite/tests/ghc-regress/module/Mod124_A.hs b/testsuite/tests/ghc-regress/module/Mod124_A.hs new file mode 100644 index 0000000000..8e9310bb32 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod124_A.hs @@ -0,0 +1,3 @@ +module Mod124_A where + +data T = T diff --git a/testsuite/tests/ghc-regress/module/Mod126_A.hs b/testsuite/tests/ghc-regress/module/Mod126_A.hs new file mode 100644 index 0000000000..8c2d36491c --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod126_A.hs @@ -0,0 +1,6 @@ +module Mod126_A where + +class T a where m1 :: a -> a + +data T1 = T + diff --git a/testsuite/tests/ghc-regress/module/Mod128_A.hs b/testsuite/tests/ghc-regress/module/Mod128_A.hs new file mode 100644 index 0000000000..e2df4aca73 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod128_A.hs @@ -0,0 +1,5 @@ +-- repeated exports of a type/class accumulate. +module Mod128_A(T,T(Con)) where + +data T = Con + diff --git a/testsuite/tests/ghc-regress/module/Mod131_A.hs b/testsuite/tests/ghc-regress/module/Mod131_A.hs new file mode 100644 index 0000000000..5206ee4a23 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod131_A.hs @@ -0,0 +1,4 @@ +module Mod131_A (f) where + +f x = x + diff --git a/testsuite/tests/ghc-regress/module/Mod131_B.hs b/testsuite/tests/ghc-regress/module/Mod131_B.hs new file mode 100644 index 0000000000..ff7f83e76c --- /dev/null +++ b/testsuite/tests/ghc-regress/module/Mod131_B.hs @@ -0,0 +1,6 @@ +module Mod131_B(f) where + +f = 'a' + + + diff --git a/testsuite/tests/ghc-regress/module/all.T b/testsuite/tests/ghc-regress/module/all.T new file mode 100644 index 0000000000..96ae673c8f --- /dev/null +++ b/testsuite/tests/ghc-regress/module/all.T @@ -0,0 +1,152 @@ +# These tests were swiped from the hugs98 source tree, in hugs98/tests/static, +# on 16/10/2002. +# +# I used something like this to partly-automate the transition: +# +# for i in mod*.hs; do +# if ! test -f ${i%.hs}.output; then +# echo "test('${i%.hs}', normal, compile, [''])" +# else if grep error ${i%.hs}.output >/dev/null; then +# echo "test('${i%.hs}', normal, compile_fail, [''])" +# else +# echo "test('${i%.hs}', normal, compile, [''])" +# fi fi +# done +# +# A few of the tests use Hugs-specific extensions, and have been +# commented out. + +# No point in doing anything except the normal way for renamer tests +setTestOpts(only_ways(['normal'])); + +test('mod1', normal, compile_fail, ['']) +test('mod2', normal, compile_fail, ['']) +test('mod3', normal, compile_fail, ['']) +test('mod4', normal, compile_fail, ['']) +test('mod5', normal, compile, ['']) +test('mod6', normal, compile, ['']) +test('mod7', normal, compile_fail, ['']) +test('mod8', normal, compile_fail, ['']) +test('mod9', normal, compile_fail, ['']) +test('mod10', normal, compile_fail, ['']) +test('mod11', normal, compile, ['']) +test('mod12', normal, compile, ['']) +test('mod13', normal, compile, ['']) +test('mod14', normal, compile, ['']) +test('mod15', normal, compile, ['']) +test('mod16', normal, compile, ['']) +test('mod17', normal, compile_fail, ['']) +test('mod18', normal, compile_fail, ['']) +test('mod19', normal, compile_fail, ['']) +test('mod20', normal, compile_fail, ['']) +test('mod21', normal, compile_fail, ['']) +test('mod22', normal, compile_fail, ['']) +test('mod23', normal, compile_fail, ['']) +test('mod24', normal, compile_fail, ['']) +test('mod25', normal, compile_fail, ['']) +test('mod26', normal, compile_fail, ['']) +test('mod27', normal, compile_fail, ['']) +#test('mod28', normal, compile_fail, ['']) +test('mod29', normal, compile_fail, ['']) +test('mod30', normal, compile, ['']) +test('mod31', normal, compile, ['']) +test('mod32', normal, compile, ['']) +test('mod33', normal, compile, ['']) +test('mod34', normal, compile, ['']) +test('mod35', normal, compile, ['']) +test('mod36', normal, compile_fail, ['']) +test('mod37', normal, compile, ['']) +test('mod38', normal, compile_fail, ['']) +test('mod39', normal, compile, ['']) +test('mod40', normal, compile_fail, ['']) +test('mod41', normal, compile_fail, ['']) +test('mod42', normal, compile_fail, ['']) +test('mod43', normal, compile_fail, ['']) +test('mod44', normal, compile_fail, ['']) +test('mod45', normal, compile_fail, ['']) +test('mod46', normal, compile_fail, ['']) +test('mod47', normal, compile_fail, ['']) +test('mod48', normal, compile_fail, ['']) +test('mod49', normal, compile_fail, ['']) +test('mod50', normal, compile_fail, ['']) +test('mod51', normal, compile_fail, ['']) +test('mod52', normal, compile_fail, ['']) +test('mod53', normal, compile_fail, ['']) +test('mod54', normal, compile_fail, ['']) +test('mod55', normal, compile_fail, ['']) +test('mod56', normal, compile_fail, ['']) +#test('mod57', normal, compile_fail, ['']) +test('mod58', normal, compile_fail, ['']) +test('mod59', normal, compile_fail, ['']) +test('mod60', normal, compile_fail, ['']) +test('mod61', normal, compile_fail, ['']) +test('mod62', normal, compile_fail, ['']) +test('mod63', normal, compile_fail, ['']) +test('mod64', normal, compile, ['']) +test('mod65', normal, compile, ['']) +test('mod66', normal, compile_fail, ['']) +test('mod67', normal, compile_fail, ['']) +test('mod68', normal, compile_fail, ['']) +test('mod69', normal, compile_fail, ['']) +test('mod70', normal, compile_fail, ['']) +test('mod71', normal, compile_fail, ['']) +test('mod72', normal, compile_fail, ['']) +test('mod73', normal, compile_fail, ['']) +test('mod74', normal, compile_fail, ['']) +test('mod75', normal, compile, ['']) +test('mod76', normal, compile_fail, ['']) +test('mod77', normal, compile_fail, ['']) +#test('mod78', normal, compile_fail, ['']) +test('mod79', normal, compile_fail, ['']) +test('mod80', normal, compile_fail, ['']) +test('mod81', normal, compile_fail, ['']) +test('mod82', normal, compile, ['']) +test('mod83', normal, compile, ['']) +test('mod84', normal, compile, ['']) +test('mod85', normal, compile, ['']) +test('mod86', normal, compile, ['']) +test('mod87', normal, compile_fail, ['']) +test('mod88', normal, compile_fail, ['']) +test('mod89', normal, compile_fail, ['']) +test('mod90', normal, compile_fail, ['']) +test('mod91', normal, compile_fail, ['']) +test('mod92', normal, compile, ['']) +test('mod93', normal, compile, ['']) +test('mod94', normal, compile, ['']) +test('mod95', normal, compile, ['']) +test('mod96', normal, compile, ['']) +test('mod97', normal, compile_fail, ['']) +test('mod98', expect_fail, compile_fail, ['']) +test('mod99', normal, compile, ['']) +test('mod100', normal, compile, ['']) +test('mod101', normal, multimod_compile_fail, ['mod101', '-v0']) +test('mod102', normal, multimod_compile_fail, ['mod102', '-v0']) +test('mod103', normal, compile, ['']) +test('mod104', normal, compile, ['']) +test('mod105', normal, compile, ['']) +test('mod106', normal, compile, ['']) +test('mod107', normal, compile, ['']) +test('mod108', normal, compile, ['']) +test('mod109', normal, compile, ['']) +test('mod110', normal, compile_fail, ['']) +test('mod111', normal, compile, ['']) +test('mod112', normal, compile, ['']) +test('mod113', normal, compile, ['']) +test('mod114', normal, multimod_compile_fail, ['mod114', '-v0']) +test('mod115', normal, multimod_compile, ['mod115', '-v0']) +test('mod116', normal, compile_fail, ['']) +test('mod117', normal, multimod_compile, ['mod117', '-v0']) +test('mod118', normal, multimod_compile, ['mod118', '-v0']) +test('mod119', normal, multimod_compile, ['mod119', '-v0']) +test('mod120', normal, multimod_compile_fail, ['mod120', '-v0']) +test('mod121', normal, multimod_compile_fail, ['mod121', '-v0']) +test('mod122', normal, multimod_compile_fail, ['mod122', '-v0']) +test('mod123', normal, multimod_compile_fail, ['mod123', '-v0']) +test('mod124', normal, multimod_compile_fail, ['mod124', '-v0']) +test('mod125', normal, multimod_compile_fail, ['mod125', '-v0']) +test('mod126', normal, multimod_compile_fail, ['mod126', '-v0']) +test('mod127', normal, multimod_compile_fail, ['mod127', '-v0']) +test('mod128', normal, multimod_compile, ['mod128', '-v0']) +test('mod129', normal, compile, ['']) +test('mod130', normal, compile_fail, ['']) +test('mod131', normal, multimod_compile_fail, ['mod131', '-v0']) diff --git a/testsuite/tests/ghc-regress/module/convert-tests.sh b/testsuite/tests/ghc-regress/module/convert-tests.sh new file mode 100644 index 0000000000..d4053472ac --- /dev/null +++ b/testsuite/tests/ghc-regress/module/convert-tests.sh @@ -0,0 +1,12 @@ +#! /bin/sh + +# something like this... +for i in mod*.hs; do + if ! test -f ${i%.hs}.output; then + echo "test('${i%.hs}', normal, compile, [''])" + else if grep error ${i%.hs}.output >/dev/null; then + echo "test('${i%.hs}', normal, compile_fail, [''])" + else + echo "test('${i%.hs}', normal, compile, [''])" + fi fi +done diff --git a/testsuite/tests/ghc-regress/module/mod1.hs b/testsuite/tests/ghc-regress/module/mod1.hs new file mode 100644 index 0000000000..c8276cda87 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod1.hs @@ -0,0 +1,3 @@ +-- !!! Importing unknown module +module M where +import N diff --git a/testsuite/tests/ghc-regress/module/mod1.stderr b/testsuite/tests/ghc-regress/module/mod1.stderr new file mode 100644 index 0000000000..7e56241cad --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod1.stderr @@ -0,0 +1,4 @@ + +mod1.hs:3: + failed to load interface for `N': + Could not find interface file for `N' diff --git a/testsuite/tests/ghc-regress/module/mod10.hs b/testsuite/tests/ghc-regress/module/mod10.hs new file mode 100644 index 0000000000..1e8046f05e --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod10.hs @@ -0,0 +1,3 @@ +-- !!! Exporting non-existent datatype transparently +module M(T(K1)) where +x = 'a' -- dummy definition to get round a separate bug diff --git a/testsuite/tests/ghc-regress/module/mod10.stderr b/testsuite/tests/ghc-regress/module/mod10.stderr new file mode 100644 index 0000000000..3492a5ed0c --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod10.stderr @@ -0,0 +1,2 @@ + +mod10.hs:2: Type constructor or class not in scope: `T' diff --git a/testsuite/tests/ghc-regress/module/mod100.hs b/testsuite/tests/ghc-regress/module/mod100.hs new file mode 100644 index 0000000000..f370d09f87 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod100.hs @@ -0,0 +1,28 @@ +-- !!! Empty where declarations list +module Mod100 where + +y = 3 + +x = v where v = 2 where + +{- Example of a nested context not being further + indented than the enclosing - an error (from the + Sec B.2 of the H98 report). + +f x = let + h y = let + p z = z + in p + in h + +-} + +f e = let { x = e; y = x } in y + +z = 'a' where + +class A a where + +instance A Int where + +instance A Char diff --git a/testsuite/tests/ghc-regress/module/mod101.hs b/testsuite/tests/ghc-regress/module/mod101.hs new file mode 100644 index 0000000000..ffc393cbff --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod101.hs @@ -0,0 +1,8 @@ +-- !!! Re-exporting a subset of a alg. data type's constructors +module Mod101 where + +import Mod101_AuxB + +-- ConB is not imported by Mod101_AuxB, hence not exported either. +x :: DataA +x = ConB False diff --git a/testsuite/tests/ghc-regress/module/mod101.stderr b/testsuite/tests/ghc-regress/module/mod101.stderr new file mode 100644 index 0000000000..117642553f --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod101.stderr @@ -0,0 +1,2 @@ + +mod101.hs:8: Data constructor not in scope: `ConB' diff --git a/testsuite/tests/ghc-regress/module/mod102.hs b/testsuite/tests/ghc-regress/module/mod102.hs new file mode 100644 index 0000000000..945276937c --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod102.hs @@ -0,0 +1,8 @@ +-- !!! Fixed bug: Re-exporting a subset of a class' methods +module Mod102 where + +import Mod102_AuxB + +-- methB is not imported by Mod102_AuxB, hence not exported either. +x :: Bool -> () +x = methB False diff --git a/testsuite/tests/ghc-regress/module/mod102.stderr b/testsuite/tests/ghc-regress/module/mod102.stderr new file mode 100644 index 0000000000..571de7e320 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod102.stderr @@ -0,0 +1,2 @@ + +mod102.hs:8: Variable not in scope: `methB' diff --git a/testsuite/tests/ghc-regress/module/mod103.hs b/testsuite/tests/ghc-regress/module/mod103.hs new file mode 100644 index 0000000000..ccd6ddfd0d --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod103.hs @@ -0,0 +1,12 @@ +-- !!! Layout rule extension (restricting empty do's). +module Foo where + +g :: Int -> (Int -> IO a) -> IO a +g x cont = cont x + +f :: Int -> IO Int +f x = do + g x $ \ y -> do + f y + + diff --git a/testsuite/tests/ghc-regress/module/mod104.hs b/testsuite/tests/ghc-regress/module/mod104.hs new file mode 100644 index 0000000000..f44289971f --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod104.hs @@ -0,0 +1,6 @@ +-- !!! Redefining imported Prelude entities +module A where +--import Prelude + +head = "head" + diff --git a/testsuite/tests/ghc-regress/module/mod105.hs b/testsuite/tests/ghc-regress/module/mod105.hs new file mode 100644 index 0000000000..3b08039d27 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod105.hs @@ -0,0 +1,9 @@ +-- !!! Re-defining Prelude entities +module Ring where +import qualified Prelude +import List ( nub ) + +l1 + l2 = l1 Prelude.++ l2 +l1 * l2 = nub (l1 + l2) + +succ = (Prelude.+ 1) diff --git a/testsuite/tests/ghc-regress/module/mod106.hs b/testsuite/tests/ghc-regress/module/mod106.hs new file mode 100644 index 0000000000..8ed6edaea3 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod106.hs @@ -0,0 +1,8 @@ +-- !!! local aliases +module M where + +import qualified Maybe as M +import qualified List as M + +x = M.length +b = M.isJust diff --git a/testsuite/tests/ghc-regress/module/mod107.hs b/testsuite/tests/ghc-regress/module/mod107.hs new file mode 100644 index 0000000000..cd660d96af --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod107.hs @@ -0,0 +1,6 @@ +-- !!! Redefining and using Prelude entities +module F where + +sin :: Float -> Float +sin x = (x::Float) +f x = Prelude.sin (F.sin x) diff --git a/testsuite/tests/ghc-regress/module/mod108.hs b/testsuite/tests/ghc-regress/module/mod108.hs new file mode 100644 index 0000000000..2a5ffa4934 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod108.hs @@ -0,0 +1,6 @@ +-- !!! Local alias same as module +module F where + +import Prelude as F + +x = 'a' diff --git a/testsuite/tests/ghc-regress/module/mod109.hs b/testsuite/tests/ghc-regress/module/mod109.hs new file mode 100644 index 0000000000..e9b6f29171 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod109.hs @@ -0,0 +1,7 @@ +-- !!! redefining and using Prelude entities +module A( null, nonNull ) where +import Prelude hiding( null ) +import qualified Prelude +null, nonNull :: Int -> Bool +null x = x == 0 +nonNull x = not (Prelude.null [x]) && not (null x) diff --git a/testsuite/tests/ghc-regress/module/mod11.hs b/testsuite/tests/ghc-regress/module/mod11.hs new file mode 100644 index 0000000000..84353668ba --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod11.hs @@ -0,0 +1,2 @@ +-- !!! Empty module body +module M where diff --git a/testsuite/tests/ghc-regress/module/mod110.hs b/testsuite/tests/ghc-regress/module/mod110.hs new file mode 100644 index 0000000000..897dd12cdb --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod110.hs @@ -0,0 +1,15 @@ +-- !!! Re-defining Prelude class +module M where + +import Prelude +--import qualified Prelude + +class Eq a where + equal :: a -> a -> Prelude.Bool + negate :: a -> a + +instance Eq Prelude.Int where + equal x y = x Prelude.== y + negate x = Prelude.negate x +x = M.negate (2 :: Prelude.Int) + diff --git a/testsuite/tests/ghc-regress/module/mod110.stderr b/testsuite/tests/ghc-regress/module/mod110.stderr new file mode 100644 index 0000000000..b0daa1f9c4 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod110.stderr @@ -0,0 +1,5 @@ + +mod110.hs:11: + Ambiguous occurrence `Eq' + It could refer to either `M.Eq', defined at mod110.hs:7 + or `GHC.Base.Eq', imported from Prelude at mod110.hs:4 diff --git a/testsuite/tests/ghc-regress/module/mod111.hs b/testsuite/tests/ghc-regress/module/mod111.hs new file mode 100644 index 0000000000..3f2b02cddb --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod111.hs @@ -0,0 +1,12 @@ +-- !!! Hiding an abstract (Prelude) type +module M where + +import Prelude hiding ( Char ) +import Char hiding ( ord, Char ) +import qualified Char ( ord ) + +type Char = Int + +ord :: Char -> Int +ord x = Char.ord (chr x) + 1 + diff --git a/testsuite/tests/ghc-regress/module/mod112.hs b/testsuite/tests/ghc-regress/module/mod112.hs new file mode 100644 index 0000000000..953d930603 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod112.hs @@ -0,0 +1,12 @@ +-- !!! Hiding an abstract (Prelude) class +module M where + +import Prelude hiding ( Eq ) + +class Eq a where + equ :: a -> Bool + +f :: Eq a => a -> Bool +f x = equ x + + diff --git a/testsuite/tests/ghc-regress/module/mod113.hs b/testsuite/tests/ghc-regress/module/mod113.hs new file mode 100644 index 0000000000..49942bae34 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod113.hs @@ -0,0 +1,7 @@ +-- !!! empty decls, alts and stmts +module M where { +;;;;;;;;import Char;;x = 1;;y = 2; +v = do {;;;;;;;;;;;;;;;;;;;;;;;x <- [1];;return x;;}; +f x = case x of { ;;;;;;2 -> 'a';;;;;;3->'b';;;;;;;;;;;};;; +g x = case x of { ;;;;;;;;;; _ -> "aa"; } +} diff --git a/testsuite/tests/ghc-regress/module/mod114.hs b/testsuite/tests/ghc-regress/module/mod114.hs new file mode 100644 index 0000000000..b739c5d283 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod114.hs @@ -0,0 +1,4 @@ +-- !!! Type re-exportation test +-- (from bug reported by Ross Paterson.) +module Mod114 (Stuff) where +import Mod114_Help hiding(Stuff(..)) diff --git a/testsuite/tests/ghc-regress/module/mod114.stderr b/testsuite/tests/ghc-regress/module/mod114.stderr new file mode 100644 index 0000000000..805357e12b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod114.stderr @@ -0,0 +1,2 @@ + +mod114.hs:3: Type constructor or class not in scope: `Stuff' diff --git a/testsuite/tests/ghc-regress/module/mod115.hs b/testsuite/tests/ghc-regress/module/mod115.hs new file mode 100644 index 0000000000..f0bf9439a2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod115.hs @@ -0,0 +1,7 @@ +-- !!! class method (re-)exportation trickery +module M where + +import Mod115_B + +f = m1 (1::Int) +g = m2 (2::Int) diff --git a/testsuite/tests/ghc-regress/module/mod116.hs b/testsuite/tests/ghc-regress/module/mod116.hs new file mode 100644 index 0000000000..42d668c9c8 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod116.hs @@ -0,0 +1,5 @@ +-- !!! data ctor (re-)exportation +module M (T(M1), M2) where + +data T = M1 Int | M2 Int + diff --git a/testsuite/tests/ghc-regress/module/mod116.stderr b/testsuite/tests/ghc-regress/module/mod116.stderr new file mode 100644 index 0000000000..113bc54728 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod116.stderr @@ -0,0 +1,2 @@ + +mod116.hs:2: Type constructor or class not in scope: `M2' diff --git a/testsuite/tests/ghc-regress/module/mod117.hs b/testsuite/tests/ghc-regress/module/mod117.hs new file mode 100644 index 0000000000..83dc056f9c --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod117.hs @@ -0,0 +1,7 @@ +-- !!! field name (re-)exportation trickery +module M where + +import Mod117_B + +f = m1 undefined +g = m2 undefined diff --git a/testsuite/tests/ghc-regress/module/mod118.hs b/testsuite/tests/ghc-regress/module/mod118.hs new file mode 100644 index 0000000000..a443b6f123 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod118.hs @@ -0,0 +1,6 @@ +-- !!! more class method (re-)exportation trickery. +module M where + +import Mod118_B + +g = m2 (2::Int) diff --git a/testsuite/tests/ghc-regress/module/mod119.hs b/testsuite/tests/ghc-regress/module/mod119.hs new file mode 100644 index 0000000000..d51f5674d9 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod119.hs @@ -0,0 +1,3 @@ +-- !!! module re-exportation +module M where +import Mod119_B(f) diff --git a/testsuite/tests/ghc-regress/module/mod12.hs b/testsuite/tests/ghc-regress/module/mod12.hs new file mode 100644 index 0000000000..dcbacb6728 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod12.hs @@ -0,0 +1,5 @@ +-- !!! Correct class export +module M(C(m1,m2,m3)) where +class C a where + m1 :: a + m2, m3 :: a diff --git a/testsuite/tests/ghc-regress/module/mod120.hs b/testsuite/tests/ghc-regress/module/mod120.hs new file mode 100644 index 0000000000..04e5039463 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod120.hs @@ -0,0 +1,5 @@ +-- !!! (..) importation of partially exported types +-- (test / bug report due to Ross Paterson.) +module M where +import Mod120_A(T(..)) +f = Foo diff --git a/testsuite/tests/ghc-regress/module/mod120.stderr b/testsuite/tests/ghc-regress/module/mod120.stderr new file mode 100644 index 0000000000..687eda93f3 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod120.stderr @@ -0,0 +1,2 @@ + +mod120.hs:5: Data constructor not in scope: `Foo' diff --git a/testsuite/tests/ghc-regress/module/mod121.hs b/testsuite/tests/ghc-regress/module/mod121.hs new file mode 100644 index 0000000000..f39427d623 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod121.hs @@ -0,0 +1,5 @@ +-- !!! (..) importation of partially exported class +-- (test / bug report due to Ross Paterson.) +module M where +import Mod121_A(C(..)) +f = m2 (1::Int) diff --git a/testsuite/tests/ghc-regress/module/mod121.stderr b/testsuite/tests/ghc-regress/module/mod121.stderr new file mode 100644 index 0000000000..f8bc3a42f3 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod121.stderr @@ -0,0 +1,2 @@ + +mod121.hs:5: Variable not in scope: `m2' diff --git a/testsuite/tests/ghc-regress/module/mod122.hs b/testsuite/tests/ghc-regress/module/mod122.hs new file mode 100644 index 0000000000..84440d1668 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod122.hs @@ -0,0 +1,6 @@ +-- !!! exporting a method (but not its class) +module M where +import Mod122_A + +f :: C a => a -> a +f = m1 diff --git a/testsuite/tests/ghc-regress/module/mod122.stderr b/testsuite/tests/ghc-regress/module/mod122.stderr new file mode 100644 index 0000000000..b9740ea247 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod122.stderr @@ -0,0 +1,2 @@ + +mod122.hs:5: Type constructor or class not in scope: `C' diff --git a/testsuite/tests/ghc-regress/module/mod123.hs b/testsuite/tests/ghc-regress/module/mod123.hs new file mode 100644 index 0000000000..cdf7402115 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod123.hs @@ -0,0 +1,6 @@ +-- !!! exporting a field name (but not its type) +module M where +import Mod123_A + +f :: T -> Int +f x = f1 x diff --git a/testsuite/tests/ghc-regress/module/mod123.stderr b/testsuite/tests/ghc-regress/module/mod123.stderr new file mode 100644 index 0000000000..4078bec131 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod123.stderr @@ -0,0 +1,2 @@ + +mod123.hs:5: Type constructor or class not in scope: `T' diff --git a/testsuite/tests/ghc-regress/module/mod124.hs b/testsuite/tests/ghc-regress/module/mod124.hs new file mode 100644 index 0000000000..3fd26f0fb9 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod124.hs @@ -0,0 +1,7 @@ +-- !!! hiding an entity T (where T is both a type and a dcon.) +module M where + +import Mod124_A hiding (T) + +x :: T +x = undefined diff --git a/testsuite/tests/ghc-regress/module/mod124.stderr b/testsuite/tests/ghc-regress/module/mod124.stderr new file mode 100644 index 0000000000..45f69b1ad2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod124.stderr @@ -0,0 +1,2 @@ + +mod124.hs:6: Type constructor or class not in scope: `T' diff --git a/testsuite/tests/ghc-regress/module/mod125.hs b/testsuite/tests/ghc-regress/module/mod125.hs new file mode 100644 index 0000000000..fcd2253740 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod125.hs @@ -0,0 +1,7 @@ +-- !!! hiding an entity T (where T is both a type and a dcon.) +module M where + +import Mod124_A hiding (T) + +--x :: T +x = T diff --git a/testsuite/tests/ghc-regress/module/mod125.stderr b/testsuite/tests/ghc-regress/module/mod125.stderr new file mode 100644 index 0000000000..36cf496d0d --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod125.stderr @@ -0,0 +1,2 @@ + +mod125.hs:7: Data constructor not in scope: `T' diff --git a/testsuite/tests/ghc-regress/module/mod126.hs b/testsuite/tests/ghc-regress/module/mod126.hs new file mode 100644 index 0000000000..b661d385c3 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod126.hs @@ -0,0 +1,7 @@ +-- !!! hiding an entity T (where T is both a class and a dcon.) +module M where + +import Mod126_A hiding (T) + +--x :: T +x = T diff --git a/testsuite/tests/ghc-regress/module/mod126.stderr b/testsuite/tests/ghc-regress/module/mod126.stderr new file mode 100644 index 0000000000..0606db43d1 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod126.stderr @@ -0,0 +1,2 @@ + +mod126.hs:7: Data constructor not in scope: `T' diff --git a/testsuite/tests/ghc-regress/module/mod127.hs b/testsuite/tests/ghc-regress/module/mod127.hs new file mode 100644 index 0000000000..92c3816f47 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod127.hs @@ -0,0 +1,7 @@ +-- !!! hiding an entity T (where T is both a class and a dcon.) +module M where + +import Mod126_A hiding (T) + +x :: T a => a -> a +x = undefined diff --git a/testsuite/tests/ghc-regress/module/mod127.stderr b/testsuite/tests/ghc-regress/module/mod127.stderr new file mode 100644 index 0000000000..ed21e1f7d8 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod127.stderr @@ -0,0 +1,2 @@ + +mod127.hs:6: Type constructor or class not in scope: `T' diff --git a/testsuite/tests/ghc-regress/module/mod128.hs b/testsuite/tests/ghc-regress/module/mod128.hs new file mode 100644 index 0000000000..5d96e0f464 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod128.hs @@ -0,0 +1,5 @@ +-- !!! Cumulative exportation +module M where +import Mod128_A(T(..)) + +f = Con diff --git a/testsuite/tests/ghc-regress/module/mod129.hs b/testsuite/tests/ghc-regress/module/mod129.hs new file mode 100644 index 0000000000..4229e9e88a --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod129.hs @@ -0,0 +1,8 @@ +-- !!! hiding class members (but not class.) +module M where + +import Prelude hiding ( (<), (>)) + +x :: Ord a => a -> a +x = undefined + diff --git a/testsuite/tests/ghc-regress/module/mod13.hs b/testsuite/tests/ghc-regress/module/mod13.hs new file mode 100644 index 0000000000..d7aeb7db94 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod13.hs @@ -0,0 +1,5 @@ +-- !!! Omitted member from export list +module M(C(m1,m3)) where +class C a where + m1 :: a + m2, m3 :: a diff --git a/testsuite/tests/ghc-regress/module/mod130.hs b/testsuite/tests/ghc-regress/module/mod130.hs new file mode 100644 index 0000000000..97dbacbfd2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod130.hs @@ -0,0 +1,7 @@ +-- !!! hiding class members. +module M where + +import Prelude hiding ( (<), (>)) + +x :: Int -> Int +x = (<) 2 diff --git a/testsuite/tests/ghc-regress/module/mod130.stderr b/testsuite/tests/ghc-regress/module/mod130.stderr new file mode 100644 index 0000000000..cc385e4f17 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod130.stderr @@ -0,0 +1,2 @@ + +mod130.hs:7: Variable not in scope: `<' diff --git a/testsuite/tests/ghc-regress/module/mod131.hs b/testsuite/tests/ghc-regress/module/mod131.hs new file mode 100644 index 0000000000..1ccee23085 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod131.hs @@ -0,0 +1,5 @@ +-- !!! unqual name conflicts in export lists. (*should* fail, but doesn't.) +module C ( Mod131_A.f, g, module Mod131_B ) where +import Mod131_B(f) +import qualified Mod131_A(f) +g = f diff --git a/testsuite/tests/ghc-regress/module/mod131.stderr b/testsuite/tests/ghc-regress/module/mod131.stderr new file mode 100644 index 0000000000..3180e52d35 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod131.stderr @@ -0,0 +1,3 @@ + +mod131.hs:2: + The export items `Mod131_A.f' and `module Mod131_B' create conflicting exports for `f' diff --git a/testsuite/tests/ghc-regress/module/mod14.hs b/testsuite/tests/ghc-regress/module/mod14.hs new file mode 100644 index 0000000000..b88a4a6988 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod14.hs @@ -0,0 +1,5 @@ +-- !!! Duplicate member in export list +module M(C(m1,m2,m2,m3)) where +class C a where + m1 :: a + m2, m3 :: a diff --git a/testsuite/tests/ghc-regress/module/mod15.hs b/testsuite/tests/ghc-regress/module/mod15.hs new file mode 100644 index 0000000000..c2de445c50 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod15.hs @@ -0,0 +1,5 @@ +-- !!! Correct class export +module M(C(..)) where +class C a where + m1 :: a + m2, m3 :: a diff --git a/testsuite/tests/ghc-regress/module/mod16.hs b/testsuite/tests/ghc-regress/module/mod16.hs new file mode 100644 index 0000000000..3b0e6d7bd9 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod16.hs @@ -0,0 +1,5 @@ +-- !!! Correct abstract class export +module M(C) where +class C a where + m1 :: a + m2, m3 :: a diff --git a/testsuite/tests/ghc-regress/module/mod17.hs b/testsuite/tests/ghc-regress/module/mod17.hs new file mode 100644 index 0000000000..c3f219edde --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod17.hs @@ -0,0 +1,5 @@ +-- !!! Testing non-member function in explicit class export list +module M(C(m1,m2,m3,Left)) where +class C a where + m1 :: a + m2, m3 :: a diff --git a/testsuite/tests/ghc-regress/module/mod17.stderr b/testsuite/tests/ghc-regress/module/mod17.stderr new file mode 100644 index 0000000000..d70ff66b26 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod17.stderr @@ -0,0 +1,4 @@ + +mod17.hs:2: + The export item `C(m1, m2, m3, Left)' + attempts to export constructors or class methods that are not visible here diff --git a/testsuite/tests/ghc-regress/module/mod18.hs b/testsuite/tests/ghc-regress/module/mod18.hs new file mode 100644 index 0000000000..cfbcdbf62a --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod18.hs @@ -0,0 +1,3 @@ +-- !!! Testing duplicate type synonyms +type T = Int +type T = Float diff --git a/testsuite/tests/ghc-regress/module/mod18.stderr b/testsuite/tests/ghc-regress/module/mod18.stderr new file mode 100644 index 0000000000..e23166504c --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod18.stderr @@ -0,0 +1,5 @@ + +mod18.hs:2: + Multiple declarations of `Main.T' + mod18.hs:2 + mod18.hs:3 diff --git a/testsuite/tests/ghc-regress/module/mod19.hs b/testsuite/tests/ghc-regress/module/mod19.hs new file mode 100644 index 0000000000..9f8b49f2b2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod19.hs @@ -0,0 +1,3 @@ +-- !!! Testing duplicate classes +class C a where m :: a +class C a where m :: a diff --git a/testsuite/tests/ghc-regress/module/mod19.stderr b/testsuite/tests/ghc-regress/module/mod19.stderr new file mode 100644 index 0000000000..2bcddb2c48 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod19.stderr @@ -0,0 +1,10 @@ + +mod19.hs:2: + Multiple declarations of `Main.m' + mod19.hs:2 + mod19.hs:3 + +mod19.hs:2: + Multiple declarations of `Main.C' + mod19.hs:2 + mod19.hs:3 diff --git a/testsuite/tests/ghc-regress/module/mod2.hs b/testsuite/tests/ghc-regress/module/mod2.hs new file mode 100644 index 0000000000..d0821071b6 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod2.hs @@ -0,0 +1,3 @@ +-- !!! Qualified import of unknown module +module M where +import qualified N diff --git a/testsuite/tests/ghc-regress/module/mod2.stderr b/testsuite/tests/ghc-regress/module/mod2.stderr new file mode 100644 index 0000000000..099382416a --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod2.stderr @@ -0,0 +1,4 @@ + +mod2.hs:3: + failed to load interface for `N': + Could not find interface file for `N' diff --git a/testsuite/tests/ghc-regress/module/mod20.hs b/testsuite/tests/ghc-regress/module/mod20.hs new file mode 100644 index 0000000000..68d6ede9d0 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod20.hs @@ -0,0 +1,3 @@ +-- !!! Testing duplicate members +class C1 a where m :: a +class C2 a where m :: a
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod20.stderr b/testsuite/tests/ghc-regress/module/mod20.stderr new file mode 100644 index 0000000000..26a1cd7267 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod20.stderr @@ -0,0 +1,5 @@ + +mod20.hs:2: + Multiple declarations of `Main.m' + mod20.hs:2 + mod20.hs:3 diff --git a/testsuite/tests/ghc-regress/module/mod21.hs b/testsuite/tests/ghc-regress/module/mod21.hs new file mode 100644 index 0000000000..7d24286464 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod21.hs @@ -0,0 +1,3 @@ +-- !!! Testing duplicate type constructors +data T = K1 +data T = K2 diff --git a/testsuite/tests/ghc-regress/module/mod21.stderr b/testsuite/tests/ghc-regress/module/mod21.stderr new file mode 100644 index 0000000000..59702e7fd2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod21.stderr @@ -0,0 +1,5 @@ + +mod21.hs:2: + Multiple declarations of `Main.T' + mod21.hs:2 + mod21.hs:3 diff --git a/testsuite/tests/ghc-regress/module/mod22.hs b/testsuite/tests/ghc-regress/module/mod22.hs new file mode 100644 index 0000000000..69cc870720 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod22.hs @@ -0,0 +1,3 @@ +-- !!! Testing duplicate data constructors +data T1 = K +data T2 = K diff --git a/testsuite/tests/ghc-regress/module/mod22.stderr b/testsuite/tests/ghc-regress/module/mod22.stderr new file mode 100644 index 0000000000..ab839f05a0 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod22.stderr @@ -0,0 +1,5 @@ + +mod22.hs:2: + Multiple declarations of `Main.K' + mod22.hs:2 + mod22.hs:3 diff --git a/testsuite/tests/ghc-regress/module/mod23.hs b/testsuite/tests/ghc-regress/module/mod23.hs new file mode 100644 index 0000000000..84753b4189 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod23.hs @@ -0,0 +1,3 @@ +module ShouldFail where +-- !!! Testing duplicate type variables +type T a a = Either a a diff --git a/testsuite/tests/ghc-regress/module/mod23.stderr b/testsuite/tests/ghc-regress/module/mod23.stderr new file mode 100644 index 0000000000..ce10011f90 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod23.stderr @@ -0,0 +1,4 @@ + +mod23.hs:3: + Conflicting definitions for `a' + In the declaration for type synonym `T' diff --git a/testsuite/tests/ghc-regress/module/mod24.hs b/testsuite/tests/ghc-regress/module/mod24.hs new file mode 100644 index 0000000000..6e1654b4f9 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod24.hs @@ -0,0 +1,3 @@ +module ShouldFail where +-- !!! Testing duplicate type variables +data T a a = K a a diff --git a/testsuite/tests/ghc-regress/module/mod24.stderr b/testsuite/tests/ghc-regress/module/mod24.stderr new file mode 100644 index 0000000000..bc1305af39 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod24.stderr @@ -0,0 +1,4 @@ + +mod24.hs:3: + Conflicting definitions for `a' + In the data type declaration for `T' diff --git a/testsuite/tests/ghc-regress/module/mod25.hs b/testsuite/tests/ghc-regress/module/mod25.hs new file mode 100644 index 0000000000..e1f5087379 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod25.hs @@ -0,0 +1,3 @@ +module ShouldFail where +-- !!! Testing bogus (or existential) type variables +data T a = K a b diff --git a/testsuite/tests/ghc-regress/module/mod25.stderr b/testsuite/tests/ghc-regress/module/mod25.stderr new file mode 100644 index 0000000000..377e890ba4 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod25.stderr @@ -0,0 +1,2 @@ + +mod25.hs:3: Type variable not in scope: `b' diff --git a/testsuite/tests/ghc-regress/module/mod26.hs b/testsuite/tests/ghc-regress/module/mod26.hs new file mode 100644 index 0000000000..d58b1de1d0 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod26.hs @@ -0,0 +1,3 @@ +module ShouldFail where +-- !!! Testing bogus (or existential) type variables +type T a = Either a b diff --git a/testsuite/tests/ghc-regress/module/mod26.stderr b/testsuite/tests/ghc-regress/module/mod26.stderr new file mode 100644 index 0000000000..92e9915388 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod26.stderr @@ -0,0 +1,2 @@ + +mod26.hs:3: Type variable not in scope: `b' diff --git a/testsuite/tests/ghc-regress/module/mod27.hs b/testsuite/tests/ghc-regress/module/mod27.hs new file mode 100644 index 0000000000..394fa2341d --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod27.hs @@ -0,0 +1,4 @@ +module ShouldFail where +-- !!! Testing recursive type synonyms +type T1 = (Int,T2) +type T2 = (Int,T1) diff --git a/testsuite/tests/ghc-regress/module/mod27.stderr b/testsuite/tests/ghc-regress/module/mod27.stderr new file mode 100644 index 0000000000..f57efaceeb --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod27.stderr @@ -0,0 +1,4 @@ + +Cycle in type declarations: + `T2' at mod27.hs:4 + `T1' at mod27.hs:3 diff --git a/testsuite/tests/ghc-regress/module/mod29.hs b/testsuite/tests/ghc-regress/module/mod29.hs new file mode 100644 index 0000000000..cce8eb5f5b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod29.hs @@ -0,0 +1,6 @@ +-- !!! Testing for out of scope Prelude types. +-- was: Imported tycon clashes with local definition +-- (but that's OK, as long as the type isn't _used_.) +module M where +import Prelude(Int) +type Int = Char diff --git a/testsuite/tests/ghc-regress/module/mod29.stderr b/testsuite/tests/ghc-regress/module/mod29.stderr new file mode 100644 index 0000000000..ddf7db5db8 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod29.stderr @@ -0,0 +1,2 @@ + +mod29.hs:6: Type constructor or class not in scope: `Char' diff --git a/testsuite/tests/ghc-regress/module/mod3.hs b/testsuite/tests/ghc-regress/module/mod3.hs new file mode 100644 index 0000000000..ec31b6e480 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod3.hs @@ -0,0 +1,4 @@ +-- !!! Exporting "constructor" of a type synonym +module M(T(K1)) where +type T = T' +data T' = K1
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod3.stderr b/testsuite/tests/ghc-regress/module/mod3.stderr new file mode 100644 index 0000000000..eb0af1c727 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod3.stderr @@ -0,0 +1,4 @@ + +mod3.hs:2: + The export item `T(K1)' + attempts to export constructors or class methods that are not visible here diff --git a/testsuite/tests/ghc-regress/module/mod30.hs b/testsuite/tests/ghc-regress/module/mod30.hs new file mode 100644 index 0000000000..8f87970a2d --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod30.hs @@ -0,0 +1,4 @@ +-- !!! Imported class clashes with local class definition +module M where +import Prelude(Eq,Bool) +class Eq a where (==) :: a -> a -> Bool diff --git a/testsuite/tests/ghc-regress/module/mod31.hs b/testsuite/tests/ghc-regress/module/mod31.hs new file mode 100644 index 0000000000..70f66a391e --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod31.hs @@ -0,0 +1,5 @@ +-- !!! Defining local type with same name as imported class +-- was: Imported class clashes with local type definition +module M where +import Prelude(Eq,Bool) +type Eq = Bool diff --git a/testsuite/tests/ghc-regress/module/mod32.hs b/testsuite/tests/ghc-regress/module/mod32.hs new file mode 100644 index 0000000000..2922bab0ce --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod32.hs @@ -0,0 +1,5 @@ +-- !!! Defining local class with same name as imported type. +-- was: Imported tycon clashes with local class definition +module M where +import Prelude(Int,Bool) +class Int a where (==) :: a -> a -> Bool diff --git a/testsuite/tests/ghc-regress/module/mod33.hs b/testsuite/tests/ghc-regress/module/mod33.hs new file mode 100644 index 0000000000..04d984af39 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod33.hs @@ -0,0 +1,5 @@ +-- !!! Redefining an imported name +-- was: Imported var clashes with local var definition +module M where +import Prelude(id) +id x = x diff --git a/testsuite/tests/ghc-regress/module/mod34.hs b/testsuite/tests/ghc-regress/module/mod34.hs new file mode 100644 index 0000000000..8ce259acd0 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod34.hs @@ -0,0 +1,5 @@ +-- !!! Defining local value with same name as imported class member. +-- was: Imported member fun clashes with local var definition +module M where +import Ix(Ix(..)) +index x = x diff --git a/testsuite/tests/ghc-regress/module/mod35.hs b/testsuite/tests/ghc-regress/module/mod35.hs new file mode 100644 index 0000000000..614bb73130 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod35.hs @@ -0,0 +1,5 @@ +-- !!! Redefining imported data constructors +-- was: Imported constructor clashes with local constructor +module M where +import Prelude(Bool(True,False)) +data T = True diff --git a/testsuite/tests/ghc-regress/module/mod36.hs b/testsuite/tests/ghc-regress/module/mod36.hs new file mode 100644 index 0000000000..9bd609c019 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod36.hs @@ -0,0 +1,5 @@ +-- !!! Hiding lists "intersect" part 1 +module M where +import Prelude hiding (const,id) +import Prelude hiding (const) +x = const diff --git a/testsuite/tests/ghc-regress/module/mod36.stderr b/testsuite/tests/ghc-regress/module/mod36.stderr new file mode 100644 index 0000000000..7f2b3c8ad9 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod36.stderr @@ -0,0 +1,2 @@ + +mod36.hs:5: Variable not in scope: `const' diff --git a/testsuite/tests/ghc-regress/module/mod37.hs b/testsuite/tests/ghc-regress/module/mod37.hs new file mode 100644 index 0000000000..4e21e6c9a9 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod37.hs @@ -0,0 +1,5 @@ +-- !!! Hiding lists "intersect" part 2 +module M where +import Prelude hiding (const,id) +import Prelude hiding (const) +x = id diff --git a/testsuite/tests/ghc-regress/module/mod38.hs b/testsuite/tests/ghc-regress/module/mod38.hs new file mode 100644 index 0000000000..1391fbaeaf --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod38.hs @@ -0,0 +1,4 @@ +-- !!! Class decl clashes with type decl +module M where +type C = Int +class C a where f :: a diff --git a/testsuite/tests/ghc-regress/module/mod38.stderr b/testsuite/tests/ghc-regress/module/mod38.stderr new file mode 100644 index 0000000000..44089b4621 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod38.stderr @@ -0,0 +1,5 @@ + +mod38.hs:2: + Multiple declarations of `M.C' + mod38.hs:3 + mod38.hs:4 diff --git a/testsuite/tests/ghc-regress/module/mod39.hs b/testsuite/tests/ghc-regress/module/mod39.hs new file mode 100644 index 0000000000..477e0a3854 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod39.hs @@ -0,0 +1,3 @@ +-- !!! Class variable constraints on member funs +module M where +class C a where f :: Eq a => a diff --git a/testsuite/tests/ghc-regress/module/mod4.hs b/testsuite/tests/ghc-regress/module/mod4.hs new file mode 100644 index 0000000000..02f579800f --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod4.hs @@ -0,0 +1,3 @@ +-- !!! Exporting unknown constructor +module M(T(K1,K2)) where +data T = K1 diff --git a/testsuite/tests/ghc-regress/module/mod4.stderr b/testsuite/tests/ghc-regress/module/mod4.stderr new file mode 100644 index 0000000000..100e40858e --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod4.stderr @@ -0,0 +1,4 @@ + +mod4.hs:2: + The export item `T(K1, K2)' + attempts to export constructors or class methods that are not visible here diff --git a/testsuite/tests/ghc-regress/module/mod40.hs b/testsuite/tests/ghc-regress/module/mod40.hs new file mode 100644 index 0000000000..5fc8a2e0f7 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod40.hs @@ -0,0 +1,4 @@ +-- !!! Cyclic class hierarchy +module M where +class C2 a => C1 a where f :: a +class C1 a => C2 a where g :: a diff --git a/testsuite/tests/ghc-regress/module/mod40.stderr b/testsuite/tests/ghc-regress/module/mod40.stderr new file mode 100644 index 0000000000..0ca730340c --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod40.stderr @@ -0,0 +1,4 @@ + +Cycle in class declarations: + `C1' at mod40.hs:3 + `C2' at mod40.hs:4 diff --git a/testsuite/tests/ghc-regress/module/mod41.hs b/testsuite/tests/ghc-regress/module/mod41.hs new file mode 100644 index 0000000000..a1ac924242 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod41.hs @@ -0,0 +1,3 @@ +-- !!! Repeated variable in instance predicate +module M where +instance Eq a => Eq (Either a a) diff --git a/testsuite/tests/ghc-regress/module/mod41.stderr b/testsuite/tests/ghc-regress/module/mod41.stderr new file mode 100644 index 0000000000..ae41012ce7 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod41.stderr @@ -0,0 +1,6 @@ + +mod41.hs:3: + Illegal instance declaration for `Eq (Either a a)' + (The instance type must be of form (T a b c) + where T is not a synonym, and a,b,c are distinct type variables) + In the instance declaration for `Eq (Either a a)' diff --git a/testsuite/tests/ghc-regress/module/mod42.hs b/testsuite/tests/ghc-regress/module/mod42.hs new file mode 100644 index 0000000000..9828d8b642 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod42.hs @@ -0,0 +1,3 @@ +-- !!! Not "simple type" in instance +module M where +instance Eq a diff --git a/testsuite/tests/ghc-regress/module/mod42.stderr b/testsuite/tests/ghc-regress/module/mod42.stderr new file mode 100644 index 0000000000..22fdb840c9 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod42.stderr @@ -0,0 +1,6 @@ + +mod42.hs:3: + Illegal instance declaration for `Eq a' + (The instance type must be of form (T a b c) + where T is not a synonym, and a,b,c are distinct type variables) + In the instance declaration for `Eq a' diff --git a/testsuite/tests/ghc-regress/module/mod43.hs b/testsuite/tests/ghc-regress/module/mod43.hs new file mode 100644 index 0000000000..085382f8b0 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod43.hs @@ -0,0 +1,3 @@ +-- !!! Type synonym in instance +module M where +instance Eq String diff --git a/testsuite/tests/ghc-regress/module/mod43.stderr b/testsuite/tests/ghc-regress/module/mod43.stderr new file mode 100644 index 0000000000..89ed324597 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod43.stderr @@ -0,0 +1,6 @@ + +mod43.hs:3: + Illegal instance declaration for `Eq String' + (The instance type must be of form (T a b c) + where T is not a synonym, and a,b,c are distinct type variables) + In the instance declaration for `Eq String' diff --git a/testsuite/tests/ghc-regress/module/mod44.hs b/testsuite/tests/ghc-regress/module/mod44.hs new file mode 100644 index 0000000000..f5b34cd50e --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod44.hs @@ -0,0 +1,5 @@ +-- !!! Repeated instance decl +module M where +data T = T Int +instance Eq T +instance Eq T diff --git a/testsuite/tests/ghc-regress/module/mod44.stderr b/testsuite/tests/ghc-regress/module/mod44.stderr new file mode 100644 index 0000000000..518264c320 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod44.stderr @@ -0,0 +1,4 @@ + +Duplicate instance declarations: + mod44.hs:4: Eq T + mod44.hs:5: Eq T diff --git a/testsuite/tests/ghc-regress/module/mod45.hs b/testsuite/tests/ghc-regress/module/mod45.hs new file mode 100644 index 0000000000..03a1bc32ba --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod45.hs @@ -0,0 +1,7 @@ +-- !!! Type sigs in instance decl +module M where +data T = T Int +instance Eq T where + (==) :: T -> T -> Bool + T x == T y = x == y + diff --git a/testsuite/tests/ghc-regress/module/mod45.stderr b/testsuite/tests/ghc-regress/module/mod45.stderr new file mode 100644 index 0000000000..dbd0de62aa --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod45.stderr @@ -0,0 +1,2 @@ + +mod45.hs:5: Misplaced type signature: == :: T -> T -> Bool diff --git a/testsuite/tests/ghc-regress/module/mod46.hs b/testsuite/tests/ghc-regress/module/mod46.hs new file mode 100644 index 0000000000..4b7a8f8135 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod46.hs @@ -0,0 +1,4 @@ +-- !!! Instances of superclasses exist +module M where +data T = T Int +instance Ord T diff --git a/testsuite/tests/ghc-regress/module/mod46.stderr b/testsuite/tests/ghc-regress/module/mod46.stderr new file mode 100644 index 0000000000..0b531bcbd3 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod46.stderr @@ -0,0 +1,5 @@ + +mod46.hs:4: + No instance for (Eq T) + arising from the instance declaration at mod46.hs:4 + In the instance declaration for `Ord T' diff --git a/testsuite/tests/ghc-regress/module/mod47.hs b/testsuite/tests/ghc-regress/module/mod47.hs new file mode 100644 index 0000000000..f0f487dda2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod47.hs @@ -0,0 +1,7 @@ +-- !!! Instance context can't satisfy class-hierarchy constraint +module M where +class Foo a +class Foo a => Bar a +instance Num a => Foo [a] +instance (Eq a, Enum a) => Bar [a] + diff --git a/testsuite/tests/ghc-regress/module/mod47.stderr b/testsuite/tests/ghc-regress/module/mod47.stderr new file mode 100644 index 0000000000..37f22dc07c --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod47.stderr @@ -0,0 +1,7 @@ + +mod47.hs:6: + Could not deduce (Num a) from the context (Eq a, Enum a) + Probable fix: + Add (Num a) to the instance declaration superclass context + arising from the instance declaration at mod47.hs:6 + In the instance declaration for `Bar [a]' diff --git a/testsuite/tests/ghc-regress/module/mod48.hs b/testsuite/tests/ghc-regress/module/mod48.hs new file mode 100644 index 0000000000..681d356e2e --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod48.hs @@ -0,0 +1,5 @@ +-- !!! Class decl can't use pattern bindings +module M where +class C a where + x,y :: a + (x,y) = error "foo"
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod48.stderr b/testsuite/tests/ghc-regress/module/mod48.stderr new file mode 100644 index 0000000000..209622ad5b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod48.stderr @@ -0,0 +1,4 @@ + +mod48.hs:5: + Can't handle multiple methods defined by one pattern binding + (x, y) = error "foo" diff --git a/testsuite/tests/ghc-regress/module/mod49.hs b/testsuite/tests/ghc-regress/module/mod49.hs new file mode 100644 index 0000000000..b9baba032a --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod49.hs @@ -0,0 +1,5 @@ +-- !!! Default decl for non-method +module M where +class C a where + x :: a + y = error "foo"
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod49.stderr b/testsuite/tests/ghc-regress/module/mod49.stderr new file mode 100644 index 0000000000..d6d157ab43 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod49.stderr @@ -0,0 +1,2 @@ + +mod49.hs:5: Variable not in scope: `y' diff --git a/testsuite/tests/ghc-regress/module/mod5.hs b/testsuite/tests/ghc-regress/module/mod5.hs new file mode 100644 index 0000000000..5b059ecc1a --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod5.hs @@ -0,0 +1,3 @@ +-- !!! Duplicate export of constructor +module M(T(K1,K1)) where +data T = K1 diff --git a/testsuite/tests/ghc-regress/module/mod50.hs b/testsuite/tests/ghc-regress/module/mod50.hs new file mode 100644 index 0000000000..5f26b8d487 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod50.hs @@ -0,0 +1,3 @@ +-- !!! Default decl for non-method +module M where +data T = C deriving (Foo)
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod50.stderr b/testsuite/tests/ghc-regress/module/mod50.stderr new file mode 100644 index 0000000000..86f18dd78b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod50.stderr @@ -0,0 +1,2 @@ + +mod50.hs:3: Type constructor or class not in scope: `Foo' diff --git a/testsuite/tests/ghc-regress/module/mod51.hs b/testsuite/tests/ghc-regress/module/mod51.hs new file mode 100644 index 0000000000..c3069a6c3e --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod51.hs @@ -0,0 +1,3 @@ +-- !!! Duplicate derived instance +module M where +data T = C deriving (Eq,Eq)
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod51.stderr b/testsuite/tests/ghc-regress/module/mod51.stderr new file mode 100644 index 0000000000..11e42e6fb1 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod51.stderr @@ -0,0 +1,4 @@ + +Duplicate instance declarations: + mod51.hs:3: Eq T + mod51.hs:3: Eq T diff --git a/testsuite/tests/ghc-regress/module/mod52.hs b/testsuite/tests/ghc-regress/module/mod52.hs new file mode 100644 index 0000000000..c907afe215 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod52.hs @@ -0,0 +1,4 @@ +-- !!! Duplicate derived instance +module M where +data T = C deriving (Eq) +instance Eq T
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod52.stderr b/testsuite/tests/ghc-regress/module/mod52.stderr new file mode 100644 index 0000000000..c81b8b370b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod52.stderr @@ -0,0 +1,4 @@ + +Duplicate instance declarations: + mod52.hs:3: Eq T + mod52.hs:4: Eq T diff --git a/testsuite/tests/ghc-regress/module/mod53.hs b/testsuite/tests/ghc-regress/module/mod53.hs new file mode 100644 index 0000000000..c7291e43a7 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod53.hs @@ -0,0 +1,4 @@ +-- !!! Duplicate derived instance +module M where +class C a +data T = K deriving (C) diff --git a/testsuite/tests/ghc-regress/module/mod53.stderr b/testsuite/tests/ghc-regress/module/mod53.stderr new file mode 100644 index 0000000000..2b0f9fd2bb --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod53.stderr @@ -0,0 +1,4 @@ + +mod53.hs:4: + Can't make a derived instance of `C T' (not a derivable class) + When deriving instances for type `T' diff --git a/testsuite/tests/ghc-regress/module/mod54.hs b/testsuite/tests/ghc-regress/module/mod54.hs new file mode 100644 index 0000000000..0814a5e57b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod54.hs @@ -0,0 +1,3 @@ +-- !!! Duplicate derived instance +module M where +data T = K deriving (Ord) diff --git a/testsuite/tests/ghc-regress/module/mod54.stderr b/testsuite/tests/ghc-regress/module/mod54.stderr new file mode 100644 index 0000000000..ae0f4455d2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod54.stderr @@ -0,0 +1,5 @@ + +mod54.hs:3: + No instance for (Eq T) + arising from the instance declaration at mod54.hs:3 + In the instance declaration for `Ord T' diff --git a/testsuite/tests/ghc-regress/module/mod55.hs b/testsuite/tests/ghc-regress/module/mod55.hs new file mode 100644 index 0000000000..55cfab7d60 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod55.hs @@ -0,0 +1,3 @@ +-- !!! Illegal deriving Enum +module M where +data T = K Int deriving (Enum) diff --git a/testsuite/tests/ghc-regress/module/mod55.stderr b/testsuite/tests/ghc-regress/module/mod55.stderr new file mode 100644 index 0000000000..7db11287ac --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod55.stderr @@ -0,0 +1,5 @@ + +mod55.hs:3: + Can't make a derived instance of `Enum T' + (data type with all nullary constructors expected) + When deriving instances for type `T' diff --git a/testsuite/tests/ghc-regress/module/mod56.hs b/testsuite/tests/ghc-regress/module/mod56.hs new file mode 100644 index 0000000000..d2cbe253e4 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod56.hs @@ -0,0 +1,4 @@ +-- !!! Illegal deriving Ix +module M where +import Ix(Ix) +data T = K1 Int | K2 deriving (Eq,Ord,Ix) diff --git a/testsuite/tests/ghc-regress/module/mod56.stderr b/testsuite/tests/ghc-regress/module/mod56.stderr new file mode 100644 index 0000000000..3dfcfa8055 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod56.stderr @@ -0,0 +1,5 @@ + +mod56.hs:4: + Can't make a derived instance of `Ix T' + (one constructor data type or type with all nullary constructors expected) + When deriving instances for type `T' diff --git a/testsuite/tests/ghc-regress/module/mod58.hs b/testsuite/tests/ghc-regress/module/mod58.hs new file mode 100644 index 0000000000..4ab2f71737 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod58.hs @@ -0,0 +1,4 @@ +-- !!! Multiple (identical) default decls +module M where +default (Int,Integer) +default (Int,Integer) diff --git a/testsuite/tests/ghc-regress/module/mod58.stderr b/testsuite/tests/ghc-regress/module/mod58.stderr new file mode 100644 index 0000000000..6246c2c1c9 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod58.stderr @@ -0,0 +1,4 @@ + +mod58.hs:4: + Multiple default declarations + here was another default declaration mod58.hs:3 diff --git a/testsuite/tests/ghc-regress/module/mod59.hs b/testsuite/tests/ghc-regress/module/mod59.hs new file mode 100644 index 0000000000..ecb026e894 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod59.hs @@ -0,0 +1,3 @@ +-- !!! Malformed pattern (unknown constructor) +module M where +f K = error "foo"
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod59.stderr b/testsuite/tests/ghc-regress/module/mod59.stderr new file mode 100644 index 0000000000..7a9a287704 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod59.stderr @@ -0,0 +1,2 @@ + +mod59.hs:3: Data constructor not in scope: `K' diff --git a/testsuite/tests/ghc-regress/module/mod6.hs b/testsuite/tests/ghc-regress/module/mod6.hs new file mode 100644 index 0000000000..91a9a780cd --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod6.hs @@ -0,0 +1,3 @@ +-- !!! Omitted constructor from export list +module M(T(K1)) where +data T = K1|K2 diff --git a/testsuite/tests/ghc-regress/module/mod60.hs b/testsuite/tests/ghc-regress/module/mod60.hs new file mode 100644 index 0000000000..61884850b3 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod60.hs @@ -0,0 +1,3 @@ +-- !!! Malformed pattern (arity) +module M where +f (Left) = error "foo"
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod60.stderr b/testsuite/tests/ghc-regress/module/mod60.stderr new file mode 100644 index 0000000000..4fae583b32 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod60.stderr @@ -0,0 +1,5 @@ + +mod60.hs:3: + Constructor `Left' should have 1 argument, but has been given 0 + When checking the pattern: Left + In the definition of `f': f (Left) = error "foo" diff --git a/testsuite/tests/ghc-regress/module/mod61.hs b/testsuite/tests/ghc-regress/module/mod61.hs new file mode 100644 index 0000000000..62fdef2dd3 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod61.hs @@ -0,0 +1,3 @@ +-- !!! Malformed infix expression +module M where +f a b c = a==b==c
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod61.stderr b/testsuite/tests/ghc-regress/module/mod61.stderr new file mode 100644 index 0000000000..3d2c3bbe91 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod61.stderr @@ -0,0 +1,4 @@ + +mod61.hs:3: + precedence parsing error + cannot mix `(==)' [infix 4] and `(==)' [infix 4] in the same infix expression diff --git a/testsuite/tests/ghc-regress/module/mod62.hs b/testsuite/tests/ghc-regress/module/mod62.hs new file mode 100644 index 0000000000..b1140fdd6b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod62.hs @@ -0,0 +1,3 @@ +-- !!! Malformed binding (qualified) +module M where +x = let M.y = 'a' in M.y diff --git a/testsuite/tests/ghc-regress/module/mod62.stderr b/testsuite/tests/ghc-regress/module/mod62.stderr new file mode 100644 index 0000000000..1e447b828b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod62.stderr @@ -0,0 +1,4 @@ + +mod62.hs:3: + Invalid use of qualified name `M.y' + In the binding group for `M.y' diff --git a/testsuite/tests/ghc-regress/module/mod63.hs b/testsuite/tests/ghc-regress/module/mod63.hs new file mode 100644 index 0000000000..70da4c30c2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod63.hs @@ -0,0 +1,4 @@ +-- !!! Bindings of different arities +module M where +f 0 = id +f x y = x+y diff --git a/testsuite/tests/ghc-regress/module/mod63.stderr b/testsuite/tests/ghc-regress/module/mod63.stderr new file mode 100644 index 0000000000..43939c4fea --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod63.stderr @@ -0,0 +1,2 @@ + +mod63.hs:3: Varying number of arguments for function `f' diff --git a/testsuite/tests/ghc-regress/module/mod64.hs b/testsuite/tests/ghc-regress/module/mod64.hs new file mode 100644 index 0000000000..9a9c6aef78 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod64.hs @@ -0,0 +1,3 @@ +-- !!! Pattern binding must bind (not an error in standard Haskell) +module M where +x = let ['a'] = "a" in 'a' diff --git a/testsuite/tests/ghc-regress/module/mod64.stderr b/testsuite/tests/ghc-regress/module/mod64.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod64.stderr diff --git a/testsuite/tests/ghc-regress/module/mod65.hs b/testsuite/tests/ghc-regress/module/mod65.hs new file mode 100644 index 0000000000..96866b9666 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod65.hs @@ -0,0 +1,3 @@ +-- !!! Malformed lhs (pointless but legal in Haskell 1.3, rejected by Hugs) +module M where +x = let [] = "a" in 'a' diff --git a/testsuite/tests/ghc-regress/module/mod65.stderr b/testsuite/tests/ghc-regress/module/mod65.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod65.stderr diff --git a/testsuite/tests/ghc-regress/module/mod66.hs b/testsuite/tests/ghc-regress/module/mod66.hs new file mode 100644 index 0000000000..d162ae09d5 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod66.hs @@ -0,0 +1,5 @@ +-- !!! Multiple value bindings +module M where +f x = 'a' +g x = 'b' +f x = 'c'
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod66.stderr b/testsuite/tests/ghc-regress/module/mod66.stderr new file mode 100644 index 0000000000..2b4be6d884 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod66.stderr @@ -0,0 +1,5 @@ + +mod66.hs:2: + Multiple declarations of `M.f' + mod66.hs:3 + mod66.hs:5 diff --git a/testsuite/tests/ghc-regress/module/mod67.hs b/testsuite/tests/ghc-regress/module/mod67.hs new file mode 100644 index 0000000000..addfbfb946 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod67.hs @@ -0,0 +1,3 @@ +-- !!! Type decl but no body +module M where +f :: Int -> Bool
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod67.stderr b/testsuite/tests/ghc-regress/module/mod67.stderr new file mode 100644 index 0000000000..c5640dcf6f --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod67.stderr @@ -0,0 +1,2 @@ + +mod67.hs:3: Variable not in scope: `f' diff --git a/testsuite/tests/ghc-regress/module/mod68.hs b/testsuite/tests/ghc-regress/module/mod68.hs new file mode 100644 index 0000000000..fd10684e2c --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod68.hs @@ -0,0 +1,5 @@ +-- !!! Multiple type decls +module M where +f :: Int -> Bool +f :: Int -> Bool +f = even
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/module/mod68.stderr b/testsuite/tests/ghc-regress/module/mod68.stderr new file mode 100644 index 0000000000..2b79502021 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod68.stderr @@ -0,0 +1,2 @@ + +mod68.hs:4: Duplicate type signature: f :: Int -> Bool diff --git a/testsuite/tests/ghc-regress/module/mod69.hs b/testsuite/tests/ghc-regress/module/mod69.hs new file mode 100644 index 0000000000..8360274d21 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod69.hs @@ -0,0 +1,3 @@ +-- !!! Illegal @ in expression +module M where +f x = x@1 diff --git a/testsuite/tests/ghc-regress/module/mod69.stderr b/testsuite/tests/ghc-regress/module/mod69.stderr new file mode 100644 index 0000000000..aa1672cb7d --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod69.stderr @@ -0,0 +1,2 @@ + +mod69.hs:3: Pattern syntax in expression context: x@1 diff --git a/testsuite/tests/ghc-regress/module/mod7.hs b/testsuite/tests/ghc-regress/module/mod7.hs new file mode 100644 index 0000000000..68aacee63b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod7.hs @@ -0,0 +1,3 @@ +-- !!! Exporting non-existent type/class +module M(T) where +x = 'a' -- dummy definition to get round a separate bug diff --git a/testsuite/tests/ghc-regress/module/mod7.stderr b/testsuite/tests/ghc-regress/module/mod7.stderr new file mode 100644 index 0000000000..2c15afaf50 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod7.stderr @@ -0,0 +1,2 @@ + +mod7.hs:2: Type constructor or class not in scope: `T' diff --git a/testsuite/tests/ghc-regress/module/mod70.hs b/testsuite/tests/ghc-regress/module/mod70.hs new file mode 100644 index 0000000000..cb7d51fe3b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod70.hs @@ -0,0 +1,3 @@ +-- !!! Illegal ~ in expression +module M where +f x = x~1 diff --git a/testsuite/tests/ghc-regress/module/mod70.stderr b/testsuite/tests/ghc-regress/module/mod70.stderr new file mode 100644 index 0000000000..6cfb9c73b9 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod70.stderr @@ -0,0 +1,2 @@ + +mod70.hs:3: Pattern syntax in expression context: ~1 diff --git a/testsuite/tests/ghc-regress/module/mod71.hs b/testsuite/tests/ghc-regress/module/mod71.hs new file mode 100644 index 0000000000..49cc66d4b1 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod71.hs @@ -0,0 +1,3 @@ +-- !!! Illegal _ in expression +module M where +f x = x _ 1 diff --git a/testsuite/tests/ghc-regress/module/mod71.stderr b/testsuite/tests/ghc-regress/module/mod71.stderr new file mode 100644 index 0000000000..cdac9e53fe --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod71.stderr @@ -0,0 +1,2 @@ + +mod71.hs:3: Pattern syntax in expression context: _ diff --git a/testsuite/tests/ghc-regress/module/mod72.hs b/testsuite/tests/ghc-regress/module/mod72.hs new file mode 100644 index 0000000000..355d235c1e --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod72.hs @@ -0,0 +1,3 @@ +-- !!! Undefined variable in expression +module M where +f x = g x diff --git a/testsuite/tests/ghc-regress/module/mod72.stderr b/testsuite/tests/ghc-regress/module/mod72.stderr new file mode 100644 index 0000000000..183f9242cc --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod72.stderr @@ -0,0 +1,2 @@ + +mod72.hs:3: Variable not in scope: `g' diff --git a/testsuite/tests/ghc-regress/module/mod73.hs b/testsuite/tests/ghc-regress/module/mod73.hs new file mode 100644 index 0000000000..dd825d997a --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod73.hs @@ -0,0 +1,3 @@ +-- !!! Undefined qualified variable in expression +module M where +f x = Prelude.g x diff --git a/testsuite/tests/ghc-regress/module/mod73.stderr b/testsuite/tests/ghc-regress/module/mod73.stderr new file mode 100644 index 0000000000..ce66f079cf --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod73.stderr @@ -0,0 +1,2 @@ + +mod73.hs:3: Variable not in scope: `Prelude.g' diff --git a/testsuite/tests/ghc-regress/module/mod74.hs b/testsuite/tests/ghc-regress/module/mod74.hs new file mode 100644 index 0000000000..af580a130b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod74.hs @@ -0,0 +1,3 @@ +-- !!! Undefined qualifier in expression +module M where +f x = N.g x diff --git a/testsuite/tests/ghc-regress/module/mod74.stderr b/testsuite/tests/ghc-regress/module/mod74.stderr new file mode 100644 index 0000000000..4625c77199 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod74.stderr @@ -0,0 +1,2 @@ + +mod74.hs:3: Variable not in scope: `N.g' diff --git a/testsuite/tests/ghc-regress/module/mod75.hs b/testsuite/tests/ghc-regress/module/mod75.hs new file mode 100644 index 0000000000..4428de8237 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod75.hs @@ -0,0 +1,3 @@ +-- !!! Qualifying with local module name +module M where +f x = M.f x diff --git a/testsuite/tests/ghc-regress/module/mod76.hs b/testsuite/tests/ghc-regress/module/mod76.hs new file mode 100644 index 0000000000..ccf4efa0ff --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod76.hs @@ -0,0 +1,7 @@ +-- !!! Multiple modules per file +module M where +foo = 'a' + +module N where +bar = 'b' + diff --git a/testsuite/tests/ghc-regress/module/mod76.stderr b/testsuite/tests/ghc-regress/module/mod76.stderr new file mode 100644 index 0000000000..fcf01d0ecc --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod76.stderr @@ -0,0 +1 @@ +mod76.hs:5: parse error on input `module' diff --git a/testsuite/tests/ghc-regress/module/mod77.hs b/testsuite/tests/ghc-regress/module/mod77.hs new file mode 100644 index 0000000000..ea5f89d53e --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod77.hs @@ -0,0 +1,4 @@ +-- !!! Naked fixity declaration +module M where +infix $$$ +x = 'a' diff --git a/testsuite/tests/ghc-regress/module/mod77.stderr b/testsuite/tests/ghc-regress/module/mod77.stderr new file mode 100644 index 0000000000..52187419ef --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod77.stderr @@ -0,0 +1,2 @@ + +mod77.hs:3: Variable not in scope: `$$$' diff --git a/testsuite/tests/ghc-regress/module/mod79.hs b/testsuite/tests/ghc-regress/module/mod79.hs new file mode 100644 index 0000000000..ae46dd88cd --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod79.hs @@ -0,0 +1,4 @@ +-- !!! Importing unknown class/tycon +module M where +import Prelude(C) + diff --git a/testsuite/tests/ghc-regress/module/mod79.stderr b/testsuite/tests/ghc-regress/module/mod79.stderr new file mode 100644 index 0000000000..8c3834832a --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod79.stderr @@ -0,0 +1,2 @@ + +mod79.hs:3: Module `Prelude' does not export `C' diff --git a/testsuite/tests/ghc-regress/module/mod8.hs b/testsuite/tests/ghc-regress/module/mod8.hs new file mode 100644 index 0000000000..8d7c3e003e --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod8.hs @@ -0,0 +1,3 @@ +-- !!! Exporting non-existent module +module M(module N) where +x = 'a' -- dummy definition to get round a separate bug diff --git a/testsuite/tests/ghc-regress/module/mod8.stderr b/testsuite/tests/ghc-regress/module/mod8.stderr new file mode 100644 index 0000000000..6bee7aa013 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod8.stderr @@ -0,0 +1,2 @@ + +mod8.hs:2: Unknown module in export list: module `N' diff --git a/testsuite/tests/ghc-regress/module/mod80.hs b/testsuite/tests/ghc-regress/module/mod80.hs new file mode 100644 index 0000000000..4ab1539054 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod80.hs @@ -0,0 +1,4 @@ +-- !!! Importing unknown name +module M where +import Prelude(f) + diff --git a/testsuite/tests/ghc-regress/module/mod80.stderr b/testsuite/tests/ghc-regress/module/mod80.stderr new file mode 100644 index 0000000000..606e19abd2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod80.stderr @@ -0,0 +1,2 @@ + +mod80.hs:3: Module `Prelude' does not export `f' diff --git a/testsuite/tests/ghc-regress/module/mod81.hs b/testsuite/tests/ghc-regress/module/mod81.hs new file mode 100644 index 0000000000..ef1c8639fd --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod81.hs @@ -0,0 +1,4 @@ +-- !!! Importing Tycon with bogus constructor +module M where +import Prelude(Either(Left,Right,Foo)) + diff --git a/testsuite/tests/ghc-regress/module/mod81.stderr b/testsuite/tests/ghc-regress/module/mod81.stderr new file mode 100644 index 0000000000..7261c73d72 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod81.stderr @@ -0,0 +1,3 @@ + +mod81.hs:3: + Module `Prelude' does not export `Either(Left, Right, Foo)' diff --git a/testsuite/tests/ghc-regress/module/mod82.hs b/testsuite/tests/ghc-regress/module/mod82.hs new file mode 100644 index 0000000000..62c630ac24 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod82.hs @@ -0,0 +1,4 @@ +-- !!! Importing Tycon with missing constructor +module M where +import Prelude(Either(Left)) + diff --git a/testsuite/tests/ghc-regress/module/mod83.hs b/testsuite/tests/ghc-regress/module/mod83.hs new file mode 100644 index 0000000000..efce6dd02f --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod83.hs @@ -0,0 +1,4 @@ +-- !!! Importing Tycon with duplicate constructor +module M where +import Prelude(Either(Left,Right,Right)) + diff --git a/testsuite/tests/ghc-regress/module/mod84.hs b/testsuite/tests/ghc-regress/module/mod84.hs new file mode 100644 index 0000000000..737cf7b14f --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod84.hs @@ -0,0 +1,4 @@ +-- !!! Correct tycon import (explicit constructor list) +module M where +import Prelude(Either(Left,Right)) +x = (Left 'a', Right 'a') diff --git a/testsuite/tests/ghc-regress/module/mod85.hs b/testsuite/tests/ghc-regress/module/mod85.hs new file mode 100644 index 0000000000..f9322f7517 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod85.hs @@ -0,0 +1,5 @@ +-- !!! Correct tycon import (implicit constructor list) +module M where +import Prelude(Either(..)) +x = (Left 'a', Right 'a') + diff --git a/testsuite/tests/ghc-regress/module/mod86.hs b/testsuite/tests/ghc-regress/module/mod86.hs new file mode 100644 index 0000000000..e143c44504 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod86.hs @@ -0,0 +1,4 @@ +-- !!! Correct abstract tycon import +module M where +import Prelude(Either) + diff --git a/testsuite/tests/ghc-regress/module/mod87.hs b/testsuite/tests/ghc-regress/module/mod87.hs new file mode 100644 index 0000000000..161ab3c031 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod87.hs @@ -0,0 +1,4 @@ +-- !!! Trying to use constructors of abstractly imported type. +module M where +import Prelude(Either) +x = Left 'a' diff --git a/testsuite/tests/ghc-regress/module/mod87.stderr b/testsuite/tests/ghc-regress/module/mod87.stderr new file mode 100644 index 0000000000..59e41700df --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod87.stderr @@ -0,0 +1,2 @@ + +mod87.hs:4: Data constructor not in scope: `Left' diff --git a/testsuite/tests/ghc-regress/module/mod88.hs b/testsuite/tests/ghc-regress/module/mod88.hs new file mode 100644 index 0000000000..aacf912915 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod88.hs @@ -0,0 +1,5 @@ +-- !!! Honouring qualified imports lists +-- was: Known bug: Qualified import ignores import list +module M where +import qualified Prelude (map) +x = Prelude.Left 'a' diff --git a/testsuite/tests/ghc-regress/module/mod88.stderr b/testsuite/tests/ghc-regress/module/mod88.stderr new file mode 100644 index 0000000000..9109ad4635 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod88.stderr @@ -0,0 +1,2 @@ + +mod88.hs:5: Data constructor not in scope: `Prelude.Left' diff --git a/testsuite/tests/ghc-regress/module/mod89.hs b/testsuite/tests/ghc-regress/module/mod89.hs new file mode 100644 index 0000000000..2c48d65a16 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod89.hs @@ -0,0 +1,4 @@ +-- !!! Sublist for non-class/tycon +module M where +import Prelude(map(..)) + diff --git a/testsuite/tests/ghc-regress/module/mod89.stderr b/testsuite/tests/ghc-regress/module/mod89.stderr new file mode 100644 index 0000000000..21d64a51f7 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod89.stderr @@ -0,0 +1 @@ +mod89.hs:3: parse error on input `(' diff --git a/testsuite/tests/ghc-regress/module/mod9.hs b/testsuite/tests/ghc-regress/module/mod9.hs new file mode 100644 index 0000000000..a08690679b --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod9.hs @@ -0,0 +1,3 @@ +-- !!! Exporting non-existent type transparently +module M(T(..)) where +x = 'a' -- dummy definition to get round a separate bug diff --git a/testsuite/tests/ghc-regress/module/mod9.stderr b/testsuite/tests/ghc-regress/module/mod9.stderr new file mode 100644 index 0000000000..7176dfb2fb --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod9.stderr @@ -0,0 +1,2 @@ + +mod9.hs:2: Type constructor or class not in scope: `T' diff --git a/testsuite/tests/ghc-regress/module/mod90.hs b/testsuite/tests/ghc-regress/module/mod90.hs new file mode 100644 index 0000000000..7b44ff57e2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod90.hs @@ -0,0 +1,4 @@ +-- !!! Sublist for non-class/tycon +module M where +import Prelude(Left(..)) + diff --git a/testsuite/tests/ghc-regress/module/mod90.stderr b/testsuite/tests/ghc-regress/module/mod90.stderr new file mode 100644 index 0000000000..a85a88e8ae --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod90.stderr @@ -0,0 +1,2 @@ + +mod90.hs:3: Module `Prelude' does not export `Left(..)' diff --git a/testsuite/tests/ghc-regress/module/mod91.hs b/testsuite/tests/ghc-regress/module/mod91.hs new file mode 100644 index 0000000000..8a7387e8ad --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod91.hs @@ -0,0 +1,4 @@ +-- !!! Importing Class with bogus member +module M where +import Prelude(Eq((==),(/=),eq)) + diff --git a/testsuite/tests/ghc-regress/module/mod91.stderr b/testsuite/tests/ghc-regress/module/mod91.stderr new file mode 100644 index 0000000000..188874aa67 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod91.stderr @@ -0,0 +1,2 @@ + +mod91.hs:3: Module `Prelude' does not export `Eq((==), (/=), eq)' diff --git a/testsuite/tests/ghc-regress/module/mod92.hs b/testsuite/tests/ghc-regress/module/mod92.hs new file mode 100644 index 0000000000..e9045b9335 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod92.hs @@ -0,0 +1,4 @@ +-- !!! Importing Class with missing member +module M where +import Prelude(Eq((==))) + diff --git a/testsuite/tests/ghc-regress/module/mod93.hs b/testsuite/tests/ghc-regress/module/mod93.hs new file mode 100644 index 0000000000..9dbd82cc9d --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod93.hs @@ -0,0 +1,4 @@ +-- !!! Importing Class with duplicate member +module M where +import Prelude(Eq((==),(/=),(==))) + diff --git a/testsuite/tests/ghc-regress/module/mod94.hs b/testsuite/tests/ghc-regress/module/mod94.hs new file mode 100644 index 0000000000..d485705132 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod94.hs @@ -0,0 +1,5 @@ +-- !!! Correct Class import (explicit member list) +module M where +import Prelude(Eq((==),(/=))) +x = 'a' == 'b' +y = 'a' /= 'b' diff --git a/testsuite/tests/ghc-regress/module/mod95.hs b/testsuite/tests/ghc-regress/module/mod95.hs new file mode 100644 index 0000000000..b1969b58a2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod95.hs @@ -0,0 +1,5 @@ +-- !!! Correct Class import (explicit member list) +module M where +import Prelude(Eq(..)) +x = 'a' == 'b' +y = 'a' /= 'b' diff --git a/testsuite/tests/ghc-regress/module/mod96.hs b/testsuite/tests/ghc-regress/module/mod96.hs new file mode 100644 index 0000000000..2f20be02b8 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod96.hs @@ -0,0 +1,4 @@ +-- !!! Correct abstract class import +module M where +import Prelude(Eq) + diff --git a/testsuite/tests/ghc-regress/module/mod97.hs b/testsuite/tests/ghc-regress/module/mod97.hs new file mode 100644 index 0000000000..ee51c8b9fb --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod97.hs @@ -0,0 +1,4 @@ +-- !!! Trying to use members of abstractly imported class +module M where +import Prelude(Eq) +x = 'a' == 'b' diff --git a/testsuite/tests/ghc-regress/module/mod97.stderr b/testsuite/tests/ghc-regress/module/mod97.stderr new file mode 100644 index 0000000000..e9f2b8e4dc --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod97.stderr @@ -0,0 +1,2 @@ + +mod97.hs:4: Variable not in scope: `==' diff --git a/testsuite/tests/ghc-regress/module/mod98.hs b/testsuite/tests/ghc-regress/module/mod98.hs new file mode 100644 index 0000000000..e0dc3c32c2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod98.hs @@ -0,0 +1,4 @@ +-- !!! Type signature for qualified name +module M where +M.x :: Char +x = 'a' diff --git a/testsuite/tests/ghc-regress/module/mod98.stderr b/testsuite/tests/ghc-regress/module/mod98.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod98.stderr diff --git a/testsuite/tests/ghc-regress/module/mod99.hs b/testsuite/tests/ghc-regress/module/mod99.hs new file mode 100644 index 0000000000..8298cf1c69 --- /dev/null +++ b/testsuite/tests/ghc-regress/module/mod99.hs @@ -0,0 +1,4 @@ +-- !!! Empty export list +module M(,) where + +x = 2 |