diff options
Diffstat (limited to 'testsuite/tests')
281 files changed, 2437 insertions, 891 deletions
diff --git a/testsuite/tests/annotations/should_compile/th/AnnHelper.hs b/testsuite/tests/annotations/should_compile/th/AnnHelper.hs new file mode 100644 index 0000000000..ac0f040ba0 --- /dev/null +++ b/testsuite/tests/annotations/should_compile/th/AnnHelper.hs @@ -0,0 +1,16 @@ +module AnnHelper where + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +traverseModuleAnnotations :: Q [String] +traverseModuleAnnotations = do + ModuleInfo children <- reifyModule =<< thisModule + go children [] [] + where + go [] _visited acc = return acc + go (x:xs) visited acc | x `elem` visited = go xs visited acc + | otherwise = do + ModuleInfo newMods <- reifyModule x + newAnns <- reifyAnnotations $ AnnLookupModule x + go (newMods ++ xs) (x:visited) (newAnns ++ acc) diff --git a/testsuite/tests/annotations/should_compile/th/Makefile b/testsuite/tests/annotations/should_compile/th/Makefile new file mode 100644 index 0000000000..4159eeeda1 --- /dev/null +++ b/testsuite/tests/annotations/should_compile/th/Makefile @@ -0,0 +1,33 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +annth_make: + $(MAKE) clean_annth_make + mkdir build_make + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make \ + -odir build_make -hidir build_make -o build_make/annth annth.hs + +clean_annth_make: + rm -rf build_make + +annth_compunits: + $(MAKE) clean_annth_compunits + mkdir build_compunits + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \ + -odir build_compunits -hidir build_compunits \ + -c AnnHelper.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \ + -odir build_compunits -hidir build_compunits \ + -c TestModule.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \ + -odir build_compunits -hidir build_compunits \ + -c TestModuleTH.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -ibuild_compunits \ + -odir build_compunits -hidir build_compunits \ + -c annth.hs + +clean_annth_compunits: + rm -rf build_compunits + +.PHONY: annth_make clean_annth_make annth_compunits clean_annth_compunits diff --git a/testsuite/tests/annotations/should_compile/th/TestModule.hs b/testsuite/tests/annotations/should_compile/th/TestModule.hs new file mode 100644 index 0000000000..d9519eb8b2 --- /dev/null +++ b/testsuite/tests/annotations/should_compile/th/TestModule.hs @@ -0,0 +1,11 @@ +module TestModule where + +{-# ANN module "Module annotation" #-} + +{-# ANN type TestType "Type annotation" #-} +{-# ANN TestType "Constructor annotation" #-} +data TestType = TestType + +{-# ANN testValue "Value annotation" #-} +testValue :: Int +testValue = 42 diff --git a/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs new file mode 100644 index 0000000000..f21b13764b --- /dev/null +++ b/testsuite/tests/annotations/should_compile/th/TestModuleTH.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TemplateHaskell #-} + +module TestModuleTH where + +import Language.Haskell.TH + +$(do + modAnn <- pragAnnD ModuleAnnotation + (stringE "TH module annotation") + [typ] <- [d| data TestTypeTH = TestTypeTH |] + conAnn <- pragAnnD (ValueAnnotation $ mkName "TestTypeTH") + (stringE "TH Constructor annotation") + typAnn <- pragAnnD (TypeAnnotation $ mkName "TestTypeTH") + (stringE "TH Type annotation") + valAnn <- pragAnnD (ValueAnnotation $ mkName "testValueTH") + (stringE "TH Value annotation") + [val] <- [d| testValueTH = (42 :: Int) |] + return [modAnn, conAnn, typAnn, typ, valAnn, val] ) diff --git a/testsuite/tests/annotations/should_compile/th/all.T b/testsuite/tests/annotations/should_compile/th/all.T new file mode 100644 index 0000000000..b44a0d594f --- /dev/null +++ b/testsuite/tests/annotations/should_compile/th/all.T @@ -0,0 +1,22 @@ +setTestOpts(when(compiler_profiled(), skip)) + +# Annotations and Template Haskell, require runtime evaluation. In +# order for this to work with profiling, we would have to build the +# program twice and use -osuf p_o (see the TH_splitE5_prof test). For +# now, just disable the profiling ways. + +test('annth_make', + [req_interp, + omit_ways(['profasm','profthreaded']), + unless(have_dynamic(),skip), + clean_cmd('$MAKE -s clean_annth_make')], + run_command, + ['$MAKE -s --no-print-directory annth_make']) + +test('annth_compunits', + [req_interp, + omit_ways(['profasm','profthreaded']), + unless(have_dynamic(),skip), + clean_cmd('$MAKE -s clean_annth_compunits')], + run_command, + ['$MAKE -s --no-print-directory annth_compunits']) diff --git a/testsuite/tests/annotations/should_compile/th/annth.hs b/testsuite/tests/annotations/should_compile/th/annth.hs new file mode 100644 index 0000000000..de5d4d32a8 --- /dev/null +++ b/testsuite/tests/annotations/should_compile/th/annth.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE TemplateHaskell #-} + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +import AnnHelper +import TestModule +import TestModuleTH + +main = do + $(do + anns <- traverseModuleAnnotations + runIO $ print (anns :: [String]) + anns <- reifyAnnotations (AnnLookupName 'testValue) + runIO $ print (anns :: [String]) + anns <- reifyAnnotations (AnnLookupName 'testValueTH) + runIO $ print (anns :: [String]) + anns <- reifyAnnotations (AnnLookupName ''TestType) + runIO $ print (anns :: [String]) + anns <- reifyAnnotations (AnnLookupName ''TestTypeTH) + runIO $ print (anns :: [String]) + anns <- reifyAnnotations (AnnLookupName 'TestType) + runIO $ print (anns :: [String]) + anns <- reifyAnnotations (AnnLookupName 'TestTypeTH) + runIO $ print (anns :: [String]) + [| return () |] ) diff --git a/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout new file mode 100644 index 0000000000..96e4642c7e --- /dev/null +++ b/testsuite/tests/annotations/should_compile/th/annth_compunits.stdout @@ -0,0 +1,7 @@ +["TH module annotation","Module annotation"] +["Value annotation"] +["TH Value annotation"] +["Type annotation"] +["TH Type annotation"] +["Constructor annotation"] +["TH Constructor annotation"] diff --git a/testsuite/tests/annotations/should_compile/th/annth_make.stdout b/testsuite/tests/annotations/should_compile/th/annth_make.stdout new file mode 100644 index 0000000000..96e4642c7e --- /dev/null +++ b/testsuite/tests/annotations/should_compile/th/annth_make.stdout @@ -0,0 +1,7 @@ +["TH module annotation","Module annotation"] +["Value annotation"] +["TH Value annotation"] +["Type annotation"] +["TH Type annotation"] +["Constructor annotation"] +["TH Constructor annotation"] diff --git a/testsuite/tests/callarity/perf/all.T b/testsuite/tests/callarity/perf/all.T index 765a2e94a7..1c7969474c 100644 --- a/testsuite/tests/callarity/perf/all.T +++ b/testsuite/tests/callarity/perf/all.T @@ -1,8 +1,9 @@ test('T3924', [stats_num_field('bytes allocated', - [ (wordsize(64), 51480, 5), + [ (wordsize(64), 50760, 5), # previously, without call-arity: 22326544 # 2014-01-18: 51480 (amd64/Linux) + # 2014-07-17: 50760 (amd64/Linux) (Roundabout adjustment) (wordsize(32), 44988, 5) ]), # 2014-04-04: 44988 (Windows, 64-bit machine) only_ways(['normal']) diff --git a/testsuite/tests/codeGen/should_compile/T9155.hs b/testsuite/tests/codeGen/should_compile/T9155.hs new file mode 100644 index 0000000000..6fac0bcee6 --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T9155.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module M () where + +import Data.Bits ((.&.)) + +bitsSet :: Int -> Int -> Bool +bitsSet mask i + = (i .&. mask == mask) + +class Eq b => BitMask b where + assocBitMask :: [(b,Int)] + + fromBitMask :: Int -> b + fromBitMask i + = walk assocBitMask + where + walk [] = error "Graphics.UI.WX.Types.fromBitMask: empty list" + walk [(x,0)] = x + walk ((x,m):xs) | bitsSet m i = x + | otherwise = walk xs + +data Align = AlignLeft + | AlignCentre + deriving Eq + +instance BitMask Align where + assocBitMask + = [(AlignCentre,512) + ,(AlignLeft, 256) + ] diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 487b6b653c..ae8d0dd24a 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -22,3 +22,4 @@ test('massive_array', test('T7237', normal, compile, ['']) test('T7574', [cmm_src, omit_ways(['llvm', 'optllvm'])], compile, ['']) test('T8205', normal, compile, ['-O0']) +test('T9155', normal, compile, ['-O2']) diff --git a/testsuite/tests/codeGen/should_run/T9001.hs b/testsuite/tests/codeGen/should_run/T9001.hs new file mode 100644 index 0000000000..3fae93efa0 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T9001.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RankNTypes #-} + +newtype FMList = FM {unFM :: forall m. m -> m} + +main = print (delete 2000 (FM id) :: Int) + +delete 0 _ = 0 +delete n (FM a) = a $ delete (n-1) $ FM $ \g -> a (const g) undefined diff --git a/testsuite/tests/codeGen/should_run/T9001.stdout b/testsuite/tests/codeGen/should_run/T9001.stdout new file mode 100644 index 0000000000..573541ac97 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T9001.stdout @@ -0,0 +1 @@ +0 diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 9077af2e0c..2d66c42aa3 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -48,9 +48,7 @@ test('cgrun047', normal, compile_and_run, ['']) test('cgrun048', normal, compile_and_run, ['']) test('cgrun049', normal, compile_and_run, ['-funbox-strict-fields']) test('cgrun050', normal, compile_and_run, ['']) -# Doesn't work with External Core due to datatype declaration with no constructors -test('cgrun051', [expect_fail_for(['extcore','optextcore']), exit_code(1)], - compile_and_run, ['']) +test('cgrun051', [exit_code(1)], compile_and_run, ['']) test('cgrun052', only_ways(['optasm']), compile_and_run, ['-funbox-strict-fields']) test('cgrun053', normal, compile_and_run, ['']) test('cgrun054', normal, compile_and_run, ['']) @@ -121,3 +119,4 @@ test('StaticByteArraySize', normal, compile_and_run, ['-O2']) test('CopySmallArray', normal, compile_and_run, ['']) test('CopySmallArrayStressTest', reqlib('random'), compile_and_run, ['']) test('SizeOfSmallArray', normal, compile_and_run, ['']) +test('T9001', normal, compile_and_run, ['']) diff --git a/testsuite/tests/concurrent/should_run/AtomicPrimops.hs b/testsuite/tests/concurrent/should_run/AtomicPrimops.hs new file mode 100644 index 0000000000..0c55aba93e --- /dev/null +++ b/testsuite/tests/concurrent/should_run/AtomicPrimops.hs @@ -0,0 +1,245 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +module Main ( main ) where + +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Monad (when) +import Foreign.Storable +import GHC.Exts +import GHC.IO + +-- | Iterations per worker. +iters :: Int +iters = 1000000 + +main :: IO () +main = do + fetchAddSubTest + fetchAndTest + fetchNandTest + fetchOrTest + fetchXorTest + casTest + readWriteTest + +-- | Test fetchAddIntArray# by having two threads concurrenctly +-- increment a counter and then checking the sum at the end. +fetchAddSubTest :: IO () +fetchAddSubTest = do + tot <- race 0 + (\ mba -> work fetchAddIntArray mba iters 2) + (\ mba -> work fetchSubIntArray mba iters 1) + assertEq 1000000 tot "fetchAddSubTest" + where + work :: (MByteArray -> Int -> Int -> IO ()) -> MByteArray -> Int -> Int + -> IO () + work op mba 0 val = return () + work op mba n val = op mba 0 val >> work op mba (n-1) val + +-- | Test fetchXorIntArray# by having two threads concurrenctly XORing +-- and then checking the result at the end. Works since XOR is +-- commutative. +-- +-- Covers the code paths for AND, NAND, and OR as well. +fetchXorTest :: IO () +fetchXorTest = do + res <- race n0 + (\ mba -> work mba iters t1pat) + (\ mba -> work mba iters t2pat) + assertEq expected res "fetchXorTest" + where + work :: MByteArray -> Int -> Int -> IO () + work mba 0 val = return () + work mba n val = fetchXorIntArray mba 0 val >> work mba (n-1) val + + -- Initial value is a large prime and the two patterns are 1010... + -- and 0101... + (n0, t1pat, t2pat) + | sizeOf (undefined :: Int) == 8 = + (0x00000000ffffffff, 0x5555555555555555, 0x9999999999999999) + | otherwise = (0x0000ffff, 0x55555555, 0x99999999) + expected + | sizeOf (undefined :: Int) == 8 = 4294967295 + | otherwise = 65535 + +-- The tests for AND, NAND, and OR are trivial for two reasons: +-- +-- * The code path is already well exercised by 'fetchXorTest'. +-- +-- * It's harder to test these operations, as a long sequence of them +-- convert to a single value but we'd like to write a test in the +-- style of 'fetchXorTest' that applies the operation repeatedly, +-- to make it likely that any race conditions are detected. +-- +-- Right now we only test that they return the correct value for a +-- single op on each thread. + +fetchOpTest :: (MByteArray -> Int -> Int -> IO ()) + -> Int -> String -> IO () +fetchOpTest op expected name = do + res <- race n0 + (\ mba -> work mba t1pat) + (\ mba -> work mba t2pat) + assertEq expected res name + where + work :: MByteArray -> Int -> IO () + work mba val = op mba 0 val + + -- Initial value is a large prime and the two patterns are 1010... + -- and 0101... + (n0, t1pat, t2pat) + | sizeOf (undefined :: Int) == 8 = + (0x00000000ffffffff, 0x5555555555555555, 0x9999999999999999) + | otherwise = (0x0000ffff, 0x55555555, 0x99999999) + +fetchAndTest :: IO () +fetchAndTest = fetchOpTest fetchAndIntArray expected "fetchAndTest" + where expected + | sizeOf (undefined :: Int) == 8 = 286331153 + | otherwise = 4369 + +fetchNandTest :: IO () +fetchNandTest = fetchOpTest fetchNandIntArray expected "fetchNandTest" + where expected + | sizeOf (undefined :: Int) == 8 = 7378697629770151799 + | otherwise = -2576976009 + +fetchOrTest :: IO () +fetchOrTest = fetchOpTest fetchOrIntArray expected "fetchOrTest" + where expected + | sizeOf (undefined :: Int) == 8 = 15987178197787607039 + | otherwise = 3722313727 + +-- | Test casIntArray# by using it to emulate fetchAddIntArray# and +-- then having two threads concurrenctly increment a counter, +-- checking the sum at the end. +casTest :: IO () +casTest = do + tot <- race 0 + (\ mba -> work mba iters 1) + (\ mba -> work mba iters 2) + assertEq 3000000 tot "casTest" + where + work :: MByteArray -> Int -> Int -> IO () + work mba 0 val = return () + work mba n val = add mba 0 val >> work mba (n-1) val + + -- Fetch-and-add implemented using CAS. + add :: MByteArray -> Int -> Int -> IO () + add mba ix n = do + old <- readIntArray mba ix + old' <- casIntArray mba ix old (old + n) + when (old /= old') $ add mba ix n + +-- | Tests atomic reads and writes by making sure that one thread sees +-- updates that are done on another. This test isn't very good at the +-- moment, as this might work even without atomic ops, but at least it +-- exercises the code. +readWriteTest :: IO () +readWriteTest = do + mba <- newByteArray (sizeOf (undefined :: Int)) + writeIntArray mba 0 0 + latch <- newEmptyMVar + done <- newEmptyMVar + forkIO $ do + takeMVar latch + n <- atomicReadIntArray mba 0 + assertEq 1 n "readWriteTest" + putMVar done () + atomicWriteIntArray mba 0 1 + putMVar latch () + takeMVar done + +-- | Create two threads that mutate the byte array passed to them +-- concurrently. The array is one word large. +race :: Int -- ^ Initial value of array element + -> (MByteArray -> IO ()) -- ^ Thread 1 action + -> (MByteArray -> IO ()) -- ^ Thread 2 action + -> IO Int -- ^ Final value of array element +race n0 thread1 thread2 = do + done1 <- newEmptyMVar + done2 <- newEmptyMVar + mba <- newByteArray (sizeOf (undefined :: Int)) + writeIntArray mba 0 n0 + forkIO $ thread1 mba >> putMVar done1 () + forkIO $ thread2 mba >> putMVar done2 () + mapM_ takeMVar [done1, done2] + readIntArray mba 0 + +------------------------------------------------------------------------ +-- Test helper + +assertEq :: (Eq a, Show a) => a -> a -> String -> IO () +assertEq expected actual name + | expected == actual = putStrLn $ name ++ ": OK" + | otherwise = do + putStrLn $ name ++ ": FAIL" + putStrLn $ "Expected: " ++ show expected + putStrLn $ " Actual: " ++ show actual + +------------------------------------------------------------------------ +-- Wrappers around MutableByteArray# + +data MByteArray = MBA (MutableByteArray# RealWorld) + +fetchAddIntArray :: MByteArray -> Int -> Int -> IO () +fetchAddIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# -> + case fetchAddIntArray# mba# ix# n# s# of + (# s2#, _ #) -> (# s2#, () #) + +fetchSubIntArray :: MByteArray -> Int -> Int -> IO () +fetchSubIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# -> + case fetchSubIntArray# mba# ix# n# s# of + (# s2#, _ #) -> (# s2#, () #) + +fetchAndIntArray :: MByteArray -> Int -> Int -> IO () +fetchAndIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# -> + case fetchAndIntArray# mba# ix# n# s# of + (# s2#, _ #) -> (# s2#, () #) + +fetchNandIntArray :: MByteArray -> Int -> Int -> IO () +fetchNandIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# -> + case fetchNandIntArray# mba# ix# n# s# of + (# s2#, _ #) -> (# s2#, () #) + +fetchOrIntArray :: MByteArray -> Int -> Int -> IO () +fetchOrIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# -> + case fetchOrIntArray# mba# ix# n# s# of + (# s2#, _ #) -> (# s2#, () #) + +fetchXorIntArray :: MByteArray -> Int -> Int -> IO () +fetchXorIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# -> + case fetchXorIntArray# mba# ix# n# s# of + (# s2#, _ #) -> (# s2#, () #) + +newByteArray :: Int -> IO MByteArray +newByteArray (I# n#) = IO $ \ s# -> + case newByteArray# n# s# of + (# s2#, mba# #) -> (# s2#, MBA mba# #) + +writeIntArray :: MByteArray -> Int -> Int -> IO () +writeIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# -> + case writeIntArray# mba# ix# n# s# of + s2# -> (# s2#, () #) + +readIntArray :: MByteArray -> Int -> IO Int +readIntArray (MBA mba#) (I# ix#) = IO $ \ s# -> + case readIntArray# mba# ix# s# of + (# s2#, n# #) -> (# s2#, I# n# #) + +atomicWriteIntArray :: MByteArray -> Int -> Int -> IO () +atomicWriteIntArray (MBA mba#) (I# ix#) (I# n#) = IO $ \ s# -> + case atomicWriteIntArray# mba# ix# n# s# of + s2# -> (# s2#, () #) + +atomicReadIntArray :: MByteArray -> Int -> IO Int +atomicReadIntArray (MBA mba#) (I# ix#) = IO $ \ s# -> + case atomicReadIntArray# mba# ix# s# of + (# s2#, n# #) -> (# s2#, I# n# #) + +casIntArray :: MByteArray -> Int -> Int -> Int -> IO Int +casIntArray (MBA mba#) (I# ix#) (I# old#) (I# new#) = IO $ \ s# -> + case casIntArray# mba# ix# old# new# s# of + (# s2#, old2# #) -> (# s2#, I# old2# #) diff --git a/testsuite/tests/concurrent/should_run/AtomicPrimops.stdout b/testsuite/tests/concurrent/should_run/AtomicPrimops.stdout new file mode 100644 index 0000000000..c37041a040 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/AtomicPrimops.stdout @@ -0,0 +1,7 @@ +fetchAddSubTest: OK +fetchAndTest: OK +fetchNandTest: OK +fetchOrTest: OK +fetchXorTest: OK +casTest: OK +readWriteTest: OK diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index d4e76c6b1e..0a66892d82 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -78,8 +78,10 @@ test('readMVar1', normal, compile_and_run, ['']) test('readMVar2', normal, compile_and_run, ['']) test('readMVar3', normal, compile_and_run, ['']) test('tryReadMVar1', normal, compile_and_run, ['']) +test('tryReadMVar2', normal, compile_and_run, ['']) test('T7970', normal, compile_and_run, ['']) +test('AtomicPrimops', normal, compile_and_run, ['']) # ----------------------------------------------------------------------------- # These tests we only do for a full run diff --git a/testsuite/tests/concurrent/should_run/tryReadMVar2.hs b/testsuite/tests/concurrent/should_run/tryReadMVar2.hs new file mode 100644 index 0000000000..13b8a45c32 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/tryReadMVar2.hs @@ -0,0 +1,15 @@ +module Main where + +import Control.Concurrent +import Control.Monad + +main = do + m <- newEmptyMVar + done <- newEmptyMVar + let q = 200000 + forkIO (do mapM (\n -> putMVar m n) [1..q]; putMVar done ()) + forkIO (do replicateM_ q $ readMVar m; putMVar done ()) + forkIO (do replicateM_ q $ tryReadMVar m; putMVar done ()) + forkIO (do replicateM_ q $ takeMVar m; putMVar done ()) + replicateM_ 4 $ takeMVar done + diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index dbafaedf82..c40b603d3f 100644 --- a/testsuite/tests/deSugar/should_compile/T2431.stderr +++ b/testsuite/tests/deSugar/should_compile/T2431.stderr @@ -13,7 +13,7 @@ T2431.$WRefl [InlPrag=INLINE] :: forall a. a T2431.:~: a T2431.$WRefl = \ (@ a) -> T2431.Refl @ a @ a @~ <a>_N T2431.absurd - :: forall a. (GHC.Types.Int T2431.:~: GHC.Types.Bool) -> a + :: forall a. GHC.Types.Int T2431.:~: GHC.Types.Bool -> a [GblId, Arity=1, Caf=NoCafRefs, Str=DmdType <L,U>b] T2431.absurd = \ (@ a) (x :: GHC.Types.Int T2431.:~: GHC.Types.Bool) -> diff --git a/testsuite/tests/deriving/should_compile/T7269.hs b/testsuite/tests/deriving/should_compile/T7269.hs new file mode 100644 index 0000000000..2d7331bebb --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T7269.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, GeneralizedNewtypeDeriving #-} + +module T7269 where + +class C (a :: k) + +instance C Int + +newtype MyInt = MyInt Int deriving C + +newtype YourInt = YourInt Int +deriving instance C YourInt diff --git a/testsuite/tests/deriving/should_compile/T9069.hs b/testsuite/tests/deriving/should_compile/T9069.hs new file mode 100644 index 0000000000..7ab3af3489 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T9069.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DeriveTraversable #-} + +module T9069 where + +import Data.Foldable +import Data.Traversable + +data Trivial a = Trivial a + deriving (Functor,Foldable,Traversable)
\ No newline at end of file diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 224b99ef00..f440e8043e 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -49,3 +49,5 @@ test('T8865', normal, compile, ['']) test('T8893', normal, compile, ['']) test('T8950', expect_broken(8950), compile, ['']) test('T8963', normal, compile, ['']) +test('T7269', normal, compile, ['']) +test('T9069', normal, compile, ['']) diff --git a/testsuite/tests/deriving/should_fail/T7959.hs b/testsuite/tests/deriving/should_fail/T7959.hs index a798bb0666..000e759be5 100644 --- a/testsuite/tests/deriving/should_fail/T7959.hs +++ b/testsuite/tests/deriving/should_fail/T7959.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NullaryTypeClasses, StandaloneDeriving #-} +{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving #-} module T7959 where class A diff --git a/testsuite/tests/deriving/should_fail/T7959.stderr b/testsuite/tests/deriving/should_fail/T7959.stderr index dde9ee0034..5ca93a7fe3 100644 --- a/testsuite/tests/deriving/should_fail/T7959.stderr +++ b/testsuite/tests/deriving/should_fail/T7959.stderr @@ -4,5 +4,5 @@ T7959.hs:5:1: In the stand-alone deriving instance for ‘A’ T7959.hs:6:17: - Cannot derive instances for nullary classes + Expected kind ‘k0 -> Constraint’, but ‘A’ has kind ‘Constraint’ In the data declaration for ‘B’ diff --git a/testsuite/tests/deriving/should_fail/T9071-2.hs b/testsuite/tests/deriving/should_fail/T9071-2.hs new file mode 100644 index 0000000000..7a2f4749ce --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071-2.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DeriveFunctor #-} +module T9071_2 where + +newtype Mu f = Mu (f (Mu f)) + +newtype K1 a b = K1 a +newtype F1 a = F1 (Mu (K1 a)) deriving Functor diff --git a/testsuite/tests/deriving/should_fail/T9071.hs b/testsuite/tests/deriving/should_fail/T9071.hs new file mode 100644 index 0000000000..dc64f42db8 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DeriveFunctor #-} +module T9071 where + +import T9071a + +newtype K a b = K a +newtype F a = F (Mu (K a)) deriving Functor + diff --git a/testsuite/tests/deriving/should_fail/T9071.stderr b/testsuite/tests/deriving/should_fail/T9071.stderr new file mode 100644 index 0000000000..259adbaef0 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071.stderr @@ -0,0 +1,10 @@ +[1 of 2] Compiling T9071a ( T9071a.hs, T9071a.o ) +[2 of 2] Compiling T9071 ( T9071.hs, T9071.o ) + +T9071.hs:7:37: + No instance for (Functor K) + arising from the first field of ‘F’ (type ‘Mu (K a)’) + Possible fix: + use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Functor F) diff --git a/testsuite/tests/deriving/should_fail/T9071_2.hs b/testsuite/tests/deriving/should_fail/T9071_2.hs new file mode 100644 index 0000000000..7a2f4749ce --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071_2.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DeriveFunctor #-} +module T9071_2 where + +newtype Mu f = Mu (f (Mu f)) + +newtype K1 a b = K1 a +newtype F1 a = F1 (Mu (K1 a)) deriving Functor diff --git a/testsuite/tests/deriving/should_fail/T9071_2.stderr b/testsuite/tests/deriving/should_fail/T9071_2.stderr new file mode 100644 index 0000000000..ae0fcdb928 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071_2.stderr @@ -0,0 +1,8 @@ + +T9071_2.hs:7:40: + No instance for (Functor Mu) + arising from the first field of ‘F1’ (type ‘Mu (K1 a)’) + Possible fix: + use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Functor F1) diff --git a/testsuite/tests/deriving/should_fail/T9071a.hs b/testsuite/tests/deriving/should_fail/T9071a.hs new file mode 100644 index 0000000000..bf3a126a19 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T9071a.hs @@ -0,0 +1,4 @@ +module T9071a where + +newtype Mu f = Mu (f (Mu f)) + diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index d503b6e266..99da88a55b 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -50,3 +50,6 @@ test('T7800', normal, multimod_compile_fail, ['T7800','']) test('T5498', normal, compile_fail, ['']) test('T6147', normal, compile_fail, ['']) test('T8851', normal, compile_fail, ['']) +test('T9071', normal, multimod_compile_fail, ['T9071','']) +test('T9071_2', normal, compile_fail, ['']) + diff --git a/testsuite/tests/deriving/should_fail/drvfail005.stderr b/testsuite/tests/deriving/should_fail/drvfail005.stderr index b5a2de8d01..1546a37d07 100644 --- a/testsuite/tests/deriving/should_fail/drvfail005.stderr +++ b/testsuite/tests/deriving/should_fail/drvfail005.stderr @@ -1,5 +1,5 @@ drvfail005.hs:4:13: - Can't make a derived instance of ‘Show a (Test a)’: - ‘Show a’ is not a class + Expected kind ‘k0 -> Constraint’, + but ‘Show a’ has kind ‘Constraint’ In the data declaration for ‘Test’ diff --git a/testsuite/tests/deriving/should_fail/drvfail009.stderr b/testsuite/tests/deriving/should_fail/drvfail009.stderr index fcc5b4c305..b9dd90c758 100644 --- a/testsuite/tests/deriving/should_fail/drvfail009.stderr +++ b/testsuite/tests/deriving/should_fail/drvfail009.stderr @@ -1,8 +1,8 @@ drvfail009.hs:10:31: - Can't make a derived instance of ‘C T1’ - (even with cunning newtype deriving): - ‘C’ does not have arity 1 + Expecting one more argument to ‘C’ + Expected kind ‘* -> Constraint’, + but ‘C’ has kind ‘* -> * -> Constraint’ In the newtype declaration for ‘T1’ drvfail009.hs:13:31: diff --git a/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr b/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr index 749c3cdfeb..bf6f453f71 100644 --- a/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr +++ b/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr @@ -1,6 +1,9 @@ [1 of 1] Compiling ExportList ( ExportList.hs, ExportList.o ) Warning: vectorisation failure: identityConvTyCon: type constructor contains parallel arrays [::] - Could NOT call vectorised from original version ExportList.solveV + Could NOT call vectorised from original version + ExportList.solveV :: GHC.Types.Double -> [:GHC.Types.Double:] Warning: vectorisation failure: identityConvTyCon: type constructor contains parallel arrays NodeV Could NOT call vectorised from original version - ExportList.solvePA + ExportList.solvePA :: ExportList.NodeV + -> GHC.Types.Double + -> Data.Array.Parallel.PArray.PData.Base.PArray GHC.Types.Double diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index 3603bb6bcd..62aa2f92c8 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -556,9 +556,25 @@ T6037: T2507: -LC_ALL=C "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -c T2507.hs +.PHONY: T8959a +T8959a: + -LC_ALL=C "$(TEST_HC)" $(TEST_HC_OPTS_NO_RECOMP) -c T8959a.hs -XUnicodeSyntax + .PHONY: T703 T703: $(RM) -rf T703 [ ! -d T703 ] "$(TEST_HC)" $(TEST_HC_OPTS) --make T703.hs -v0 ! readelf -W -l T703 2>/dev/null | grep 'GNU_STACK' | grep -q 'RWE' + +.PHONY: write_interface_oneshot +write_interface_oneshot: + $(RM) -rf write_interface_oneshot/A011.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_oneshot -fno-code -fwrite-interface -c A011.hs + test -f write_interface_oneshot/A011.hi + +.PHONY: write_interface_make +write_interface_make: + $(RM) -rf write_interface_make/A011.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_make -fno-code -fwrite-interface --make A011.hs + test -f write_interface_make/A011.hi diff --git a/testsuite/tests/driver/T8959a.hs b/testsuite/tests/driver/T8959a.hs new file mode 100644 index 0000000000..6f8fd77d15 --- /dev/null +++ b/testsuite/tests/driver/T8959a.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE UnicodeSyntax #-} +module T8959a where + +foo :: Int -> Int +foo = () diff --git a/testsuite/tests/driver/T8959a.stderr b/testsuite/tests/driver/T8959a.stderr new file mode 100644 index 0000000000..f270bb6d6e --- /dev/null +++ b/testsuite/tests/driver/T8959a.stderr @@ -0,0 +1,5 @@ + +T8959a.hs:5:7: + Couldn't match expected type `Int -> Int' with actual type `()' + In the expression: () + In an equation for `foo': foo = () diff --git a/testsuite/tests/driver/T9050.cmm b/testsuite/tests/driver/T9050.cmm new file mode 100644 index 0000000000..8b1a393741 --- /dev/null +++ b/testsuite/tests/driver/T9050.cmm @@ -0,0 +1 @@ +// empty diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index ed0ce0f8cb..7236ec1a3a 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -391,7 +391,18 @@ test('T2507', [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail)], run_command, ['$MAKE -s --no-print-directory T2507']) +test('T8959a', + # The testsuite doesn't know how to set a non-Unicode locale on Windows or Mac OS X + [when(opsys('mingw32'), expect_fail), when(opsys('darwin'), expect_fail)], + run_command, + ['$MAKE -s --no-print-directory T8959a']) test('T703', normal, run_command, ['$MAKE -s --no-print-directory T703']) test('T8101', normal, compile, ['-Wall -fno-code']) +def build_T9050(name, way): + return simple_build(name + '.cmm', way, '-outputdir=. ', 0, '', 0, 0, 0) +test('T9050', normal, build_T9050, []) + +test('write_interface_oneshot', normal, run_command, ['$MAKE -s --no-print-directory write_interface_oneshot']) +test('write_interface_make', normal, run_command, ['$MAKE -s --no-print-directory write_interface_make']) diff --git a/testsuite/tests/driver/recomp006/recomp006.stderr b/testsuite/tests/driver/recomp006/recomp006.stderr index 7119ff540b..25b48f375f 100644 --- a/testsuite/tests/driver/recomp006/recomp006.stderr +++ b/testsuite/tests/driver/recomp006/recomp006.stderr @@ -1,6 +1,7 @@ A.hs:8:8: - Couldn't match expected type ‘Int’ with actual type ‘(t0, t1)’ + Couldn't match expected type ‘Int’ + with actual type ‘(Integer, Integer)’ In the expression: (2, 3) In the expression: (1, (2, 3)) In an equation for ‘f’: f = (1, (2, 3)) diff --git a/testsuite/tests/driver/write_interface_make.stdout b/testsuite/tests/driver/write_interface_make.stdout new file mode 100644 index 0000000000..1594f5ee2f --- /dev/null +++ b/testsuite/tests/driver/write_interface_make.stdout @@ -0,0 +1 @@ +[1 of 1] Compiling A011 ( A011.hs, nothing ) diff --git a/testsuite/tests/ext-core/Makefile b/testsuite/tests/ext-core/Makefile deleted file mode 100644 index d52dd9c428..0000000000 --- a/testsuite/tests/ext-core/Makefile +++ /dev/null @@ -1,29 +0,0 @@ -TOP=../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - -# T5881 needs a script because it goes wrong only when -# the modules are compiled separately, not with --make -T5881: - $(RM) -f T5881.hi T5881.o T5881a.hi T5881a.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T5881a.hs - '$(TEST_HC)' $(TEST_HC_OPTS) -c T5881.hs - -# T6025 is like T5881; needs separate compile -T6025: - $(RM) -f T6025.hi T6025.o T6025a.hi T6025a.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T6025a.hs - '$(TEST_HC)' $(TEST_HC_OPTS) -c T6025.hs - -# T6054 is like T5881; needs separate compile -# The second compile fails, and should do so, hence leading "-" -T6054: - $(RM) -f T6054.hi T6054.o T6054a.hi T6054a.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T6054a.hs - -'$(TEST_HC)' $(TEST_HC_OPTS) -c T6054.hs - -T7022: - $(RM) -f T7022.hi T7022.o T7022a.hi T7022a.o T7022b.hi T7022b.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T7022a.hs - '$(TEST_HC)' $(TEST_HC_OPTS) -c T7022b.hs -v0 - -'$(TEST_HC)' $(TEST_HC_OPTS) -c -v0 T7022.hs diff --git a/testsuite/tests/ext-core/T7239.hs b/testsuite/tests/ext-core/T7239.hs deleted file mode 100644 index 4331b9e493..0000000000 --- a/testsuite/tests/ext-core/T7239.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Main where - -data T a = T a - -type C = T Int -type CL = [C] - -main = print 1 diff --git a/testsuite/tests/ext-core/all.T b/testsuite/tests/ext-core/all.T deleted file mode 100644 index a1fbb8b7e7..0000000000 --- a/testsuite/tests/ext-core/all.T +++ /dev/null @@ -1,3 +0,0 @@ -setTestOpts(only_compiler_types(['ghc'])) - -test('T7239', normal, compile, ['-fext-core']) diff --git a/testsuite/tests/ffi/should_compile/all.T b/testsuite/tests/ffi/should_compile/all.T index a192a7b0cc..84c7e8602e 100644 --- a/testsuite/tests/ffi/should_compile/all.T +++ b/testsuite/tests/ffi/should_compile/all.T @@ -9,30 +9,21 @@ test('cc001', normal, compile, ['']) # Non-static C call # cc004 test also uses stdcall, so it only works on i386. if config.platform.startswith('i386-'): - ways = expect_fail_for(['extcore','optextcore']) + ways = normal else: - ways = expect_fail + ways = expect_fail test('cc004', ways, compile, ['']) -# foreign label -test('cc005', expect_fail_for(['extcore','optextcore']), compile, ['']) - -# Missing: -# test('cc006', normal, compile, ['']) - +test('cc005', normal, compile, ['']) test('cc007', normal, compile, ['']) -# foreign label -test('cc008', expect_fail_for(['extcore','optextcore']), compile, ['']) -# foreign label -test('cc009', expect_fail_for(['extcore','optextcore']), compile, ['']) -# Non-static C call -test('cc010', expect_fail_for(['extcore','optextcore']), compile, ['']) +test('cc008', normal, compile, ['']) +test('cc009', normal, compile, ['']) +test('cc010', normal , compile, ['']) test('cc011', normal, compile, ['']) test('cc012', normal, compile, ['']) test('cc013', normal, compile, ['']) test('cc014', normal, compile, ['']) test('ffi-deriv1', normal, compile, ['']) - test('T1357', normal, compile, ['']) test('T3624', normal, compile, ['']) test('T3742', normal, compile, ['']) diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T index 567c3e67ce..7efc6eb3d8 100644 --- a/testsuite/tests/ffi/should_run/all.T +++ b/testsuite/tests/ffi/should_run/all.T @@ -4,10 +4,7 @@ # extra run flags # expected process return value, if not zero -# Doesn't work with External Core due to __labels -test('fed001', [only_compiler_types(['ghc']), - expect_fail_for(['extcore','optextcore'])], - compile_and_run, ['']) +test('fed001', normal, compile_and_run, ['']) # Omit GHCi for these two, as they use foreign export test('ffi001', omit_ways(['ghci']), compile_and_run, ['']) @@ -37,9 +34,7 @@ test('ffi005', [ omit_ways(prof_ways), exit_code(3) ], compile_and_run, ['']) -# ffi[006-009] don't work with External Core due to non-static-C foreign calls - -test('ffi006', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) +test('ffi006', normal, compile_and_run, ['']) # Skip ffi00{7,8} for GHCi. These tests both try to exit or raise an # error from a foreign export, which shuts down the runtime. When @@ -48,15 +43,8 @@ test('ffi006', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) # Sometimes we end up with the wrong exit code, or get an extra # 'interrupted' message from the GHCi thread shutting down. -test('ffi007', - [omit_ways(['ghci']), expect_fail_for(['extcore','optextcore'])], - compile_and_run, ['']) - -test('ffi008', - [expect_fail_for(['extcore','optextcore']), - exit_code(1), - omit_ways(['ghci'])], - compile_and_run, ['']) +test('ffi007', omit_ways(['ghci']), compile_and_run, ['']) +test('ffi008', [exit_code(1), omit_ways(['ghci'])], compile_and_run, ['']) # On i386, we need -msse2 to get reliable floating point results maybe_skip = normal @@ -68,13 +56,11 @@ if config.platform.startswith('i386-'): else: maybe_skip = only_ways(['ghci']) -test('ffi009', [when(fast(), skip), expect_fail_for(['extcore','optextcore']), +test('ffi009', [when(fast(), skip), reqlib('random'), maybe_skip] ,compile_and_run, [opts]) -# Doesn't work with External Core due to __labels -test('ffi010', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) - +test('ffi010', normal, compile_and_run, ['']) test('ffi011', normal, compile_and_run, ['']) # The stdcall calling convention works on Windows, and sometimes on @@ -88,9 +74,7 @@ else: skip_if_not_windows = skip test('ffi012', skip_if_not_windows, compile_and_run, ['']) - -# Doesn't work with External Core due to __labels -test('ffi013', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) +test('ffi013', normal, compile_and_run, ['']) # threaded2 sometimes gives ffi014: Main_dDu: interrupted test('ffi014', diff --git a/testsuite/tests/gadt/T9096.hs b/testsuite/tests/gadt/T9096.hs new file mode 100644 index 0000000000..d778798d36 --- /dev/null +++ b/testsuite/tests/gadt/T9096.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE GADTs #-} + +module T9096 where + +data Foo a where + MkFoo :: (->) a (Foo a) diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index 9192891d63..52a8812377 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -122,3 +122,4 @@ test('T7321', ['$MAKE -s --no-print-directory T7321']) test('T7974', normal, compile, ['']) test('T7558', normal, compile_fail, ['']) +test('T9096', normal, compile, ['']) diff --git a/testsuite/tests/ghc-api/T4891/T4891.hs b/testsuite/tests/ghc-api/T4891/T4891.hs index ca4aff91c9..854bf62998 100644 --- a/testsuite/tests/ghc-api/T4891/T4891.hs +++ b/testsuite/tests/ghc-api/T4891/T4891.hs @@ -20,7 +20,6 @@ import Unsafe.Coerce import Control.Monad import Data.Maybe import Bag -import PrelNames (iNTERACTIVE) import Outputable import GhcMonad import X diff --git a/testsuite/tests/ghc-api/T4891/T4891.stdout b/testsuite/tests/ghc-api/T4891/T4891.stdout index 47eb152467..8ad0b4eabe 100644 --- a/testsuite/tests/ghc-api/T4891/T4891.stdout +++ b/testsuite/tests/ghc-api/T4891/T4891.stdout @@ -1,20 +1,20 @@ ===== -Name: GHC.Types.False +Name: False OccString: 'False' -DataCon: GHC.Types.False +DataCon: False ===== Name: : OccString: ':' DataCon: : ===== -Name: X.:-> +Name: :-> OccString: ':->' -DataCon: X.:-> +DataCon: :-> ===== -Name: X.:->. +Name: :->. OccString: ':->.' -DataCon: X.:->. +DataCon: :->. ===== -Name: X.:->.+ +Name: :->.+ OccString: ':->.+' -DataCon: X.:->.+ +DataCon: :->.+ diff --git a/testsuite/tests/ghc-api/T6145.hs b/testsuite/tests/ghc-api/T6145.hs index 98e8bd0219..13b80eef87 100644 --- a/testsuite/tests/ghc-api/T6145.hs +++ b/testsuite/tests/ghc-api/T6145.hs @@ -27,15 +27,15 @@ main = do l <- loadModule d let ts=typecheckedSource l -- liftIO (putStr (showSDocDebug (ppr ts))) - let fs=filterBag (isDataCon . snd) ts + let fs=filterBag isDataCon ts return $ not $ isEmptyBag fs removeFile "Test.hs" print ok where isDataCon (L _ (AbsBinds { abs_binds = bs })) - = not (isEmptyBag (filterBag (isDataCon . snd) bs)) + = not (isEmptyBag (filterBag isDataCon bs)) isDataCon (L l (f@FunBind {})) - | (MG (m:_) _ _) <- fun_matches f, + | (MG (m:_) _ _ _) <- fun_matches f, (L _ (c@ConPatOut{}):_)<-hsLMatchPats m, (L l _)<-pat_con c = isGoodSrcSpan l -- Check that the source location is a good one diff --git a/testsuite/tests/ghc-api/T8639_api.stdout b/testsuite/tests/ghc-api/T8639_api.stdout index 659a1ddccd..7218302dc1 100644 --- a/testsuite/tests/ghc-api/T8639_api.stdout +++ b/testsuite/tests/ghc-api/T8639_api.stdout @@ -1,2 +1,2 @@ 3 -GHC.Types.Bool +Bool diff --git a/testsuite/tests/ghc-e/should_run/Makefile b/testsuite/tests/ghc-e/should_run/Makefile index 1971004d4c..5ed1ec2e6c 100644 --- a/testsuite/tests/ghc-e/should_run/Makefile +++ b/testsuite/tests/ghc-e/should_run/Makefile @@ -30,3 +30,5 @@ T3890: T7299: '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e "Control.Concurrent.threadDelay (1000 * 1000)" +T9086: + '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -e ":main" T9086.hs diff --git a/testsuite/tests/ghc-e/should_run/T9086.hs b/testsuite/tests/ghc-e/should_run/T9086.hs new file mode 100644 index 0000000000..a2b4ace33a --- /dev/null +++ b/testsuite/tests/ghc-e/should_run/T9086.hs @@ -0,0 +1 @@ +main = return "this should not be printed" diff --git a/testsuite/tests/ghc-e/should_run/all.T b/testsuite/tests/ghc-e/should_run/all.T index 4ab7567358..9f6491819d 100644 --- a/testsuite/tests/ghc-e/should_run/all.T +++ b/testsuite/tests/ghc-e/should_run/all.T @@ -14,3 +14,4 @@ test('T2228', test('T2636', req_interp, run_command, ['$MAKE --no-print-directory -s T2636']) test('T3890', req_interp, run_command, ['$MAKE --no-print-directory -s T3890']) test('T7299', req_interp, run_command, ['$MAKE --no-print-directory -s T7299']) +test('T9086', req_interp, run_command, ['$MAKE --no-print-directory -s T9086']) diff --git a/testsuite/tests/ghci/prog013/Bad.hs b/testsuite/tests/ghci/prog013/Bad.hs new file mode 100644 index 0000000000..2c26204e77 --- /dev/null +++ b/testsuite/tests/ghci/prog013/Bad.hs @@ -0,0 +1,3 @@ +a = 1 +b = 2 +bad = ' diff --git a/testsuite/tests/ghci/prog013/Good.hs b/testsuite/tests/ghci/prog013/Good.hs new file mode 100644 index 0000000000..a9aeef048b --- /dev/null +++ b/testsuite/tests/ghci/prog013/Good.hs @@ -0,0 +1,3 @@ +a = 1 +b = 2 +c = 3 diff --git a/testsuite/tests/ghci/prog013/prog013.T b/testsuite/tests/ghci/prog013/prog013.T new file mode 100644 index 0000000000..020bdf81c8 --- /dev/null +++ b/testsuite/tests/ghci/prog013/prog013.T @@ -0,0 +1,2 @@ +test('prog013', normal, ghci_script, ['prog013.script']) + diff --git a/testsuite/tests/ghci/prog013/prog013.script b/testsuite/tests/ghci/prog013/prog013.script new file mode 100644 index 0000000000..b9df968933 --- /dev/null +++ b/testsuite/tests/ghci/prog013/prog013.script @@ -0,0 +1,8 @@ +:set editor /bin/echo +:l Good.hs +:e +:l Bad.hs +:e +:e ./Bad.hs +:l Good.hs +:e diff --git a/testsuite/tests/ghci/prog013/prog013.stderr b/testsuite/tests/ghci/prog013/prog013.stderr new file mode 100644 index 0000000000..d8970d4d2e --- /dev/null +++ b/testsuite/tests/ghci/prog013/prog013.stderr @@ -0,0 +1,9 @@ + +Bad.hs:3:8: + lexical error in string/character literal at character '\n' + +Bad.hs:3:8: + lexical error in string/character literal at character '\n' + +Bad.hs:3:8: + lexical error in string/character literal at character '\n' diff --git a/testsuite/tests/ghci/prog013/prog013.stdout b/testsuite/tests/ghci/prog013/prog013.stdout new file mode 100644 index 0000000000..0d621dad77 --- /dev/null +++ b/testsuite/tests/ghci/prog013/prog013.stdout @@ -0,0 +1,4 @@ +Good.hs +Bad.hs +3 +./Bad.hs +3 +Good.hs diff --git a/testsuite/tests/ghci/scripts/Defer02.stderr b/testsuite/tests/ghci/scripts/Defer02.stderr index ed36a3eb3c..7635c8f804 100644 --- a/testsuite/tests/ghci/scripts/Defer02.stderr +++ b/testsuite/tests/ghci/scripts/Defer02.stderr @@ -84,13 +84,13 @@ the type signature for k :: Int ~ Bool => Int -> Bool In the ambiguity check for: Int ~ Bool => Int -> Bool To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature for ‘k’: k :: Int ~ Bool => Int -> Bool + In the type signature for ‘k’: k :: (Int ~ Bool) => Int -> Bool ../../typecheck/should_run/Defer01.hs:45:6: Warning: Couldn't match expected type ‘Bool’ with actual type ‘Int’ In the ambiguity check for: Int ~ Bool => Int -> Bool To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature for ‘k’: k :: Int ~ Bool => Int -> Bool + In the type signature for ‘k’: k :: (Int ~ Bool) => Int -> Bool ../../typecheck/should_run/Defer01.hs:45:6: Warning: Couldn't match type ‘Int’ with ‘Bool’ diff --git a/testsuite/tests/ghci/scripts/T2766.stdout b/testsuite/tests/ghci/scripts/T2766.stdout index f8ee42ff6a..5bcbd9e75e 100644 --- a/testsuite/tests/ghci/scripts/T2766.stdout +++ b/testsuite/tests/ghci/scripts/T2766.stdout @@ -1,3 +1,3 @@ first :: Arrow to => b `to` c -> (b, d) `to` (c, d) :: Arrow to => to b c -> to (b, d) (c, d) -first :: b~>c -> (b, d)~>(c, d) :: (b ~> c) -> (b, d) ~> (c, d) +first :: b~>c -> (b, d)~>(c, d) :: b ~> c -> (b, d) ~> (c, d) diff --git a/testsuite/tests/ghci/scripts/T4087.stdout b/testsuite/tests/ghci/scripts/T4087.stdout index 3f600bd78d..2ca08aa449 100644 --- a/testsuite/tests/ghci/scripts/T4087.stdout +++ b/testsuite/tests/ghci/scripts/T4087.stdout @@ -1,4 +1,4 @@ -type role Equal nominal nominal -data Equal a b where - Equal :: Equal a a - -- Defined at T4087.hs:5:1 +type role Equal nominal nominal
+data Equal a b where
+ Equal :: Equal b b
+ -- Defined at T4087.hs:5:1
diff --git a/testsuite/tests/ghci/scripts/T4175.stdout b/testsuite/tests/ghci/scripts/T4175.stdout index 1f44bd1051..29bca027ce 100644 --- a/testsuite/tests/ghci/scripts/T4175.stdout +++ b/testsuite/tests/ghci/scripts/T4175.stdout @@ -1,18 +1,18 @@ type family A a b :: * -- Defined at T4175.hs:7:1 -type instance A (B a) b -- Defined at T4175.hs:10:1 -type instance A (Maybe a) a -- Defined at T4175.hs:9:1 -type instance A Int Int -- Defined at T4175.hs:8:1 +type instance A (B a) b = () -- Defined at T4175.hs:10:1 +type instance A (Maybe a) a = a -- Defined at T4175.hs:9:1 +type instance A Int Int = () -- Defined at T4175.hs:8:1 type role B nominal data family B a -- Defined at T4175.hs:12:1 instance G B -- Defined at T4175.hs:34:10 -data instance B () -- Defined at T4175.hs:13:15 -type instance A (B a) b -- Defined at T4175.hs:10:1 +data instance B () = MkB -- Defined at T4175.hs:13:15 +type instance A (B a) b = () -- Defined at T4175.hs:10:1 class C a where type family D a b :: * -- Defined at T4175.hs:16:5 -type D () () -- Defined at T4175.hs:22:5 -type D Int () -- Defined at T4175.hs:19:5 +type instance D () () = Bool -- Defined at T4175.hs:22:5 +type instance D Int () = String -- Defined at T4175.hs:19:5 type family E a :: * where E () = Bool E Int = String @@ -25,9 +25,9 @@ instance Eq () -- Defined in ‘GHC.Classes’ instance Ord () -- Defined in ‘GHC.Classes’ instance Read () -- Defined in ‘GHC.Read’ instance Show () -- Defined in ‘GHC.Show’ -type D () () -- Defined at T4175.hs:22:5 -type D Int () -- Defined at T4175.hs:19:5 -data instance B () -- Defined at T4175.hs:13:15 +type instance D () () = Bool -- Defined at T4175.hs:22:5 +type instance D Int () = String -- Defined at T4175.hs:19:5 +data instance B () = MkB -- Defined at T4175.hs:13:15 data Maybe a = Nothing | Just a -- Defined in ‘Data.Maybe’ instance Eq a => Eq (Maybe a) -- Defined in ‘Data.Maybe’ instance Monad Maybe -- Defined in ‘Data.Maybe’ @@ -35,7 +35,7 @@ instance Functor Maybe -- Defined in ‘Data.Maybe’ instance Ord a => Ord (Maybe a) -- Defined in ‘Data.Maybe’ instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ -type instance A (Maybe a) a -- Defined at T4175.hs:9:1 +type instance A (Maybe a) a = a -- Defined at T4175.hs:9:1 data Int = I# Int# -- Defined in ‘GHC.Types’ instance C Int -- Defined at T4175.hs:18:10 instance Bounded Int -- Defined in ‘GHC.Enum’ @@ -47,7 +47,7 @@ instance Ord Int -- Defined in ‘GHC.Classes’ instance Read Int -- Defined in ‘GHC.Read’ instance Real Int -- Defined in ‘GHC.Real’ instance Show Int -- Defined in ‘GHC.Show’ -type D Int () -- Defined at T4175.hs:19:5 -type instance A Int Int -- Defined at T4175.hs:8:1 +type instance D Int () = String -- Defined at T4175.hs:19:5 +type instance A Int Int = () -- Defined at T4175.hs:8:1 class Z a -- Defined at T4175.hs:28:1 instance F (Z a) -- Defined at T4175.hs:31:10 diff --git a/testsuite/tests/ghci/scripts/T5417.stdout b/testsuite/tests/ghci/scripts/T5417.stdout index 73d1de932d..1085a1750f 100644 --- a/testsuite/tests/ghci/scripts/T5417.stdout +++ b/testsuite/tests/ghci/scripts/T5417.stdout @@ -6,4 +6,4 @@ class C.C1 a where type role C.F nominal data family C.F a -- Defined at T5417a.hs:5:5 -data C.F (B1 a) -- Defined at T5417.hs:8:10 +data instance C.F (B1 a) = B2 a -- Defined at T5417.hs:8:10 diff --git a/testsuite/tests/ghci/scripts/T7730.script b/testsuite/tests/ghci/scripts/T7730.script new file mode 100644 index 0000000000..f1e01ee1ef --- /dev/null +++ b/testsuite/tests/ghci/scripts/T7730.script @@ -0,0 +1,7 @@ +:set -XPolyKinds +data A x y +:i A +:kind A +:set -XExistentialQuantification +data T a = forall a . MkT a +:info T diff --git a/testsuite/tests/ghci/scripts/T7730.stdout b/testsuite/tests/ghci/scripts/T7730.stdout new file mode 100644 index 0000000000..e3a08c19f4 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T7730.stdout @@ -0,0 +1,8 @@ +type role A phantom phantom +data A (x :: k) (y :: k1) + -- Defined at <interactive>:3:1 +A :: k -> k1 -> * +type role T phantom +data T (a :: k) where + MkT :: forall (k :: BOX) (a :: k) a1. a1 -> T a + -- Defined at <interactive>:7:1 diff --git a/testsuite/tests/ghci/scripts/T7873.stdout b/testsuite/tests/ghci/scripts/T7873.stdout index 0167fb2eba..215757bb69 100644 --- a/testsuite/tests/ghci/scripts/T7873.stdout +++ b/testsuite/tests/ghci/scripts/T7873.stdout @@ -1,5 +1,6 @@ data D1 where - MkD1 :: (forall (p :: k -> *) (a :: k). p a -> Int) -> D1 + MkD1 :: (forall (k1 :: BOX) (p :: k1 -> *) (a :: k1). p a -> Int) + -> D1 -- Defined at <interactive>:3:1 data D2 where MkD2 :: (forall (p :: k -> *) (a :: k). p a -> Int) -> D2 diff --git a/testsuite/tests/ghci/scripts/T7939.stdout b/testsuite/tests/ghci/scripts/T7939.stdout index 9a88b5c294..feb890c578 100644 --- a/testsuite/tests/ghci/scripts/T7939.stdout +++ b/testsuite/tests/ghci/scripts/T7939.stdout @@ -3,21 +3,23 @@ class Foo (a :: k) where -- Defined at T7939.hs:6:4 Bar :: k -> * -> * type family F a :: * -- Defined at T7939.hs:8:1 -type instance F Int -- Defined at T7939.hs:9:1 +type instance F Int = Bool -- Defined at T7939.hs:9:1 F :: * -> * -type family G a :: * where G Int = Bool +type family G a :: * where + G Int = Bool -- Defined at T7939.hs:11:1 G :: * -> * -type family H (a :: Bool) :: Bool where H 'False = 'True +type family H (a :: Bool) :: Bool where + H 'False = 'True -- Defined at T7939.hs:14:1 H :: Bool -> Bool type family J (a :: [k]) :: Bool where - J '[] = 'False - J (h : t) = 'True + J k '[] = 'False + forall (k :: BOX) (h :: k) (t :: [k]). J k (h : t) = 'True -- Defined at T7939.hs:17:1 J :: [k] -> Bool type family K (a :: [k]) :: Maybe k where - K '[] = 'Nothing - K (h : t) = 'Just h + K k '[] = 'Nothing + forall (k :: BOX) (h :: k) (t :: [k]). K k (h : t) = 'Just h -- Defined at T7939.hs:21:1 K :: [k] -> Maybe k diff --git a/testsuite/tests/ghci/scripts/T8674.stdout b/testsuite/tests/ghci/scripts/T8674.stdout index a4f5bbff6e..6c13176e66 100644 --- a/testsuite/tests/ghci/scripts/T8674.stdout +++ b/testsuite/tests/ghci/scripts/T8674.stdout @@ -1,5 +1,5 @@ type role Sing nominal data family Sing (a :: k) -- Defined at T8674.hs:4:1 -data instance Sing Bool -- Defined at T8674.hs:6:15 -data instance Sing a -- Defined at T8674.hs:5:15 +data instance Sing Bool = SBool -- Defined at T8674.hs:6:15 +data instance Sing a = SNil -- Defined at T8674.hs:5:15 diff --git a/testsuite/tests/ghci/scripts/T8959.script b/testsuite/tests/ghci/scripts/T8959.script new file mode 100644 index 0000000000..124b2ab2f5 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T8959.script @@ -0,0 +1,20 @@ +:set -XPatternGuards -XArrows -XRankNTypes + +:t lookup +:t undefined :: (forall a. a -> a) -> a +:t () >- () -< () >>- () -<< () +let fun foo | True <- () = () + +:set -XUnicodeSyntax + +:t lookup +:t undefined :: (forall a. a -> a) -> a +:t () >- () -< () >>- () -<< () +let fun foo | True <- () = () + +:set -XNoUnicodeSyntax + +:t lookup +:t undefined :: (forall a. a -> a) -> a +:t () >- () -< () >>- () -<< () +let fun foo | True <- () = () diff --git a/testsuite/tests/ghci/scripts/T8959.stderr b/testsuite/tests/ghci/scripts/T8959.stderr new file mode 100644 index 0000000000..b3995c3365 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T8959.stderr @@ -0,0 +1,36 @@ + +<interactive>:1:1: + Arrow command found where an expression was expected: + () >- () -< () >>- () -<< () + +<interactive>:7:15: + Couldn't match expected type ‘()’ with actual type ‘Bool’ + In the pattern: True + In a stmt of a pattern guard for + an equation for ‘fun’: + True <- () + In an equation for ‘fun’: fun foo | True <- () = () + +<interactive>:1:1: + Arrow command found where an expression was expected: + () ↣ () ↢ () ⤜ () ⤛ () + +<interactive>:14:15: + Couldn't match expected type ‘()’ with actual type ‘Bool’ + In the pattern: True + In a stmt of a pattern guard for + an equation for ‘fun’: + True ← () + In an equation for ‘fun’: fun foo | True ← () = () + +<interactive>:1:1: + Arrow command found where an expression was expected: + () >- () -< () >>- () -<< () + +<interactive>:21:15: + Couldn't match expected type ‘()’ with actual type ‘Bool’ + In the pattern: True + In a stmt of a pattern guard for + an equation for ‘fun’: + True <- () + In an equation for ‘fun’: fun foo | True <- () = () diff --git a/testsuite/tests/ghci/scripts/T8959.stdout b/testsuite/tests/ghci/scripts/T8959.stdout new file mode 100644 index 0000000000..4631732c55 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T8959.stdout @@ -0,0 +1,6 @@ +lookup :: Eq a => a -> [(a, b)] -> Maybe b +undefined :: (forall a. a -> a) -> a :: (forall a1. a1 -> a1) -> a +lookup ∷ Eq a ⇒ a → [(a, b)] → Maybe b +undefined :: (forall a. a -> a) -> a ∷ (∀ a1. a1 → a1) → a +lookup :: Eq a => a -> [(a, b)] -> Maybe b +undefined :: (forall a. a -> a) -> a :: (forall a1. a1 -> a1) -> a diff --git a/testsuite/tests/ghci/scripts/T8959b.hs b/testsuite/tests/ghci/scripts/T8959b.hs new file mode 100644 index 0000000000..064b2670a8 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T8959b.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE UnicodeSyntax, Arrows, RankNTypes #-} +module T8959b where + +foo :: Int -> Int +foo = () + +bar :: () +bar = proc x -> do return -< x + +baz = () :: (forall a. a -> a) -> a + diff --git a/testsuite/tests/ghci/scripts/T8959b.script b/testsuite/tests/ghci/scripts/T8959b.script new file mode 100644 index 0000000000..f3c23c97a3 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T8959b.script @@ -0,0 +1 @@ +:l T8959b.hs diff --git a/testsuite/tests/ghci/scripts/T8959b.stderr b/testsuite/tests/ghci/scripts/T8959b.stderr new file mode 100644 index 0000000000..4f1ac7a97b --- /dev/null +++ b/testsuite/tests/ghci/scripts/T8959b.stderr @@ -0,0 +1,16 @@ + +T8959b.hs:5:7: + Couldn't match expected type ‘Int → Int’ with actual type ‘()’ + In the expression: () + In an equation for ‘foo’: foo = () + +T8959b.hs:8:7: + Couldn't match expected type ‘()’ with actual type ‘t0 → m0 t0’ + In the expression: proc x -> do { return ↢ x } + In an equation for ‘bar’: bar = proc x -> do { return ↢ x } + +T8959b.hs:10:7: + Couldn't match expected type ‘(∀ a2. a2 → a2) → a1’ + with actual type ‘()’ + In the expression: () ∷ (∀ a. a -> a) -> a + In an equation for ‘baz’: baz = () ∷ (∀ a. a -> a) -> a diff --git a/testsuite/tests/ghci/scripts/T9086b.script b/testsuite/tests/ghci/scripts/T9086b.script new file mode 100644 index 0000000000..d60156ad02 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9086b.script @@ -0,0 +1,2 @@ +let main = do { putStrLn "hello"; return "discarded" } +:main diff --git a/testsuite/tests/ghci/scripts/T9086b.stdout b/testsuite/tests/ghci/scripts/T9086b.stdout new file mode 100644 index 0000000000..ce01362503 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9086b.stdout @@ -0,0 +1 @@ +hello diff --git a/testsuite/tests/ghci/scripts/T9181.script b/testsuite/tests/ghci/scripts/T9181.script new file mode 100644 index 0000000000..b2239b9556 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9181.script @@ -0,0 +1 @@ +:browse GHC.TypeLits diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout new file mode 100644 index 0000000000..e1ac00cc83 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9181.stdout @@ -0,0 +1,54 @@ +type family (GHC.TypeLits.*) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + GHC.TypeLits.Nat +type family (GHC.TypeLits.+) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + GHC.TypeLits.Nat +type family (GHC.TypeLits.-) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + GHC.TypeLits.Nat +type (GHC.TypeLits.<=) (x :: GHC.TypeLits.Nat) + (y :: GHC.TypeLits.Nat) = + (x GHC.TypeLits.<=? y) ~ 'True +type family (GHC.TypeLits.<=?) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + Bool +type family GHC.TypeLits.CmpNat (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + Ordering +type family GHC.TypeLits.CmpSymbol (a :: GHC.TypeLits.Symbol) + (b :: GHC.TypeLits.Symbol) :: + Ordering +class GHC.TypeLits.KnownNat (n :: GHC.TypeLits.Nat) where + GHC.TypeLits.natSing :: GHC.TypeLits.SNat n +class GHC.TypeLits.KnownSymbol (n :: GHC.TypeLits.Symbol) where + GHC.TypeLits.symbolSing :: GHC.TypeLits.SSymbol n +data GHC.TypeLits.Nat +data GHC.TypeLits.SomeNat where + GHC.TypeLits.SomeNat :: GHC.TypeLits.KnownNat n => + (Data.Proxy.Proxy n) -> GHC.TypeLits.SomeNat +data GHC.TypeLits.SomeSymbol where + GHC.TypeLits.SomeSymbol :: GHC.TypeLits.KnownSymbol n => + (Data.Proxy.Proxy n) -> GHC.TypeLits.SomeSymbol +data GHC.TypeLits.Symbol +type family (GHC.TypeLits.^) (a :: GHC.TypeLits.Nat) + (b :: GHC.TypeLits.Nat) :: + GHC.TypeLits.Nat +GHC.TypeLits.natVal :: + GHC.TypeLits.KnownNat n => proxy n -> Integer +GHC.TypeLits.natVal' :: + GHC.TypeLits.KnownNat n => GHC.Prim.Proxy# n -> Integer +GHC.TypeLits.sameNat :: + (GHC.TypeLits.KnownNat a, GHC.TypeLits.KnownNat b) => + Data.Proxy.Proxy a + -> Data.Proxy.Proxy b -> Maybe (a Data.Type.Equality.:~: b) +GHC.TypeLits.sameSymbol :: + (GHC.TypeLits.KnownSymbol a, GHC.TypeLits.KnownSymbol b) => + Data.Proxy.Proxy a + -> Data.Proxy.Proxy b -> Maybe (a Data.Type.Equality.:~: b) +GHC.TypeLits.someNatVal :: Integer -> Maybe GHC.TypeLits.SomeNat +GHC.TypeLits.someSymbolVal :: String -> GHC.TypeLits.SomeSymbol +GHC.TypeLits.symbolVal :: + GHC.TypeLits.KnownSymbol n => proxy n -> String +GHC.TypeLits.symbolVal' :: + GHC.TypeLits.KnownSymbol n => GHC.Prim.Proxy# n -> String diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index aacdd262b1..d1e67ebeca 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -113,7 +113,7 @@ test('T5564', normal, ghci_script, ['T5564.script']) test('Defer02', normal, ghci_script, ['Defer02.script']) test('T5820', normal, ghci_script, ['T5820.script']) test('T5836', normal, ghci_script, ['T5836.script']) -test('T5979', normalise_slashes, ghci_script, ['T5979.script']) +test('T5979', [reqlib('transformers'), normalise_slashes], ghci_script, ['T5979.script']) test('T5975a', [pre_cmd('touch föøbàr1.hs'), clean_cmd('rm föøbàr1.hs')], @@ -147,6 +147,7 @@ test('T7627', normal, ghci_script, ['T7627.script']) test('T7627b', normal, ghci_script, ['T7627b.script']) test('T7586', normal, ghci_script, ['T7586.script']) test('T4175', normal, ghci_script, ['T4175.script']) +test('T7730', combined_output, ghci_script, ['T7730.script']) test('T7872', normal, ghci_script, ['T7872.script']) test('T7873', normal, ghci_script, ['T7873.script']) test('T7939', normal, ghci_script, ['T7939.script']) @@ -171,3 +172,7 @@ test('ghci059', normal, ghci_script, ['ghci059.script']) test('T8831', normal, ghci_script, ['T8831.script']) test('T8917', normal, ghci_script, ['T8917.script']) test('T8931', normal, ghci_script, ['T8931.script']) +test('T8959', normal, ghci_script, ['T8959.script']) +test('T8959b', expect_broken(8959), ghci_script, ['T8959b.script']) +test('T9181', normal, ghci_script, ['T9181.script']) +test('T9086b', normal, ghci_script, ['T9086b.script']) diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout index 9308dd3f39..9cc88b8a07 100644 --- a/testsuite/tests/ghci/scripts/ghci025.stdout +++ b/testsuite/tests/ghci/scripts/ghci025.stdout @@ -11,7 +11,7 @@ class C a b where c4 :: a1 -> b c1 :: (C a b, N b) => a -> b c2 :: (C a b, N b, S b) => a -> b -c3 :: C a b => forall a1. a1 -> b +c3 :: C a b => forall a. a -> b c4 :: C a b => forall a1. a1 -> b -- imported via Control.Monad class Monad m => MonadPlus (m :: * -> *) where @@ -69,7 +69,7 @@ class C a b where c4 :: a1 -> b c1 :: (C a b, N b) => a -> b c2 :: (C a b, N b, S b) => a -> b -c3 :: C a b => forall a1. a1 -> b +c3 :: C a b => forall a. a -> b c4 :: C a b => forall a1. a1 -> b :browse! T -- with -fprint-explicit-foralls -- defined locally @@ -83,7 +83,7 @@ class C a b where c4 :: forall a1. a1 -> b c1 :: forall a b. (C a b, N b) => a -> b c2 :: forall a b. (C a b, N b, S b) => a -> b -c3 :: forall a b. C a b => forall a1. a1 -> b +c3 :: forall a b. C a b => forall a. a -> b c4 :: forall a b. C a b => forall a1. a1 -> b -- test :browse! <target> relative to different contexts :browse! Ghci025C -- from *Ghci025C> diff --git a/testsuite/tests/ghci/scripts/ghci059.stdout b/testsuite/tests/ghci/scripts/ghci059.stdout index 6b2c8f886e..ffc893f363 100644 --- a/testsuite/tests/ghci/scripts/ghci059.stdout +++ b/testsuite/tests/ghci/scripts/ghci059.stdout @@ -1,4 +1,6 @@ type role Coercible representational representational class Coercible (a :: k) (b :: k) -- Defined in ‘GHC.Types’ -coerce :: Coercible a b => a -> b -- Defined in ‘GHC.Prim’ +coerce :: + forall (k :: BOX) (a :: k) (b :: k). Coercible a b => a -> b + -- Defined in ‘GHC.Prim’ diff --git a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr index fa92d3dd92..7ce82d0067 100644 --- a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr +++ b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr @@ -85,7 +85,7 @@ newtype N5 a b newtype N6 a b = docs on the constructor only N6 {n6 :: a b} <document comment> newtype N7 a b = The 'N7' constructor N7 {n7 :: a b} -class D a => C a where +class (D a) => C a where a :: IO a b :: [a] c :: a diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr index 6d803bb440..2bb1a178e0 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module ShouldCompile where -test :: Eq a => [a] doc1 -> [a] doc2 -> [a] doc3 +test :: (Eq a) => [a] doc1 -> [a] doc2 -> [a] doc3 test xs ys = xs diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr index 3e3cb12d10..4a57879c5c 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module ShouldCompile where -test :: Eq a => [a] doc1 -> forall b. [b] doc2 -> [a] doc3 +test :: (Eq a) => [a] doc1 -> forall b. [b] doc2 -> [a] doc3 test xs ys = xs diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr index 10e88d2bfc..d1cb709c55 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr @@ -3,8 +3,8 @@ module ShouldCompile where test :: [a] doc1 - -> forall b. Ord b => - [b] doc2 -> forall c. Num c => [c] doc3 -> [a] + -> forall b. (Ord b) => + [b] doc2 -> forall c. (Num c) => [c] doc3 -> [a] test xs ys zs = xs diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr index 20190471ae..a6c744a177 100644 --- a/testsuite/tests/indexed-types/should_compile/T3017.stderr +++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr @@ -3,24 +3,17 @@ TYPE SIGNATURES test2 :: forall c t t1. (Coll c, Num t1, Num t, Elem c ~ (t, t1)) => c -> c TYPE CONSTRUCTORS - Coll :: * -> Constraint - class Coll c - Roles: [nominal] - RecFlag NonRecursive - type family Elem c :: * (open) - empty :: c insert :: Elem c -> c -> c - ListColl :: * -> * - data ListColl a - No C type associated - Roles: [representational] - RecFlag NonRecursive, Promotable - = L :: [a] -> ListColl a Stricts: _ - FamilyInstance: none + class Coll c where + type family Elem c :: * open + empty :: c + insert :: Elem c -> c -> c + data ListColl a = L [a] + Promotable COERCION AXIOMS axiom Foo.TFCo:R:ElemListColl :: Elem (ListColl a) = a INSTANCES instance Coll (ListColl a) -- Defined at T3017.hs:12:11 FAMILY INSTANCES - type Elem (ListColl a) -- Defined at T3017.hs:13:4 + type Elem (ListColl a) Dependent modules: [] Dependent packages: [base, ghc-prim, integer-gmp] diff --git a/testsuite/tests/indexed-types/should_compile/T9085.hs b/testsuite/tests/indexed-types/should_compile/T9085.hs new file mode 100644 index 0000000000..13c9321262 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T9085.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} + +module T9085 where + +type family F a where + F a = Int + F Bool = Bool diff --git a/testsuite/tests/indexed-types/should_compile/T9085.stderr b/testsuite/tests/indexed-types/should_compile/T9085.stderr new file mode 100644 index 0000000000..ee968e0d79 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T9085.stderr @@ -0,0 +1,4 @@ + +T9085.hs:7:3: Warning: + Overlapped type family instance equation: + F Bool = Bool diff --git a/testsuite/tests/indexed-types/should_compile/T9316.hs b/testsuite/tests/indexed-types/should_compile/T9316.hs new file mode 100644 index 0000000000..b5dfca6a94 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T9316.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleInstances #-} + +module SingletonsBug where + +import Control.Applicative +import Data.Traversable (for) +import GHC.Exts( Constraint ) + +----------------------------------- +-- From 'constraints' library +-- import Data.Constraint (Dict(..)) +data Dict :: Constraint -> * where + Dict :: a => Dict a + +----------------------------------- +-- From 'singletons' library +-- import Data.Singletons hiding( withSomeSing ) + +class SingI (a :: k) where + -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@ + -- extension to use this method the way you want. + sing :: Sing a + +data family Sing (a :: k) + +data KProxy (a :: *) = KProxy + +data SomeSing (kproxy :: KProxy k) where + SomeSing :: Sing (a :: k) -> SomeSing ('KProxy :: KProxy k) + +-- SingKind :: forall k. KProxy k -> Constraint +class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where + -- | Get a base type from a proxy for the promoted kind. For example, + -- @DemoteRep ('KProxy :: KProxy Bool)@ will be the type @Bool@. + type DemoteRep kparam :: * + + -- | Convert a singleton to its unrefined version. + fromSing :: Sing (a :: k) -> DemoteRep kparam + + -- | Convert an unrefined type to an existentially-quantified singleton type. + toSing :: DemoteRep kparam -> SomeSing kparam + +withSomeSing :: SingKind ('KProxy :: KProxy k) + => DemoteRep ('KProxy :: KProxy k) + -> (forall (a :: k). Sing a -> r) + -> r +withSomeSing = error "urk" + +----------------------------------- + +data SubscriptionChannel = BookingsChannel +type BookingsChannelSym0 = BookingsChannel +data instance Sing (z_a5I7 :: SubscriptionChannel) where + SBookingsChannel :: Sing BookingsChannel + +instance SingKind ('KProxy :: KProxy SubscriptionChannel) where + type DemoteRep ('KProxy :: KProxy SubscriptionChannel) = SubscriptionChannel + fromSing SBookingsChannel = BookingsChannel + toSing BookingsChannel = SomeSing SBookingsChannel + +instance SingI BookingsChannel where + sing = SBookingsChannel + +type family T (c :: SubscriptionChannel) :: * +type instance T 'BookingsChannel = Bool + +witnessC :: Sing channel -> Dict (Show (T channel), SingI channel) +witnessC SBookingsChannel = Dict + +forAllSubscriptionChannels + :: forall m r. (Applicative m) + => (forall channel. (SingI channel, Show (T channel)) => Sing channel -> m r) + -> m r +forAllSubscriptionChannels f = + withSomeSing BookingsChannel $ \(sChannel) -> + case witnessC sChannel of + Dict -> f sChannel + diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index 5f304463c6..016444a138 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -243,3 +243,5 @@ test('T8889', normal, compile, ['']) test('T8913', normal, compile, ['']) test('T8978', normal, compile, ['']) test('T8979', normal, compile, ['']) +test('T9085', normal, compile, ['']) +test('T9316', normal, compile, ['']) diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr index 107f5ffec3..04435ba962 100644 --- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr +++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr @@ -5,7 +5,8 @@ ClosedFam3.hs-boot:5:1: Main module: type family Foo a :: * where Foo Int = Bool Foo Double = Char - Boot file: type family Foo a :: * where Foo Int = Bool + Boot file: type family Foo a :: * where + Foo Int = Bool ClosedFam3.hs-boot:8:1: Type constructor ‘Bar’ has conflicting definitions in the module @@ -20,5 +21,7 @@ ClosedFam3.hs-boot:8:1: ClosedFam3.hs-boot:12:1: Type constructor ‘Baz’ has conflicting definitions in the module and its hs-boot file - Main module: type family Baz a :: * where Baz Int = Bool - Boot file: type family Baz (a :: k) :: * where Baz Int = Bool + Main module: type family Baz a :: * where + Baz Int = Bool + Boot file: type family Baz (a :: k) :: * where + Baz * Int = Bool diff --git a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr index 1ff540979b..d3193d5f30 100644 --- a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr +++ b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr @@ -11,4 +11,4 @@ NoMatchErr.hs:19:7: In the ambiguity check for: forall d a. Fun d => Memo d a -> Memo d a To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature for ‘f’: f :: Fun d => Memo d a -> Memo d a + In the type signature for ‘f’: f :: (Fun d) => Memo d a -> Memo d a diff --git a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr index d64036c4bc..d1622335d8 100644 --- a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr +++ b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr @@ -1,5 +1,4 @@ Overlap4.hs:7:3: Number of parameters must match family declaration; expected 2 - In the equations for closed type family ‘F’ In the type family declaration for ‘F’ diff --git a/testsuite/tests/indexed-types/should_fail/Overlap5.stderr b/testsuite/tests/indexed-types/should_fail/Overlap5.stderr index 3adf2f3c3e..a889145036 100644 --- a/testsuite/tests/indexed-types/should_fail/Overlap5.stderr +++ b/testsuite/tests/indexed-types/should_fail/Overlap5.stderr @@ -1,5 +1,6 @@ Overlap5.hs:8:3: - Mismatched type names in closed type family declaration. - First name was F; this one is G - In the family declaration for ‘F’ + Mismatched type name in type family instance. + Expected: F + Actual: G + In the type family declaration for ‘F’ diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr index 8318927522..f57af3908b 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr @@ -1,4 +1,4 @@ SimpleFail1a.hs:4:1: - Couldn't match kind ‘* -> *’ against ‘*’ + Number of parameters must match family declaration; expected 2 In the data instance declaration for ‘T1’ diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr index e1059a430b..3ecd31a003 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr @@ -1,4 +1,4 @@ SimpleFail1b.hs:4:1: - Number of parameters must match family declaration; expected no more than 2 + Number of parameters must match family declaration; expected 2 In the data instance declaration for ‘T1’ diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr index 91a3eb282a..8c4c743a56 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr @@ -1,6 +1,6 @@ -SimpleFail4.hs:8:8: - Type indexes must match class instance head - Found ‘Int’ but expected ‘a’ - In the type synonym instance default declaration for ‘S2’ - In the class declaration for ‘C2’ +SimpleFail4.hs:8:11: + Unexpected type ‘Int’ + In the default declaration for ‘S2’ + A default declaration should have form + default S2 a = ... diff --git a/testsuite/tests/indexed-types/should_fail/T1897b.stderr b/testsuite/tests/indexed-types/should_fail/T1897b.stderr index 06d81a146b..6372bd9fba 100644 --- a/testsuite/tests/indexed-types/should_fail/T1897b.stderr +++ b/testsuite/tests/indexed-types/should_fail/T1897b.stderr @@ -1,14 +1,14 @@ - -T1897b.hs:16:1: - Could not deduce (Depend a0 ~ Depend a) - from the context (Bug a) - bound by the inferred type for ‘isValid’: - Bug a => [Depend a] -> Bool - at T1897b.hs:16:1-41 - NB: ‘Depend’ is a type function, and may not be injective - The type variable ‘a0’ is ambiguous - Expected type: [Depend a] -> Bool - Actual type: [Depend a0] -> Bool - When checking that ‘isValid’ - has the inferred type ‘forall a. Bug a => [Depend a] -> Bool’ - Probable cause: the inferred type is ambiguous +
+T1897b.hs:16:1:
+ Could not deduce (Depend a0 ~ Depend a)
+ from the context (Bug a)
+ bound by the inferred type for ‘isValid’:
+ Bug a => [Depend a] -> Bool
+ at T1897b.hs:16:1-41
+ NB: ‘Depend’ is a type function, and may not be injective
+ The type variable ‘a0’ is ambiguous
+ Expected type: [Depend a] -> Bool
+ Actual type: [Depend a0] -> Bool
+ When checking that ‘isValid’ has the inferred type
+ isValid :: forall a. Bug a => [Depend a] -> Bool
+ Probable cause: the inferred type is ambiguous
diff --git a/testsuite/tests/indexed-types/should_fail/T1900.stderr b/testsuite/tests/indexed-types/should_fail/T1900.stderr index 435d5e8312..d44b4ed210 100644 --- a/testsuite/tests/indexed-types/should_fail/T1900.stderr +++ b/testsuite/tests/indexed-types/should_fail/T1900.stderr @@ -11,4 +11,4 @@ T1900.hs:13:10: In the ambiguity check for: forall s. Bug s => Depend s -> Bool To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the type signature for ‘check’: - check :: Bug s => Depend s -> Bool + check :: (Bug s) => Depend s -> Bool diff --git a/testsuite/tests/indexed-types/should_fail/T2693.stderr b/testsuite/tests/indexed-types/should_fail/T2693.stderr index 58b27696ea..b613ab7ab5 100644 --- a/testsuite/tests/indexed-types/should_fail/T2693.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2693.stderr @@ -1,37 +1,38 @@ - -T2693.hs:11:7: - Couldn't match expected type ‘TFn a’ with actual type ‘TFn a0’ - NB: ‘TFn’ is a type function, and may not be injective - The type variable ‘a0’ is ambiguous - When checking that ‘x’ has the inferred type ‘forall a. TFn a’ - Probable cause: the inferred type is ambiguous - In the expression: - do { let Just x = ...; - let n = fst x + fst x; - return () } - In an equation for ‘f’: - f = do { let Just x = ...; - let n = ...; - return () } - -T2693.hs:19:15: - Couldn't match expected type ‘(a2, b0)’ with actual type ‘TFn a3’ - The type variables ‘a2’, ‘b0’, ‘a3’ are ambiguous - Relevant bindings include n :: a2 (bound at T2693.hs:19:7) - In the first argument of ‘fst’, namely ‘x’ - In the first argument of ‘(+)’, namely ‘fst x’ - -T2693.hs:19:23: - Couldn't match expected type ‘(a4, a2)’ with actual type ‘TFn a5’ - The type variables ‘a2’, ‘a4’, ‘a5’ are ambiguous - Relevant bindings include n :: a2 (bound at T2693.hs:19:7) - In the first argument of ‘snd’, namely ‘x’ - In the second argument of ‘(+)’, namely ‘snd x’ - -T2693.hs:29:20: - Couldn't match type ‘TFn a0’ with ‘PVR a1’ - The type variables ‘a0’, ‘a1’ are ambiguous - Expected type: () -> Maybe (PVR a1) - Actual type: () -> Maybe (TFn a0) - In the first argument of ‘mapM’, namely ‘g’ - In a stmt of a 'do' block: pvs <- mapM g undefined +
+T2693.hs:11:7:
+ Couldn't match expected type ‘TFn a’ with actual type ‘TFn a0’
+ NB: ‘TFn’ is a type function, and may not be injective
+ The type variable ‘a0’ is ambiguous
+ When checking that ‘x’ has the inferred type
+ x :: forall a. TFn a
+ Probable cause: the inferred type is ambiguous
+ In the expression:
+ do { let Just x = ...;
+ let n = fst x + fst x;
+ return () }
+ In an equation for ‘f’:
+ f = do { let Just x = ...;
+ let n = ...;
+ return () }
+
+T2693.hs:19:15:
+ Couldn't match expected type ‘(a2, b0)’ with actual type ‘TFn a3’
+ The type variables ‘a2’, ‘b0’, ‘a3’ are ambiguous
+ Relevant bindings include n :: a2 (bound at T2693.hs:19:7)
+ In the first argument of ‘fst’, namely ‘x’
+ In the first argument of ‘(+)’, namely ‘fst x’
+
+T2693.hs:19:23:
+ Couldn't match expected type ‘(a4, a2)’ with actual type ‘TFn a5’
+ The type variables ‘a2’, ‘a4’, ‘a5’ are ambiguous
+ Relevant bindings include n :: a2 (bound at T2693.hs:19:7)
+ In the first argument of ‘snd’, namely ‘x’
+ In the second argument of ‘(+)’, namely ‘snd x’
+
+T2693.hs:29:20:
+ Couldn't match type ‘TFn a0’ with ‘PVR a1’
+ The type variables ‘a0’, ‘a1’ are ambiguous
+ Expected type: () -> Maybe (PVR a1)
+ Actual type: () -> Maybe (TFn a0)
+ In the first argument of ‘mapM’, namely ‘g’
+ In a stmt of a 'do' block: pvs <- mapM g undefined
diff --git a/testsuite/tests/indexed-types/should_fail/T2888.stderr b/testsuite/tests/indexed-types/should_fail/T2888.stderr new file mode 100644 index 0000000000..3d2c221703 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T2888.stderr @@ -0,0 +1,5 @@ + +T2888.hs:6:1: + The associated type ‘D’ + mentions none of the type or kind variables of the class ‘C w’ + In the class declaration for ‘C’ diff --git a/testsuite/tests/indexed-types/should_fail/T5934.stderr b/testsuite/tests/indexed-types/should_fail/T5934.stderr index 85ab1a1804..67a468057c 100644 --- a/testsuite/tests/indexed-types/should_fail/T5934.stderr +++ b/testsuite/tests/indexed-types/should_fail/T5934.stderr @@ -1,8 +1,8 @@ T5934.hs:12:7:
- Cannot instantiate unification variable ‘a0’
- with a type involving foralls:
- (forall s. Gen (PrimState (ST s))) -> Int
- Perhaps you want ImpredicativeTypes
+ Couldn't match type ‘Integer’
+ with ‘(forall s. Gen (PrimState (ST s))) -> Int’
+ Expected type: Integer -> (forall s. GenST s) -> Int
+ Actual type: Integer -> Integer
In the expression: 0
In an equation for ‘run’: run = 0
diff --git a/testsuite/tests/indexed-types/should_fail/T7786.stderr b/testsuite/tests/indexed-types/should_fail/T7786.stderr index 9652643802..b081ed69b4 100644 --- a/testsuite/tests/indexed-types/should_fail/T7786.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7786.stderr @@ -3,7 +3,7 @@ T7786.hs:86:22: Couldn't match type ‘xxx’ with ‘'Empty’ Inaccessible code in a pattern with constructor - Nil :: Sing 'Empty, + Nil :: forall (k :: BOX). Sing 'Empty, in a pattern binding in 'do' block In the pattern: Nil diff --git a/testsuite/tests/indexed-types/should_fail/T9036.hs b/testsuite/tests/indexed-types/should_fail/T9036.hs new file mode 100644 index 0000000000..550adb4b0a --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9036.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} + + +module T9036 where + +class UncurryM t where + type GetMonad t :: * -> * + +class Curry a b where + type Curried a b :: * + +gSimple :: String -> String -> [String] +gSimple = simpleLogger (return ()) + +simpleLogger :: Maybe (GetMonad t after) -> t `Curried` [t] +simpleLogger _ _ = undefined diff --git a/testsuite/tests/indexed-types/should_fail/T9036.stderr b/testsuite/tests/indexed-types/should_fail/T9036.stderr new file mode 100644 index 0000000000..2df53c712c --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9036.stderr @@ -0,0 +1,12 @@ + +T9036.hs:17:17: + Couldn't match type ‘GetMonad t0’ with ‘GetMonad t’ + NB: ‘GetMonad’ is a type function, and may not be injective + The type variable ‘t0’ is ambiguous + Expected type: Maybe (GetMonad t after) -> Curried t [t] + Actual type: Maybe (GetMonad t0 after) -> Curried t0 [t0] + In the ambiguity check for: + forall t after. Maybe (GetMonad t after) -> Curried t [t] + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature for ‘simpleLogger’: + simpleLogger :: Maybe (GetMonad t after) -> t `Curried` [t] diff --git a/testsuite/tests/indexed-types/should_fail/T9097.hs b/testsuite/tests/indexed-types/should_fail/T9097.hs new file mode 100644 index 0000000000..b18b90b5f3 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9097.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} + +module T9097 where + +import GHC.Exts + +type family Foo x where + Foo True = False + Foo False = False + Foo Any = True diff --git a/testsuite/tests/indexed-types/should_fail/T9097.stderr b/testsuite/tests/indexed-types/should_fail/T9097.stderr new file mode 100644 index 0000000000..02dfc33068 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9097.stderr @@ -0,0 +1,5 @@ + +T9097.hs:10:3: + Illegal type synonym family application in instance: Any + In the equations for closed type family ‘Foo’ + In the type family declaration for ‘Foo’ diff --git a/testsuite/tests/indexed-types/should_fail/T9160.hs b/testsuite/tests/indexed-types/should_fail/T9160.hs new file mode 100644 index 0000000000..64ae3b9f9c --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9160.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances, TemplateHaskell, PolyKinds, TypeFamilies #-} + +module T9160 where +import Language.Haskell.TH + +$( do { cls_nm <- newName "C" + ; a_nm <- newName "a" + ; k_nm <- newName "k" + ; f_nm <- newName "F" + ; return [ClassD [] cls_nm [KindedTV a_nm (VarT k_nm)] [] + [FamilyD TypeFam f_nm [] (Just (VarT k_nm))]] } ) + +-- Splices in: +-- class C (a :: k) where +-- type F :: k + +instance C (a :: *) where + type F = Maybe -- Should be illegal + diff --git a/testsuite/tests/indexed-types/should_fail/T9160.stderr b/testsuite/tests/indexed-types/should_fail/T9160.stderr new file mode 100644 index 0000000000..7a476d4f42 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9160.stderr @@ -0,0 +1,11 @@ +Loading package ghc-prim ... linking ... done. +Loading package integer-gmp ... linking ... done. +Loading package base ... linking ... done. +Loading package pretty-1.1.1.1 ... linking ... done. +Loading package template-haskell ... linking ... done. + +T9160.hs:18:8: + Type indexes must match class instance head + Found ‘* -> *’ but expected ‘*’ + In the type instance declaration for ‘F’ + In the instance declaration for ‘C (a :: *)’ diff --git a/testsuite/tests/indexed-types/should_fail/T9167.hs b/testsuite/tests/indexed-types/should_fail/T9167.hs new file mode 100644 index 0000000000..2d2f555011 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9167.hs @@ -0,0 +1,6 @@ + {-# LANGUAGE TypeFamilies #-} + +module T9167 where + +class C a where + type F b diff --git a/testsuite/tests/indexed-types/should_fail/T9167.stderr b/testsuite/tests/indexed-types/should_fail/T9167.stderr new file mode 100644 index 0000000000..1bd21aed5e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9167.stderr @@ -0,0 +1,5 @@ + +T9167.hs:5:1: + The associated type ‘F’ + mentions none of the type or kind variables of the class ‘C a’ + In the class declaration for ‘C’ diff --git a/testsuite/tests/indexed-types/should_fail/T9171.hs b/testsuite/tests/indexed-types/should_fail/T9171.hs new file mode 100644 index 0000000000..72a2d707b0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9171.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PolyKinds, TypeFamilies #-} + +module T9171 where +data Base + +type family GetParam (p::k1) (t::k2) :: k3 + +type instance GetParam Base t = t + +foo = undefined :: GetParam Base (GetParam Base Int) diff --git a/testsuite/tests/indexed-types/should_fail/T9171.stderr b/testsuite/tests/indexed-types/should_fail/T9171.stderr new file mode 100644 index 0000000000..fe49925118 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T9171.stderr @@ -0,0 +1,22 @@ +
+T9171.hs:10:1:
+ Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
+ with actual type ‘GetParam Base (GetParam Base Int)’
+ NB: ‘GetParam’ is a type function, and may not be injective
+ The kind variable ‘k0’ is ambiguous
+ Use -fprint-explicit-kinds to see the kind arguments
+ When checking that ‘foo’ has the inferred type
+ foo :: forall (k :: BOX). GetParam Base (GetParam Base Int)
+ Probable cause: the inferred type is ambiguous
+
+T9171.hs:10:20:
+ Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
+ with actual type ‘GetParam Base (GetParam Base Int)’
+ NB: ‘GetParam’ is a type function, and may not be injective
+ The kind variable ‘k0’ is ambiguous
+ Use -fprint-explicit-kinds to see the kind arguments
+ In the ambiguity check for:
+ forall (k :: BOX). GetParam Base (GetParam Base Int)
+ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+ In an expression type signature: GetParam Base (GetParam Base Int)
+ In the expression: undefined :: GetParam Base (GetParam Base Int)
diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 54a33cd83d..2c5ae68859 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -47,7 +47,7 @@ test('T2157', normal, compile_fail, ['']) test('T2203a', normal, compile_fail, ['']) test('T2627b', normal, compile_fail, ['']) test('T2693', normal, compile_fail, ['']) -test('T2888', normal, compile, ['']) +test('T2888', normal, compile_fail, ['']) test('T3092', normal, compile_fail, ['']) test('NoMatchErr', normal, compile_fail, ['']) test('T2677', normal, compile_fail, ['']) @@ -119,4 +119,8 @@ test('T8129', test('T8368', normal, compile_fail, ['']) test('T8368a', normal, compile_fail, ['']) test('T8518', normal, compile_fail, ['']) - +test('T9036', normal, compile_fail, ['']) +test('T9167', normal, compile_fail, ['']) +test('T9171', normal, compile_fail, ['']) +test('T9097', normal, compile_fail, ['']) +test('T9160', normal, compile_fail, ['']) diff --git a/testsuite/tests/module/T9061.hs b/testsuite/tests/module/T9061.hs new file mode 100644 index 0000000000..1417dcad75 --- /dev/null +++ b/testsuite/tests/module/T9061.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -fwarn-unused-imports #-} +module T9061 where + +import Prelude hiding (log) + +f = log where log = () diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index 8eaa1d5217..926cbb5448 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -334,3 +334,4 @@ test('T414', normal, compile_fail, ['']) test('T414a', normal, compile, ['']) test('T414b', normal, compile, ['']) test('T3776', normal, compile, ['']) +test('T9061', normal, compile, ['']) diff --git a/testsuite/tests/module/mod132.stderr b/testsuite/tests/module/mod132.stderr index 2735a73dad..0a9d25cda8 100644 --- a/testsuite/tests/module/mod132.stderr +++ b/testsuite/tests/module/mod132.stderr @@ -1,2 +1,4 @@ -mod132.hs:6:7: Not in scope: data constructor ‘Foo’ +mod132.hs:6:7: + Not in scope: data constructor ‘Foo’ + Perhaps you meant variable ‘foo’ (line 6) diff --git a/testsuite/tests/module/mod134.stderr b/testsuite/tests/module/mod134.stderr index e2171a8c6d..d6e6f0e30b 100644 --- a/testsuite/tests/module/mod134.stderr +++ b/testsuite/tests/module/mod134.stderr @@ -4,4 +4,4 @@ mod134.hs:6:19: Perhaps you meant one of these: ‘Prelude.read’ (imported from Prelude), ‘Prelude.reads’ (imported from Prelude), - ‘Prelude.snd’ (imported from Prelude) + data constructor ‘Prelude.Left’ (imported from Prelude) diff --git a/testsuite/tests/module/mod73.stderr b/testsuite/tests/module/mod73.stderr index 432f61b549..576b0e3a86 100644 --- a/testsuite/tests/module/mod73.stderr +++ b/testsuite/tests/module/mod73.stderr @@ -2,6 +2,6 @@ mod73.hs:3:7: Not in scope: ‘Prelude.g’ Perhaps you meant one of these: - ‘Prelude.id’ (imported from Prelude), - ‘Prelude.log’ (imported from Prelude), - ‘Prelude.pi’ (imported from Prelude) + data constructor ‘Prelude.LT’ (imported from Prelude), + data constructor ‘Prelude.EQ’ (imported from Prelude), + data constructor ‘Prelude.GT’ (imported from Prelude) diff --git a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun02.hs b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun02.hs index 8567db3566..a6b9bb8ede 100644 --- a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun02.hs +++ b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun02.hs @@ -6,8 +6,3 @@ import GHC.Exts main = do print ([] :: (S.Set Int)) print (['a','b','c'] :: (S.Set Char)) print (['a','c'..'g'] :: (S.Set Char)) - -instance Ord a => IsList (S.Set a) where - type (Item (S.Set a)) = a - fromList = S.fromList - toList = S.toList diff --git a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun04.hs b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun04.hs index 478d8d2c22..1111f93427 100644 --- a/testsuite/tests/overloadedlists/should_run/overloadedlistsrun04.hs +++ b/testsuite/tests/overloadedlists/should_run/overloadedlistsrun04.hs @@ -3,10 +3,10 @@ import qualified Data.Set as S import GHC.Exts -main = do putStrLn (f []) - putStrLn (f [1,2]) - putStrLn (f [2,0]) - putStrLn (f [3,2]) +main = do putStrLn (f []) + putStrLn (f [1,2]) + putStrLn (f [2,0]) + putStrLn (f [3,2]) putStrLn (f [2,7]) putStrLn (f [2,2]) putStrLn (f [1..7]) @@ -18,11 +18,3 @@ f [_] = "one element" f [2,_] = "two elements, the smaller one is 2" f [_,2] = "two elements, the bigger one is 2" f _ = "else" - - -instance Ord a => IsList (S.Set a) where - type (Item (S.Set a)) = a - fromList = S.fromList - toList = S.toList - - diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.hs b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.hs new file mode 100644 index 0000000000..6b7de0f712 --- /dev/null +++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.hs @@ -0,0 +1,5 @@ +module ParserNoBinaryLiterals1 where + +f :: Int -> () +f 0b0 = () +f _ = () diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.stderr b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.stderr new file mode 100644 index 0000000000..3b57330e59 --- /dev/null +++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals1.stderr @@ -0,0 +1,5 @@ + +ParserNoBinaryLiterals1.hs:4:1: + Equations for ‘f’ have different numbers of arguments + ParserNoBinaryLiterals1.hs:4:1-10 + ParserNoBinaryLiterals1.hs:5:1-10 diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.hs b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.hs new file mode 100644 index 0000000000..e760bd888e --- /dev/null +++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash #-} + +module ParserNoBinaryLiterals2 where + +import GHC.Types + +f :: Word -> () +f (W# 0b0##) = () +f _ = () diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.stderr b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.stderr new file mode 100644 index 0000000000..4a756d6e27 --- /dev/null +++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals2.stderr @@ -0,0 +1,5 @@ + +ParserNoBinaryLiterals2.hs:8:4: + Constructor ‘W#’ should have 1 argument, but has been given 2 + In the pattern: W# 0 b0## + In an equation for ‘f’: f (W# 0 b0##) = () diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.hs b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.hs new file mode 100644 index 0000000000..b6bc81b68a --- /dev/null +++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash #-} + +module ParserNoBinaryLiterals3 where + +import GHC.Types + +f :: Int -> () +f (I# 0b0#) = () +f _ = () diff --git a/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.stderr b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.stderr new file mode 100644 index 0000000000..32c27e6b8a --- /dev/null +++ b/testsuite/tests/parser/should_fail/ParserNoBinaryLiterals3.stderr @@ -0,0 +1,5 @@ + +ParserNoBinaryLiterals3.hs:8:4: + Constructor ‘I#’ should have 1 argument, but has been given 2 + In the pattern: I# 0 b0# + In an equation for ‘f’: f (I# 0 b0#) = () diff --git a/testsuite/tests/parser/should_fail/T8506.stderr b/testsuite/tests/parser/should_fail/T8506.stderr index b0e9fde84b..d7de4fe4e3 100644 --- a/testsuite/tests/parser/should_fail/T8506.stderr +++ b/testsuite/tests/parser/should_fail/T8506.stderr @@ -3,4 +3,4 @@ T8506.hs:3:16: Unexpected type ‘Int’ In the class declaration for ‘Shapable’ A class declaration should have form - class Shapable a b c where ... + class Shapable a where ... diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index 45c471e2c6..7e286cf3f2 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -75,6 +75,9 @@ test('readFailTraditionalRecords3', normal, compile_fail, ['']) test('ParserNoForallUnicode', normal, compile_fail, ['']) test('ParserNoLambdaCase', when(compiler_lt('ghc', '7.5'), skip), compile_fail, ['']) test('ParserNoMultiWayIf', when(compiler_lt('ghc', '7.5'), skip), compile_fail, ['']) +test('ParserNoBinaryLiterals1', normal, compile_fail, ['']) +test('ParserNoBinaryLiterals2', normal, compile_fail, ['']) +test('ParserNoBinaryLiterals3', normal, compile_fail, ['']) test('T5425', normal, compile_fail, ['']) test('T984', normal, compile_fail, ['']) diff --git a/testsuite/tests/parser/should_fail/readFail025.stderr b/testsuite/tests/parser/should_fail/readFail025.stderr index da220cd0c3..5641642c99 100644 --- a/testsuite/tests/parser/should_fail/readFail025.stderr +++ b/testsuite/tests/parser/should_fail/readFail025.stderr @@ -3,4 +3,4 @@ readFail025.hs:5:8: Unexpected type ‘String’ In the data declaration for ‘T’ A data declaration should have form - data T a b c = ... + data T a = ... diff --git a/testsuite/tests/parser/should_run/BinaryLiterals0.hs b/testsuite/tests/parser/should_run/BinaryLiterals0.hs new file mode 100644 index 0000000000..7257445fba --- /dev/null +++ b/testsuite/tests/parser/should_run/BinaryLiterals0.hs @@ -0,0 +1,19 @@ +-- | Anti-Test for GHC 7.10+'s @BinaryLiterals@ extensions (see GHC #9224) +-- +-- NB: This code won't compile with -XBinaryLiterals enabled + +{-# LANGUAGE NegativeLiterals #-} + +module Main where + +main :: IO () +main = print lst + where + -- "0b0" is to be parsed as "0 b0" + lst = [ (,) 0b0, (,) 0b1, (,) 0b10, (,) 0b11 + , (,) -0b0, (,) -0b1, (,) -0b10, (,) -0b11 + ] :: [(Int,Int)] + b0 = 60 + b1 = 61 + b11 = 611 + b10 = 610 diff --git a/testsuite/tests/parser/should_run/BinaryLiterals0.stdout b/testsuite/tests/parser/should_run/BinaryLiterals0.stdout new file mode 100644 index 0000000000..dacce8854e --- /dev/null +++ b/testsuite/tests/parser/should_run/BinaryLiterals0.stdout @@ -0,0 +1 @@ +[(0,60),(0,61),(0,610),(0,611),(0,60),(0,61),(0,610),(0,611)] diff --git a/testsuite/tests/parser/should_run/BinaryLiterals1.hs b/testsuite/tests/parser/should_run/BinaryLiterals1.hs new file mode 100644 index 0000000000..f9918fb068 --- /dev/null +++ b/testsuite/tests/parser/should_run/BinaryLiterals1.hs @@ -0,0 +1,25 @@ +-- | Test for GHC 7.10+'s @BinaryLiterals@ extensions (see GHC #9224) + +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE MagicHash #-} + +module Main where + +import GHC.Types + +main = do + print [ I# 0b0#, I# -0b0#, I# 0b1#, I# -0b1# + , I# 0b00000000000000000000000000000000000000000000000000000000000000000000000000001# + , I# -0b00000000000000000000000000000000000000000000000000000000000000000000000000001# + , I# -0b11001001#, I# -0b11001001# + , I# -0b11111111#, I# -0b11111111# + ] + print [ W# 0b0##, W# 0b1##, W# 0b11001001##, W# 0b11##, W# 0b11111111## + , W# 0b00000000000000000000000000000000000000000000000000000000000000000000000000001## + ] + + print [ 0b0, 0b1, 0b10, 0b11, 0b100, 0b101, 0b110, 0b111 :: Integer + , -0b0, -0b1, -0b10, -0b11, -0b100, -0b101, -0b110, -0b111 + , 0b11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 + , -0b11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 + ] diff --git a/testsuite/tests/parser/should_run/BinaryLiterals1.stdout b/testsuite/tests/parser/should_run/BinaryLiterals1.stdout new file mode 100644 index 0000000000..e1065be034 --- /dev/null +++ b/testsuite/tests/parser/should_run/BinaryLiterals1.stdout @@ -0,0 +1,3 @@ +[0,0,1,-1,1,-1,-201,-201,-255,-255] +[0,1,201,3,255,1] +[0,1,2,3,4,5,6,7,0,-1,-2,-3,-4,-5,-6,-7,340282366920938463463374607431768211455,-340282366920938463463374607431768211455] diff --git a/testsuite/tests/parser/should_run/BinaryLiterals2.hs b/testsuite/tests/parser/should_run/BinaryLiterals2.hs new file mode 100644 index 0000000000..3779d52341 --- /dev/null +++ b/testsuite/tests/parser/should_run/BinaryLiterals2.hs @@ -0,0 +1,29 @@ +-- | Test for GHC 7.10+'s @BinaryLiterals@ extensions (see GHC #9224) + +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NegativeLiterals #-} + +module Main where + +import GHC.Types +import GHC.Int + +main = do + print [ I# 0B0#, I# -0B0#, I# 0B1#, I# -0B1# + , I# 0B00000000000000000000000000000000000000000000000000000000000000000000000000001# + , I# -0B00000000000000000000000000000000000000000000000000000000000000000000000000001# + , I# -0B11001001#, I# -0B11001001# + , I# -0B11111111#, I# -0B11111111# + ] + print [ W# 0B0##, W# 0B1##, W# 0B11001001##, W# 0B11##, W# 0B11111111## + , W# 0B00000000000000000000000000000000000000000000000000000000000000000000000000001## + ] + + print [ 0B0, 0B1, 0B10, 0B11, 0B100, 0B101, 0B110, 0B111 :: Integer + , -0B0, -0B1, -0B10, -0B11, -0B100, -0B101, -0B110, -0B111 + , 0B11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 + , -0B11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 + ] + + print [ I8# -0B10000000#, I8# 0B1111111# ] diff --git a/testsuite/tests/parser/should_run/BinaryLiterals2.stdout b/testsuite/tests/parser/should_run/BinaryLiterals2.stdout new file mode 100644 index 0000000000..76506e9670 --- /dev/null +++ b/testsuite/tests/parser/should_run/BinaryLiterals2.stdout @@ -0,0 +1,4 @@ +[0,0,1,-1,1,-1,-201,-201,-255,-255] +[0,1,201,3,255,1] +[0,1,2,3,4,5,6,7,0,-1,-2,-3,-4,-5,-6,-7,340282366920938463463374607431768211455,-340282366920938463463374607431768211455] +[-128,127] diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T index eee0330e5e..cf7ee6fdd3 100644 --- a/testsuite/tests/parser/should_run/all.T +++ b/testsuite/tests/parser/should_run/all.T @@ -6,3 +6,6 @@ test('T1344', normal, compile_and_run, ['']) test('operator', normal, compile_and_run, ['']) test('operator2', normal, compile_and_run, ['']) test('ParserMultiWayIf', when(compiler_lt('ghc', '7.5'), skip), compile_and_run, ['']) +test('BinaryLiterals0', normal, compile_and_run, ['']) +test('BinaryLiterals1', when(compiler_lt('ghc', '7.9'), skip), compile_and_run, ['']) +test('BinaryLiterals2', when(compiler_lt('ghc', '7.9'), skip), compile_and_run, [''])
\ No newline at end of file diff --git a/testsuite/tests/patsyn/should_compile/.gitignore b/testsuite/tests/patsyn/should_compile/.gitignore deleted file mode 100644 index 492f1e78dd..0000000000 --- a/testsuite/tests/patsyn/should_compile/.gitignore +++ /dev/null @@ -1,9 +0,0 @@ -.hpc.bidir -.hpc.ex -.hpc.ex-num -.hpc.ex-prov -.hpc.ex-view -.hpc.incomplete -.hpc.num -.hpc.overlap -.hpc.univ diff --git a/testsuite/tests/patsyn/should_compile/T9023.hs b/testsuite/tests/patsyn/should_compile/T9023.hs new file mode 100644 index 0000000000..3a8614009f --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T9023.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PatternSynonyms #-} + +module T9023 where + +pattern P a b = Just (a, b) +foo P{} = True diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index ecc4701661..d851bc3ac8 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -9,3 +9,4 @@ test('num', normal, compile, ['']) test('incomplete', normal, compile, ['']) test('export', normal, compile, ['']) test('T8966', normal, compile, ['']) +test('T9023', normal, compile, ['']) diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.hs b/testsuite/tests/patsyn/should_fail/T9161-1.hs new file mode 100644 index 0000000000..c14eb542cc --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-1.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE DataKinds #-} + +pattern PATTERN = () + +wrongLift :: PATTERN +wrongLift = undefined diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.stderr b/testsuite/tests/patsyn/should_fail/T9161-1.stderr new file mode 100644 index 0000000000..1f05196ebb --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-1.stderr @@ -0,0 +1,4 @@ + +T9161-1.hs:6:14: + Pattern synonym ‘PATTERN’ used as a type + In the type signature for ‘wrongLift’: wrongLift :: PATTERN diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.hs b/testsuite/tests/patsyn/should_fail/T9161-2.hs new file mode 100644 index 0000000000..941d23e35f --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-2.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE DataKinds, KindSignatures, PolyKinds #-} + +pattern PATTERN = () + +data Proxy (tag :: k) (a :: *) + +wrongLift :: Proxy PATTERN () +wrongLift = undefined diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.stderr b/testsuite/tests/patsyn/should_fail/T9161-2.stderr new file mode 100644 index 0000000000..8d21be5906 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T9161-2.stderr @@ -0,0 +1,5 @@ + +T9161-2.hs:8:20: + Pattern synonym ‘PATTERN’ used as a type + In the type signature for ‘wrongLift’: + wrongLift :: Proxy PATTERN () diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 897808ef1d..bff6bdf8c2 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -4,3 +4,5 @@ test('unidir', normal, compile_fail, ['']) test('local', normal, compile_fail, ['']) test('T8961', normal, multimod_compile_fail, ['T8961','']) test('as-pattern', normal, compile_fail, ['']) +test('T9161-1', normal, compile_fail, ['']) +test('T9161-2', normal, compile_fail, ['']) diff --git a/testsuite/tests/patsyn/should_run/.gitignore b/testsuite/tests/patsyn/should_run/.gitignore deleted file mode 100644 index 7380291005..0000000000 --- a/testsuite/tests/patsyn/should_run/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ -eval -ex-prov -match - -.hpc.eval -.hpc.ex-prov -.hpc.match diff --git a/testsuite/tests/perf/compiler/T5837.stderr b/testsuite/tests/perf/compiler/T5837.stderr index 2d2907d3ae..5cee13dd1d 100644 --- a/testsuite/tests/perf/compiler/T5837.stderr +++ b/testsuite/tests/perf/compiler/T5837.stderr @@ -158,4 +158,4 @@ T5837.hs:8:6: (TF a))))))))))))))))))))))))))))))))))))))))))))))))) In the ambiguity check for: forall a. a ~ TF (a, Int) => Int - In the type signature for ‘t’: t :: a ~ TF (a, Int) => Int + In the type signature for ‘t’: t :: (a ~ TF (a, Int)) => Int diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 2bff1c72d5..9a67aa5431 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -42,15 +42,17 @@ test('T1969', # 2013-02-13 27, very unstable! # 2013-09-11 30 (amd64/Linux) compiler_stats_num_field('max_bytes_used', - [(platform('i386-unknown-mingw32'), 7295012, 20), + [(platform('i386-unknown-mingw32'), 5719436, 20), # 2010-05-17 5717704 (x86/Windows) # 2013-02-10 5159748 (x86/Windows) # 2013-02-10 5030080 (x86/Windows) # 2013-11-13 7295012 (x86/Windows, 64bit machine) - (wordsize(32), 6429864, 1), + # 2014-04-24 5719436 (x86/Windows, 64bit machine) + (wordsize(32), 5949188, 1), # 6707308 (x86/OS X) # 2009-12-31 6149572 (x86/Linux) # 2014-01-22 6429864 (x86/Linux) + # 2014-06-29 5949188 (x86/Linux) (wordsize(64), 11000000, 20)]), # looks like the peak is around ~10M, but we're # unlikely to GC exactly on the peak. @@ -64,13 +66,14 @@ test('T1969', # 2013-02-10 310633884 (x86/Windows) # 2013-11-13 317975916 (x86/Windows, 64bit machine) # 2014-04-04 301784492 (x86/Windows, 64bit machine) - (wordsize(32), 316103268, 1), + (wordsize(32), 303300692, 1), # 221667908 (x86/OS X) # 274932264 (x86/Linux) # 2012-10-08 303930948 (x86/Linux, new codegen) # 2013-02-10 322937684 (x86/OSX) # 2014-01-22 316103268 (x86/Linux) - (wordsize(64), 660922376, 5)]), + # 2014-06-29 303300692 (x86/Linux) + (wordsize(64), 651626680, 5)]), # 17/11/2009 434845560 (amd64/Linux) # 08/12/2009 459776680 (amd64/Linux) # 17/05/2010 519377728 (amd64/Linux) @@ -86,6 +89,7 @@ test('T1969', # 17/1/13: 667160192 (x86_64/Linux) new demand analyser # 18/10/2013 698612512 (x86_64/Linux) fix for #8456 # 10/02/2014 660922376 (x86_64/Linux) call artiy analysis + # 17/07/2014 651626680 (x86_64/Linux) roundabout update only_ways(['normal']), extra_hc_opts('-dcore-lint -static') @@ -110,13 +114,14 @@ else: test('T3294', [ compiler_stats_num_field('max_bytes_used', # Note [residency] - [(wordsize(32), 24009436, 15), + [(wordsize(32), 19882188, 15), # 17725476 (x86/OS X) # 14593500 (Windows) # 2013-02-10 20651576 (x86/Windows) # 2013-02-10 20772984 (x86/OSX) # 2013-11-13 24009436 (x86/Windows, 64bit machine) - (wordsize(64), 43224080, 15)]), + # 2014-04-24 19882188 (x86/Windows, 64bit machine) + (wordsize(64), 40000000, 15)]), # prev: 25753192 (amd64/Linux) # 29/08/2012: 37724352 (amd64/Linux) # (increase due to new codegen, see #7198) @@ -126,6 +131,8 @@ test('T3294', # (reason for decrease unknown) # 29/5/2013: 43224080 (amd64/Linux) # (reason for increase back to earlier value unknown) + # 2014-07-14: 36670800 (amd64/Linux) + # (reason unknown, setting expected value somewhere in between) compiler_stats_num_field('bytes allocated', [(wordsize(32), 1377050640, 5), @@ -135,7 +142,7 @@ test('T3294', # 2013-11-13: 1478325844 (x86/Windows, 64bit machine) # 2014-01-12: 1565185140 (x86/Linux) # 2013-04-04: 1377050640 (x86/Windows, 64bit machine) - (wordsize(64), 2705289664, 5)]), + (wordsize(64), 2671595512, 5)]), # old: 1357587088 (amd64/Linux) # 29/08/2012: 2961778696 (amd64/Linux) # (^ increase due to new codegen, see #7198) @@ -144,6 +151,7 @@ test('T3294', # 12/12/2013: 3083825616 (amd64/Linux) (reason unknown) # 18/02/2014: 2897630040 (amd64/Linux) (call arity improvements) # 12/03/2014: 2705289664 (amd64/Linux) (more call arity improvements) + # 2014-17-07: 2671595512 (amd64/Linux) (round-about update) conf_3294 ], compile, @@ -225,14 +233,16 @@ test('T3064', # 2012-10-30: 111189536 (x86/Windows) # 2013-11-13: 146626504 (x86/Windows, 64bit machine) # 2014-01-22: 162457940 (x86/Linux) - (wordsize(64), 308422280, 5)]), + (wordsize(64), 332702112, 5)]), # (amd64/Linux) (28/06/2011): 73259544 # (amd64/Linux) (07/02/2013): 224798696 # (amd64/Linux) (02/08/2013): 236404384, increase from roles # (amd64/Linux) (11/09/2013): 290165632, increase from AMP warnings # (amd64/Linux) (22/11/2013): 308300448, GND via Coercible and counters for constraints solving - # (amd64/Linux) (02/12/2013): 329795912, Coercible refactor + # (amd64/Linux) (02/12/2013): 329795912, Coercible refactor # (amd64/Linux) (11/02/2014): 308422280, optimize Coercions in simpleOptExpr + # (amd64/Linux) (23/05/2014): 324022680, unknown cause + # (amd64/Linux) (2014-07-17): 332702112, general round of updates compiler_stats_num_field('max_bytes_used', [(wordsize(32), 11202304, 20), @@ -267,7 +277,7 @@ test('T5030', # previous: 196457520 # 2012-10-08: 259547660 (x86/Linux, new codegen) # 2013-11-21: 198573456 (x86 Windows, 64 bit machine) - (wordsize(64), 397672152, 10)]), + (wordsize(64), 409314320, 10)]), # Previously 530000000 (+/- 10%) # 17/1/13: 602993184 (x86_64/Linux) # (new demand analyser) @@ -277,6 +287,8 @@ test('T5030', # decrease from more aggressive coercion optimisations from roles # 2013-11-12 397672152 (amd64/Linux) # big decrease following better CSE and arity + # 2014-07-17 409314320 (amd64/Linux) + # general round of updates only_ways(['normal']) ], @@ -316,7 +328,7 @@ test('T783', # 2013-02-10: 329202116 (x86/Windows) # 2013-02-10: 338465200 (x86/OSX) # 2014-04-04: 319179104 (x86 Windows, 64 bit machine) - (wordsize(64), 654804144, 10)]), + (wordsize(64), 640031840, 10)]), # prev: 349263216 (amd64/Linux) # 07/08/2012: 384479856 (amd64/Linux) # 29/08/2012: 436927840 (amd64/Linux) @@ -327,6 +339,8 @@ test('T783', # (fix for #8456) # 24/10/2013: 654804144 (amd64/Linux) # (fix previous fix for #8456) + # 2014-07-17: 640031840 (amd64/Linux) + # (general round of updates) extra_hc_opts('-static') ], compile,['']) @@ -356,7 +370,7 @@ test('T5321FD', # prev: 213380256 # 2012-10-08: 240302920 (x86/Linux) # (increase due to new codegen) - (wordsize(64), 476497048, 10)]) + (wordsize(64), 426960992, 10)]) # prev: 418306336 # 29/08/2012: 492905640 # (increase due to new codegen) @@ -364,6 +378,10 @@ test('T5321FD', # (reason for decrease unknown) # 08/06/2013: 476497048 # (reason for increase unknown) + # before 2014-07-17: 441997096 + # (with -8%, still in range, hence cause not known) + # 2014-07-17: 426960992 (-11% of previous value) + # (due to better optCoercion, 5e7406d9, #9233) ], compile,['']) @@ -372,7 +390,9 @@ test('T5642', compiler_stats_num_field('bytes allocated', [(wordsize(32), 650000000, 10), # sample from x86/Linux - (wordsize(64), 1300000000, 10)]) + (wordsize(64), 1358833928, 10)]) + # prev: 1300000000 + # 2014-07-17: 1358833928 (general round of updates) ], compile,['-O']) @@ -387,8 +407,8 @@ test('T5837', # 2012-10-02 81879216 # 2012-09-20 87254264 amd64/Linux # 2013-09-18 90587232 amd64/Linux - # 2013-11-21 86795752 amd64/Linux, GND via Coercible and counters - # for constraints solving + # 2013-11-21 86795752 amd64/Linux, GND via Coercible and counters + # for constraints solving ], compile_fail,['-ftype-function-depth=50']) @@ -399,19 +419,22 @@ test('T6048', # prev: 38000000 (x86/Linux) # 2012-10-08: 48887164 (x86/Linux) # 2014-04-04: 62618072 (x86 Windows, 64 bit machine) - (wordsize(64), 110646312, 10)]) - # 18/09/2012 97247032 amd64/Linux + (wordsize(64), 125431448, 12)]) + # 18/09/2012 97247032 amd64/Linux # 16/01/2014 108578664 amd64/Linux (unknown, likely foldl-via-foldr) - # 18/01/2014 95960720 amd64/Linux Call Arity improvements + # 18/01/2014 95960720 amd64/Linux Call Arity improvements # 28/02/2014 105556793 amd64/Linux (unknown, tweak in base/4d9e7c9e3 resulted in change) # 05/03/2014 110646312 amd64/Linux Call Arity became more elaborate + # 14/07/2014 125431448 amd64/Linux unknown reason. Even worse in GHC-7.8.3. *shurg* ], compile,['']) test('T9020', [ only_ways(['optasm']), compiler_stats_num_field('bytes allocated', - [(wordsize(32), 40000000, 10), - (wordsize(64), 795469104, 10)]) + [(wordsize(32), 381360728, 10), + (wordsize(64), 728263536, 10)]) + # prev: 795469104 + # 2014-07-17: 728263536 (general round of updates) ], compile,['']) diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index e1d7e9f432..b17d472928 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -10,11 +10,12 @@ test('haddock.base', ,(platform('i386-unknown-mingw32'), 163, 10) # 2013-02-10: 133 (x86/Windows) # 2013-11-13: 163 (x86/Windows, 64bit machine) - ,(wordsize(32), 168, 1)]) + ,(wordsize(32), 156, 1)]) # 2012-08-14: 144 (x86/OSX) # 2012-10-30: 113 (x86/Windows) # 2013-02-10: 139 (x86/OSX) # 2014-01-22: 168 (x86/Linux - new haddock) + # 2014-06-29: 156 (x86/Linux) ,stats_num_field('max_bytes_used', [(wordsize(64), 115113864, 10) # 2012-08-14: 87374568 (amd64/Linux) @@ -26,11 +27,12 @@ test('haddock.base', ,(platform('i386-unknown-mingw32'), 58557136, 10) # 2013-02-10: 47988488 (x86/Windows) # 2013-11-13: 58557136 (x86/Windows, 64bit machine) - ,(wordsize(32), 62189068, 1)]) + ,(wordsize(32), 58243640, 1)]) # 2013-02-10: 52237984 (x86/OSX) # 2014-01-22: 62189068 (x86/Linux) + # 2014-06-29: 58243640 (x86/Linux) ,stats_num_field('bytes allocated', - [(wordsize(64), 7128342344, 5) + [(wordsize(64), 7498123680, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -40,15 +42,17 @@ test('haddock.base', # 2013-09-18: 6294339840 (x86_64/Linux) # 2013-11-21: 6756213256 (x86_64/Linux) # 2014-01-12: 7128342344 (x86_64/Linux) + # 2014-06-12: 7498123680 (x86_64/Linux) ,(platform('i386-unknown-mingw32'), 3548581572, 5) # 2013-02-10: 3358693084 (x86/Windows) # 2013-11-13: 3097751052 (x86/Windows, 64bit machine) # 2014-04-04: 3548581572 (x86/Windows, 64bit machine) - ,(wordsize(32), 3554624600, 1)]) + ,(wordsize(32), 3799130400, 1)]) # 2012-08-14: 3046487920 (x86/OSX) # 2012-10-30: 2955470952 (x86/Windows) # 2013-02-10: 3146596848 (x86/OSX) # 2014-02-22: 3554624600 (x86/Linux - new haddock) + # 2014-06-29: 3799130400 (x86/Linux) ], stats, ['../../../../libraries/base/dist-install/doc/html/base/base.haddock.t']) @@ -56,7 +60,7 @@ test('haddock.base', test('haddock.Cabal', [unless(in_tree_compiler(), skip) ,stats_num_field('peak_megabytes_allocated', - [(wordsize(64), 278, 10) + [(wordsize(64), 309, 10) # 2012-08-14: 202 (amd64/Linux) # 2012-08-29: 211 (amd64/Linux, new codegen) # 2012-09-20: 227 (amd64/Linux) @@ -64,33 +68,37 @@ test('haddock.Cabal', # 2013-06-07: 246 (amd64/Linux) (reason unknown) # 2013-11-21: 269 # 2013-11-22: 278 (amd64/Linux) (TH refactoring; weird) + # 2014-07-14: 309 (amd64/Linux) ,(platform('i386-unknown-mingw32'), 144, 10) # 2012-10-30: 83 (x86/Windows) # 2013-02-10: 116 (x86/Windows) # 2013-11-13: 129 (x86/Windows, 64bit machine) # 2014-01-28: 136 # 2014-04-04: 144 - ,(wordsize(32), 139, 1)]) + ,(wordsize(32), 147, 1)]) # 2012-08-14: 116 (x86/OSX) # 2013-02-10: 89 (x86/Windows) # 2014-01-22: 139 (x86/Linux - new haddock, but out of date before) + # 2014-06-29: 147 (x86/Linux) ,stats_num_field('max_bytes_used', - [(wordsize(64), 95356616, 15) - # 2012-08-14: 74119424 (amd64/Linux) - # 2012-08-29: 77992512 (amd64/Linux, new codegen) - # 2012-10-02: 91341568 (amd64/Linux) - # 2012-10-08: 80590280 (amd64/Linux) - # 2013-03-13: 95356616 (amd64/Linux) Cabal updated + [(wordsize(64), 113232208, 15) + # 2012-08-14: 74119424 (amd64/Linux) + # 2012-08-29: 77992512 (amd64/Linux, new codegen) + # 2012-10-02: 91341568 (amd64/Linux) + # 2012-10-08: 80590280 (amd64/Linux) + # 2013-03-13: 95356616 (amd64/Linux) Cabal updated + # 2014-07-14: 113232208 (amd64/Linux) ,(platform('i386-unknown-mingw32'), 63493200, 15) # 2012-10-30: 44224896 (x86/Windows) # 2013-11-13: 49391436 (x86/Windows, 64bit machine) # 2014-04-04: 63493200 (x86/Windows, 64bit machine) - ,(wordsize(32), 52718512, 1)]) + ,(wordsize(32), 66411508, 1)]) # 2012-08-14: 47461532 (x86/OSX) # 2013-02-10: 46563344 (x86/OSX) # 2014-01-22: 52718512 (x86/Linux) + # 2014-06-29: 66411508 (x86/Linux) ,stats_num_field('bytes allocated', - [(wordsize(64), 3979151552, 5) + [(wordsize(64), 4200993768, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -101,13 +109,16 @@ test('haddock.Cabal', # 2013-11-21: 3908586784 (amd64/Linux) Cabal updated # 2013-12-12: 3828567272 (amd64/Linux) # 2014-01-12: 3979151552 (amd64/Linux) new parser - ,(platform('i386-unknown-mingw32'), 1966911336, 1) + # 2014-06-29: 4200993768 (amd64/Linux) + ,(platform('i386-unknown-mingw32'), 2052220292, 5) # 2012-10-30: 1733638168 (x86/Windows) # 2013-02-10: 1906532680 (x86/Windows) # 2014-01-28: 1966911336 (x86/Windows) - ,(wordsize(32), 1986290624, 1)]) + # 2014-04-24: 2052220292 (x86/Windows) + ,(wordsize(32), 2127198484, 1)]) # 2012-08-14: 1648610180 (x86/OSX) # 2014-01-22: 1986290624 (x86/Linux) + # 2014-06-29: 2127198484 (x86/Linux) ], stats, ['../../../../libraries/Cabal/Cabal/dist-install/doc/html/Cabal/Cabal.haddock.t']) @@ -127,10 +138,11 @@ test('haddock.compiler', # 2012-10-30: 606 (x86/Windows) # 2013-02-10: 653 (x86/Windows) # 2013-11-13: 735 (x86/Windows, 64bit machine) - ,(wordsize(32), 727, 1)]) + ,(wordsize(32), 771, 1)]) # 2012-08-14: 631 (x86/OSX) # 2013-02-10: 663 (x86/OSX) # 2014-01-22: 727 (x86/Linux - new haddock, but out of date before) + # 2014-06-29: 771 (x86/Linux) ,stats_num_field('max_bytes_used', [(wordsize(64), 541926264, 10) # 2012-08-14: 428775544 (amd64/Linux) @@ -146,24 +158,27 @@ test('haddock.compiler', # 2013-11-13: 269147084 (x86/Windows, 64bit machine) # 2014-01-28: 283814088 (x86/Windows) # 2014-04-04: 278706344 (x86/Windows) - ,(wordsize(32), 278124612, 1)]) + ,(wordsize(32), 284082916, 1)]) # 2012-08-14: 231064920 (x86/OSX) # 2013-02-10: 241785276 (x86/Windows) # 2014-01-22: 278124612 (x86/Linux - new haddock) + # 2014-06-29: 284082916 (x86/Linux) ,stats_num_field('bytes allocated', - [(wordsize(64), 28708374824, 10) + [(wordsize(64), 29809571376, 10) # 2012-08-14: 26070600504 (amd64/Linux) # 2012-08-29: 26353100288 (amd64/Linux, new CG) # 2012-09-18: 26882813032 (amd64/Linux) # 2012-11-12: 25990254632 (amd64/Linux) + # 2014-07-17: 29809571376 (amd64/Linux) general round of updates # 2012-11-27: 28708374824 (amd64/Linux) ,(platform('i386-unknown-mingw32'), 14328363592, 10) # 2012-10-30: 13773051312 (x86/Windows) # 2013-02-10: 14925262356 (x86/Windows) # 2013-11-13: 14328363592 (x86/Windows, 64bit machine) - ,(wordsize(32), 14581475024, 1)]) + ,(wordsize(32), 15110426000, 1)]) # 2012-08-14: 13471797488 (x86/OSX) # 2014-01-22: 14581475024 (x86/Linux - new haddock) + # 2014-06-29: 15110426000 (x86/Linux) ], stats, ['../../../../compiler/stage2/doc/html/ghc/ghc.haddock.t']) diff --git a/testsuite/tests/perf/should_run/T9203.hs b/testsuite/tests/perf/should_run/T9203.hs new file mode 100644 index 0000000000..500fd8c98e --- /dev/null +++ b/testsuite/tests/perf/should_run/T9203.hs @@ -0,0 +1,9 @@ +module Main where + +import Data.Typeable + +f :: Typeable a => Int -> a -> TypeRep +f 0 a = typeOf a +f n a = f (n-1) [a] + +main = print (f 50000 () == f 50001 ()) diff --git a/testsuite/tests/perf/should_run/T9203.stdout b/testsuite/tests/perf/should_run/T9203.stdout new file mode 100644 index 0000000000..bc59c12aa1 --- /dev/null +++ b/testsuite/tests/perf/should_run/T9203.stdout @@ -0,0 +1 @@ +False diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 606448b011..a9d7c0325d 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -6,8 +6,9 @@ test('T3586', [stats_num_field('peak_megabytes_allocated', (17, 1)), # expected value: 17 (amd64/Linux) - stats_num_field('bytes allocated', (16835544, 5)), - # expected value: 16835544 (amd64/Linux) + stats_num_field('bytes allocated', (16102024, 5)), + # prev: 16835544 (amd64/Linux) + # 2014-07-17: 16102024 (amd64/Linux), general round of updates only_ways(['normal']) ], compile_and_run, @@ -60,9 +61,10 @@ test('T876', [(wordsize(64), 63216 , 5), # 2013-02-14: 1263712 (x86_64/Linux) # 2014-02-10: 63216 (x86_64/Linux), call arity analysis - (wordsize(32), 56820, 5) ]), + (wordsize(32), 53024, 5) ]), # some date: 663712 (Windows, 64-bit machine) # 2014-04-04: 56820 (Windows, 64-bit machine) + # 2014-06-29: 53024 (x86_64/Linux) only_ways(['normal']), extra_run_opts('10000') ], @@ -89,9 +91,10 @@ test('T3738', # expected value: 1 (amd64/Linux) stats_num_field('bytes allocated', [(wordsize(32), 45648, 5), - # expected value: 45648 (x86/Linux) + # expected value: 50520 (x86/Linux) (wordsize(64), 49400, 5)]), - # expected value: 49400 (amd64/Linux) + # prev: 49400 (amd64/Linux) + # 2014-07-17: 50520 (amd64/Linux) general round of updates only_ways(['normal']) ], compile_and_run, @@ -153,8 +156,9 @@ test('T5205', [stats_num_field('bytes allocated', [(wordsize(32), 47088, 5), # expected value: 47088 (x86/Darwin) - (wordsize(64), 51320, 5)]), + (wordsize(64), 52600, 5)]), # expected value: 51320 (amd64/Linux) + # 2014-07-17: 52600 (amd64/Linux) general round of updates only_ways(['normal', 'optasm']) ], compile_and_run, @@ -252,8 +256,9 @@ test('Conversions', # 2013-02-10: 77472 (x86/OSX) # 2013-02-10: 79276 (x86/Windows) # 2014-01-13: 76768 (x86/Linux) due to #8647 - (wordsize(64), 110632, 5)]), + (wordsize(64), 107544, 5)]), # 2012-12-18: 109608 (amd64/OS X) + # 2014-07-17: 107544 (amd64/Linux) only_ways(['normal']) ], @@ -311,7 +316,7 @@ test('T7850', test('T5949', [stats_num_field('bytes allocated', - [ (wordsize(32), 101000, 10), + [ (wordsize(32), 116020, 10), (wordsize(64), 201008, 10)]), # previously, it was >400000 bytes only_ways(['normal'])], @@ -320,7 +325,8 @@ test('T5949', test('T4267', [stats_num_field('bytes allocated', - [ (wordsize(32), 20992, 10) + [ (wordsize(32), 36012, 10) + # 32-bit value close to 64 bit; c.f. T7619 , (wordsize(64), 40992, 10) ]), # previously, it was >170000 bytes # 2014-01-17: 130000 @@ -331,7 +337,9 @@ test('T4267', test('T7619', [stats_num_field('bytes allocated', - [ (wordsize(32), 20992, 10) + [ (wordsize(32), 36012, 10) + # 32-bit close to 64-bit value; most of this very + # small number is standard start-up boilerplate I think , (wordsize(64), 40992, 10) ]), # previously, it was >400000 bytes only_ways(['normal'])], @@ -348,8 +356,10 @@ test('InlineArrayAlloc', test('InlineByteArrayAlloc', [stats_num_field('bytes allocated', - [ (wordsize(32), 720040960, 5) + [ (wordsize(32), 1360036012, 5) , (wordsize(64), 1440040960, 5) ]), + # 32 and 64 bit not so different, because + # we are allocating *byte* arrays only_ways(['normal'])], compile_and_run, ['-O2']) @@ -361,3 +371,11 @@ test('InlineCloneArrayAlloc', only_ways(['normal'])], compile_and_run, ['-O2']) + +test('T9203', + [stats_num_field('bytes allocated', + [ (wordsize(32), 50000000, 5) + , (wordsize(64), 95747304, 5) ]), + only_ways(['normal'])], + compile_and_run, + ['-O2']) diff --git a/testsuite/tests/polykinds/Makefile b/testsuite/tests/polykinds/Makefile index aa8b482b73..8636bb959f 100644 --- a/testsuite/tests/polykinds/Makefile +++ b/testsuite/tests/polykinds/Makefile @@ -38,3 +38,9 @@ T8449: $(RM) -f T8449.hi T8449.o T8449a.hi T8449a.o '$(TEST_HC)' $(TEST_HC_OPTS) -c T8449a.hs '$(TEST_HC)' $(TEST_HC_OPTS) -c T8449.hs + +T9263: + $(RM) -f T9263.hi T9263.o T9263a.hi T9263a.o T9263b.hi T9263b.o + '$(TEST_HC)' $(TEST_HC_OPTS) -c T9263b.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -c T9263a.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -c T9263.hs diff --git a/testsuite/tests/polykinds/T7230.stderr b/testsuite/tests/polykinds/T7230.stderr index 7e1a7ab88f..0c34249223 100644 --- a/testsuite/tests/polykinds/T7230.stderr +++ b/testsuite/tests/polykinds/T7230.stderr @@ -7,13 +7,13 @@ T7230.hs:48:32: at T7230.hs:47:10-68 or from (xs ~ (x : xs1)) bound by a pattern with constructor - SCons :: forall (x :: k) (xs :: [k]). + SCons :: forall (k :: BOX) (x :: k) (xs :: [k]). Sing x -> Sing xs -> Sing (x : xs), in an equation for ‘crash’ at T7230.hs:48:8-27 or from (xs1 ~ (x1 : xs2)) bound by a pattern with constructor - SCons :: forall (x :: k) (xs :: [k]). + SCons :: forall (k :: BOX) (x :: k) (xs :: [k]). Sing x -> Sing xs -> Sing (x : xs), in an equation for ‘crash’ at T7230.hs:48:17-26 diff --git a/testsuite/tests/polykinds/T7278.stderr b/testsuite/tests/polykinds/T7278.stderr index f24f9b2aad..3d615c12f7 100644 --- a/testsuite/tests/polykinds/T7278.stderr +++ b/testsuite/tests/polykinds/T7278.stderr @@ -2,4 +2,4 @@ T7278.hs:8:43: ‘t’ is applied to too many type arguments In the type signature for ‘f’: - f :: C (t :: k) (TF t) => TF t p1 p0 -> t p1 p0 + f :: (C (t :: k) (TF t)) => TF t p1 p0 -> t p1 p0 diff --git a/testsuite/tests/polykinds/T7438.stderr b/testsuite/tests/polykinds/T7438.stderr index b126621ce1..b84465545f 100644 --- a/testsuite/tests/polykinds/T7438.stderr +++ b/testsuite/tests/polykinds/T7438.stderr @@ -1,19 +1,19 @@ - -T7438.hs:6:14: - Couldn't match expected type ‘t1’ with actual type ‘t’ - ‘t’ is untouchable - inside the constraints (t2 ~ t3) - bound by a pattern with constructor - Nil :: forall (a :: k). Thrist a a, - in an equation for ‘go’ - at T7438.hs:6:4-6 - ‘t’ is a rigid type variable bound by - the inferred type of go :: Thrist t2 t3 -> t -> t1 at T7438.hs:6:1 - ‘t1’ is a rigid type variable bound by - the inferred type of go :: Thrist t2 t3 -> t -> t1 at T7438.hs:6:1 - Possible fix: add a type signature for ‘go’ - Relevant bindings include - acc :: t (bound at T7438.hs:6:8) - go :: Thrist t2 t3 -> t -> t1 (bound at T7438.hs:6:1) - In the expression: acc - In an equation for ‘go’: go Nil acc = acc +
+T7438.hs:6:14:
+ Couldn't match expected type ‘t1’ with actual type ‘t’
+ ‘t’ is untouchable
+ inside the constraints (t2 ~ t3)
+ bound by a pattern with constructor
+ Nil :: forall (k :: BOX) (b :: k). Thrist b b,
+ in an equation for ‘go’
+ at T7438.hs:6:4-6
+ ‘t’ is a rigid type variable bound by
+ the inferred type of go :: Thrist t2 t3 -> t -> t1 at T7438.hs:6:1
+ ‘t1’ is a rigid type variable bound by
+ the inferred type of go :: Thrist t2 t3 -> t -> t1 at T7438.hs:6:1
+ Possible fix: add a type signature for ‘go’
+ Relevant bindings include
+ acc :: t (bound at T7438.hs:6:8)
+ go :: Thrist t2 t3 -> t -> t1 (bound at T7438.hs:6:1)
+ In the expression: acc
+ In an equation for ‘go’: go Nil acc = acc
diff --git a/testsuite/tests/polykinds/T7939a.stderr b/testsuite/tests/polykinds/T7939a.stderr index 09b818a5b5..22388ddca0 100644 --- a/testsuite/tests/polykinds/T7939a.stderr +++ b/testsuite/tests/polykinds/T7939a.stderr @@ -4,4 +4,4 @@ T7939a.hs:7:5: The first argument of ‘F’ should have kind ‘*’, but ‘Maybe’ has kind ‘* -> *’ In the type ‘Maybe’ - In the family declaration for ‘F’ + In the type family declaration for ‘F’ diff --git a/testsuite/tests/polykinds/T8566.stderr b/testsuite/tests/polykinds/T8566.stderr index 4638fd8c4d..ad0d15e69c 100644 --- a/testsuite/tests/polykinds/T8566.stderr +++ b/testsuite/tests/polykinds/T8566.stderr @@ -6,7 +6,8 @@ T8566.hs:31:9: bound by the instance declaration at T8566.hs:29:10-67 or from ('AA t (a : as) ~ 'AA t1 as1) bound by a pattern with constructor - A :: forall (r :: [*]) (t :: k) (as :: [U *]). I ('AA t as) r, + A :: forall (r :: [*]) (k :: BOX) (t :: k) (as :: [U *]). + I ('AA t as) r, in an equation for ‘c’ at T8566.hs:31:5 The type variable ‘fs0’ is ambiguous diff --git a/testsuite/tests/polykinds/T9063.hs b/testsuite/tests/polykinds/T9063.hs new file mode 100644 index 0000000000..007f475c06 --- /dev/null +++ b/testsuite/tests/polykinds/T9063.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, TypeOperators, + UndecidableInstances #-} + +module T9063 where + +import Data.Type.Equality +import Data.Proxy + +class kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where + type (:==) (x :: a) (y :: a) :: Bool + type x :== y = x == y + +instance PEq ('KProxy :: KProxy Bool) + +foo :: Proxy (True :== True) -> Proxy (True == True) +foo = id diff --git a/testsuite/tests/polykinds/T9106.hs b/testsuite/tests/polykinds/T9106.hs new file mode 100644 index 0000000000..eaf0364235 --- /dev/null +++ b/testsuite/tests/polykinds/T9106.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE MultiParamTypeClasses, DataKinds, FunctionalDependencies, + KindSignatures, PolyKinds, FlexibleInstances, FlexibleContexts, + UndecidableInstances #-} + +module T9106 where + +import GHC.TypeLits + +class FunctorN (n :: Nat) f (a :: *) (fa :: *) | n f a -> fa where + +instance FunctorN 0 f a a where + +instance FunctorN n f a (f fa) + diff --git a/testsuite/tests/polykinds/T9106.stderr b/testsuite/tests/polykinds/T9106.stderr new file mode 100644 index 0000000000..0b239f2ea4 --- /dev/null +++ b/testsuite/tests/polykinds/T9106.stderr @@ -0,0 +1,8 @@ + +T9106.hs:13:10: + Illegal instance declaration for ‘FunctorN n f a (f fa)’ + The liberal coverage condition fails in class ‘FunctorN’ + for functional dependency: ‘n f a -> fa’ + Reason: lhs types ‘n’, ‘f’, ‘a’ + do not jointly determine rhs type ‘f fa’ + In the instance declaration for ‘FunctorN n f a (f fa)’ diff --git a/testsuite/tests/polykinds/T9144.hs b/testsuite/tests/polykinds/T9144.hs new file mode 100644 index 0000000000..0a9ef08afa --- /dev/null +++ b/testsuite/tests/polykinds/T9144.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, GADTs, RankNTypes #-} + +module T9144 where + +import Data.Proxy +import GHC.TypeLits + +data family Sing (a :: k) + +data SomeSing :: KProxy k -> * where + SomeSing :: forall (a :: k). Sing a -> SomeSing ('KProxy :: KProxy k) + +class kproxy ~ 'KProxy => SingKind (kproxy :: KProxy k) where + fromSing :: forall (a :: k). Sing a -> DemoteRep ('KProxy :: KProxy k) + toSing :: DemoteRep ('KProxy :: KProxy k) -> SomeSing ('KProxy :: KProxy k) + +type family DemoteRep (kproxy :: KProxy k) :: * + +data Foo = Bar Nat +data FooTerm = BarTerm Integer + +data instance Sing (x :: Foo) where + SBar :: Sing n -> Sing (Bar n) + +type instance DemoteRep ('KProxy :: KProxy Nat) = Integer +type instance DemoteRep ('KProxy :: KProxy Foo) = FooTerm + +instance SingKind ('KProxy :: KProxy Nat) where + fromSing = undefined + toSing = undefined + +instance SingKind ('KProxy :: KProxy Foo) where + fromSing (SBar n) = BarTerm (fromSing n) + toSing n = case toSing n of SomeSing n' -> SomeSing (SBar n') diff --git a/testsuite/tests/polykinds/T9144.stderr b/testsuite/tests/polykinds/T9144.stderr new file mode 100644 index 0000000000..f2c65530ee --- /dev/null +++ b/testsuite/tests/polykinds/T9144.stderr @@ -0,0 +1,7 @@ +
+T9144.hs:34:26:
+ Couldn't match type ‘Integer’ with ‘FooTerm’
+ Expected type: DemoteRep 'KProxy
+ Actual type: DemoteRep 'KProxy
+ In the first argument of ‘toSing’, namely ‘n’
+ In the expression: toSing n
diff --git a/testsuite/tests/polykinds/T9222.hs b/testsuite/tests/polykinds/T9222.hs new file mode 100644 index 0000000000..df112519ac --- /dev/null +++ b/testsuite/tests/polykinds/T9222.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes, GADTs, DataKinds, PolyKinds, TypeOperators, TypeFamilies #-} +module T9222 where + +import Data.Proxy + +data Want :: (i,j) -> * where + Want :: (a ~ '(b,c) => Proxy b) -> Want a diff --git a/testsuite/tests/polykinds/T9263.hs b/testsuite/tests/polykinds/T9263.hs new file mode 100644 index 0000000000..e913e1f653 --- /dev/null +++ b/testsuite/tests/polykinds/T9263.hs @@ -0,0 +1,2 @@ +module T9263 where + import T9263a diff --git a/testsuite/tests/polykinds/T9263a.hs b/testsuite/tests/polykinds/T9263a.hs new file mode 100644 index 0000000000..1cecabad38 --- /dev/null +++ b/testsuite/tests/polykinds/T9263a.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds, KindSignatures, TypeFamilies #-} +module T9263a where + +import T9263b +import Data.Proxy + +data Void + +instance PEq ('KProxy :: KProxy Void) diff --git a/testsuite/tests/polykinds/T9263b.hs b/testsuite/tests/polykinds/T9263b.hs new file mode 100644 index 0000000000..d267eaca79 --- /dev/null +++ b/testsuite/tests/polykinds/T9263b.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-} +module T9263b where + +import Data.Proxy + +class kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where + type F (x :: a) :: Bool + type F (x :: a) = False diff --git a/testsuite/tests/polykinds/T9264.hs b/testsuite/tests/polykinds/T9264.hs new file mode 100644 index 0000000000..df75599e56 --- /dev/null +++ b/testsuite/tests/polykinds/T9264.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PolyKinds, TypeFamilies, ScopedTypeVariables #-} +module T9264 where + +class C (a :: k) where + type F (a :: k) + type F (a :: k) = Int diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 3634d83537..22a159d50e 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -100,3 +100,9 @@ test('T8566a', expect_broken(8566), compile,['']) test('T7481', normal, compile_fail,['']) test('T8705', normal, compile, ['']) test('T8985', normal, compile, ['']) +test('T9106', normal, compile_fail, ['']) +test('T9144', normal, compile_fail, ['']) +test('T9222', normal, compile, ['']) +test('T9264', normal, compile, ['']) +test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) +test('T9063', normal, compile, ['']) diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 493c846bc7..ac70b9f643 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -25,7 +25,7 @@ test('T3001-2', test('scc001', [req_profiling, extra_ways(['prof']), only_ways(prof_ways)], compile_and_run, - ['-fno-state-hack']) # Note [consistent stacks] + ['-fno-state-hack -fno-full-laziness']) # Note [consistent stacks] test('scc002', [req_profiling, extra_ways(['prof']), only_ways(prof_ways)], diff --git a/testsuite/tests/profiling/should_run/ioprof.prof.sample b/testsuite/tests/profiling/should_run/ioprof.prof.sample index 0cdfa82f48..07257e2dfe 100644 --- a/testsuite/tests/profiling/should_run/ioprof.prof.sample +++ b/testsuite/tests/profiling/should_run/ioprof.prof.sample @@ -1,39 +1,37 @@ - Mon Nov 14 13:28 2011 Time and Allocation Profiling Report (Final) + Mon Apr 28 15:29 2014 Time and Allocation Profiling Report (Final) ioprof +RTS -hc -p -RTS - total time = 0.00 secs (0 ticks @ 20 ms) - total alloc = 53,288 bytes (excludes profiling overheads) + total time = 0.00 secs (0 ticks @ 1000 us, 1 processor) + total alloc = 52,208 bytes (excludes profiling overheads) COST CENTRE MODULE %time %alloc -main Main 0.0 16.4 -errorM.\ Main 0.0 8.3 -CAF GHC.IO.Handle.FD 0.0 65.5 +MAIN MAIN 0.0 1.4 +CAF GHC.IO.Encoding 0.0 6.3 CAF GHC.Conc.Signal 0.0 1.3 -CAF GHC.IO.Encoding 0.0 5.9 +CAF GHC.IO.Handle.FD 0.0 66.2 +main Main 0.0 16.7 +errorM.\ Main 0.0 7.0 - individual inherited -COST CENTRE MODULE no. entries %time %alloc %time %alloc + individual inherited +COST CENTRE MODULE no. entries %time %alloc %time %alloc -MAIN MAIN 45 0 0.0 0.7 0.0 100.0 - CAF GHC.IO.Encoding.Iconv 76 0 0.0 0.5 0.0 0.5 - CAF GHC.Conc.Sync 74 0 0.0 0.5 0.0 0.5 - CAF GHC.IO.Encoding 65 0 0.0 5.9 0.0 5.9 - CAF GHC.Conc.Signal 62 0 0.0 1.3 0.0 1.3 - CAF GHC.IO.Handle.FD 56 0 0.0 65.5 0.0 65.5 - CAF GHC.Exception 55 0 0.0 0.2 0.0 0.2 - CAF Main 51 0 0.0 0.6 0.0 25.6 - main Main 90 1 0.0 16.4 0.0 24.9 - runM Main 93 1 0.0 0.0 0.0 8.3 - bar Main 94 0 0.0 0.0 0.0 8.3 - foo Main 99 0 0.0 0.0 0.0 8.3 - errorM Main 100 0 0.0 0.0 0.0 8.3 - errorM.\ Main 101 1 0.0 8.3 0.0 8.3 - >>= Main 95 0 0.0 0.0 0.0 0.0 - >>=.\ Main 96 1 0.0 0.0 0.0 0.0 - bar Main 91 1 0.0 0.2 0.0 0.2 - foo Main 97 1 0.0 0.0 0.0 0.0 - errorM Main 98 1 0.0 0.0 0.0 0.0 - >>= Main 92 1 0.0 0.0 0.0 0.0 +MAIN MAIN 44 0 0.0 1.4 0.0 100.0 + main Main 89 0 0.0 16.5 0.0 16.5 + CAF Main 87 0 0.0 0.0 0.0 7.4 + main Main 88 1 0.0 0.2 0.0 7.4 + runM Main 90 1 0.0 0.2 0.0 7.2 + bar Main 91 1 0.0 0.0 0.0 7.1 + errorM Main 93 1 0.0 0.0 0.0 0.0 + >>= Main 92 1 0.0 0.0 0.0 7.0 + >>=.\ Main 94 1 0.0 0.0 0.0 7.0 + foo Main 95 1 0.0 0.0 0.0 7.0 + errorM Main 96 0 0.0 0.0 0.0 7.0 + errorM.\ Main 97 1 0.0 7.0 0.0 7.0 + CAF GHC.IO.Handle.FD 84 0 0.0 66.2 0.0 66.2 + CAF GHC.Conc.Signal 82 0 0.0 1.3 0.0 1.3 + CAF GHC.Conc.Sync 81 0 0.0 0.4 0.0 0.4 + CAF GHC.IO.Encoding 74 0 0.0 6.3 0.0 6.3 + CAF GHC.IO.Encoding.Iconv 56 0 0.0 0.4 0.0 0.4 diff --git a/testsuite/tests/rename/should_compile/T9127.hs b/testsuite/tests/rename/should_compile/T9127.hs new file mode 100644 index 0000000000..c8e827f888 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T9127.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE BangPatterns #-} +module T9127 where + +f = let !_ = 2 * 2 + in 2*2 diff --git a/testsuite/tests/rename/should_compile/T9127.stderr b/testsuite/tests/rename/should_compile/T9127.stderr new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T9127.stderr diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 0ce4ca125d..4ed92bd328 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -214,3 +214,4 @@ test('T7969', 'T7969.imports'])], run_command, ['$MAKE -s --no-print-directory T7969']) +test('T9127', normal, compile, ['']) diff --git a/testsuite/tests/rename/should_fail/T9177.hs b/testsuite/tests/rename/should_fail/T9177.hs new file mode 100644 index 0000000000..9fbb9407be --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9177.hs @@ -0,0 +1,17 @@ +module T9177 where + +-- the main use case +type Foo = (int) + +-- other interesting cases +type Foo2 = (integerr) + +foo3 = bar +foo4 = Fun + +-- this warning is suboptimal (fun would be illegal here) +foo5 Fun = () + +-- No errors here: +data Bar = Bar +fun x = x diff --git a/testsuite/tests/rename/should_fail/T9177.stderr b/testsuite/tests/rename/should_fail/T9177.stderr new file mode 100644 index 0000000000..624034053f --- /dev/null +++ b/testsuite/tests/rename/should_fail/T9177.stderr @@ -0,0 +1,20 @@ + +T9177.hs:4:13: + Not in scope: type variable ‘int’ + Perhaps you meant type constructor or class ‘Int’ (imported from Prelude) + +T9177.hs:7:14: + Not in scope: type variable ‘integerr’ + Perhaps you meant type constructor or class ‘Integer’ (imported from Prelude) + +T9177.hs:9:8: + Not in scope: ‘bar’ + Perhaps you meant data constructor ‘Bar’ (line 16) + +T9177.hs:10:8: + Not in scope: data constructor ‘Fun’ + Perhaps you meant variable ‘fun’ (line 17) + +T9177.hs:13:6: + Not in scope: data constructor ‘Fun’ + Perhaps you meant variable ‘fun’ (line 17) diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index f4c3570d3d..0f60ff6175 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -114,3 +114,4 @@ test('T8448', normal, compile_fail, ['']) test('T9006', extra_clean(['T9006a.hi', 'T9006a.o']), multimod_compile_fail, ['T9006', '-v0']) +test('T9177', normal, compile_fail, ['']) diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr index 99ed2d6f12..c7b51a1d1f 100644 --- a/testsuite/tests/rename/should_fail/rnfail055.stderr +++ b/testsuite/tests/rename/should_fail/rnfail055.stderr @@ -20,8 +20,8 @@ RnFail055.hs-boot:6:1: RnFail055.hs-boot:8:1: Type constructor ‘S2’ has conflicting definitions in the module and its hs-boot file - Main module: type S2 a b = forall a. (a, b) - Boot file: type S2 a b = forall b. (a, b) + Main module: type S2 a b = forall a1. (a1, b) + Boot file: type S2 a b = forall b1. (a, b1) RnFail055.hs-boot:12:1: Type constructor ‘T1’ has conflicting definitions in the module @@ -33,9 +33,11 @@ RnFail055.hs-boot:14:1: Type constructor ‘T2’ has conflicting definitions in the module and its hs-boot file Main module: type role T2 representational nominal - data Eq b => T2 a b = T2 a + data Eq b => T2 a b + = T2 a Boot file: type role T2 nominal representational - data Eq a => T2 a b = T2 a + data Eq a => T2 a b + = T2 a RnFail055.hs-boot:16:11: T3 is exported by the hs-boot file, but not exported by the module @@ -60,7 +62,7 @@ RnFail055.hs-boot:25:1: and its hs-boot file Main module: type role T7 phantom data T7 a where - T7 :: a -> T7 a + T7 :: a1 -> T7 a Boot file: data T7 a = T7 a RnFail055.hs-boot:27:22: diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr index cd027f13f2..96d5603bbf 100644 --- a/testsuite/tests/roles/should_compile/Roles1.stderr +++ b/testsuite/tests/roles/should_compile/Roles1.stderr @@ -1,54 +1,20 @@ TYPE SIGNATURES TYPE CONSTRUCTORS - T1 :: * -> * - data T1 a - No C type associated - Roles: [nominal] - RecFlag NonRecursive, Promotable - = K1 :: forall a. a -> T1 a Stricts: _ - FamilyInstance: none - T2 :: * -> * - data T2 a - No C type associated - Roles: [representational] - RecFlag NonRecursive, Promotable - = K2 :: forall a. a -> T2 a Stricts: _ - FamilyInstance: none - T3 :: k -> * - data T3 (k::BOX) (a::k) - No C type associated - Roles: [nominal, phantom] - RecFlag NonRecursive, Not promotable - = K3 :: forall (k::BOX) (a::k). T3 k a - FamilyInstance: none - T4 :: (* -> *) -> * -> * - data T4 (a::* -> *) b - No C type associated - Roles: [nominal, nominal] - RecFlag NonRecursive, Not promotable - = K4 :: forall (a::* -> *) b. (a b) -> T4 a b Stricts: _ - FamilyInstance: none - T5 :: * -> * - data T5 a - No C type associated - Roles: [representational] - RecFlag NonRecursive, Promotable - = K5 :: forall a. a -> T5 a Stricts: _ - FamilyInstance: none - T6 :: k -> * - data T6 (k::BOX) (a::k) - No C type associated - Roles: [nominal, phantom] - RecFlag NonRecursive, Not promotable - = K6 :: forall (k::BOX) (a::k). T6 k a - FamilyInstance: none - T7 :: k -> * -> * - data T7 (k::BOX) (a::k) b - No C type associated - Roles: [nominal, phantom, representational] - RecFlag NonRecursive, Not promotable - = K7 :: forall (k::BOX) (a::k) b. b -> T7 k a b Stricts: _ - FamilyInstance: none + type role T1 nominal + data T1 a = K1 a + Promotable + data T2 a = K2 a + Promotable + type role T3 phantom + data T3 (a :: k) = K3 + type role T4 nominal nominal + data T4 (a :: * -> *) b = K4 (a b) + data T5 a = K5 a + Promotable + type role T6 phantom + data T6 (a :: k) = K6 + type role T7 phantom representational + data T7 (a :: k) b = K7 b COERCION AXIOMS Dependent modules: [] Dependent packages: [base, ghc-prim, integer-gmp] diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr index 647e59ba51..b0dda24f2c 100644 --- a/testsuite/tests/roles/should_compile/Roles13.stderr +++ b/testsuite/tests/roles/should_compile/Roles13.stderr @@ -13,8 +13,7 @@ Roles13.convert = `cast` (<Roles13.Wrap Roles13.Age>_R -> Roles13.NTCo:Wrap[0] Roles13.NTCo:Age[0] :: (Roles13.Wrap Roles13.Age -> Roles13.Wrap Roles13.Age) - ~# - (Roles13.Wrap Roles13.Age -> GHC.Types.Int)) + ~R# (Roles13.Wrap Roles13.Age -> GHC.Types.Int)) diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr index 13231931e3..e0f26a14d3 100644 --- a/testsuite/tests/roles/should_compile/Roles14.stderr +++ b/testsuite/tests/roles/should_compile/Roles14.stderr @@ -1,9 +1,7 @@ TYPE SIGNATURES TYPE CONSTRUCTORS - C2 :: * -> Constraint - class C2 a - Roles: [representational] - RecFlag NonRecursive + type role C2 representational + class C2 a where meth2 :: a -> a COERCION AXIOMS axiom Roles12.NTCo:C2 :: C2 a = a -> a diff --git a/testsuite/tests/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr index f5bcbe6829..2c7ab6c66f 100644 --- a/testsuite/tests/roles/should_compile/Roles2.stderr +++ b/testsuite/tests/roles/should_compile/Roles2.stderr @@ -1,19 +1,8 @@ TYPE SIGNATURES TYPE CONSTRUCTORS - T1 :: * -> * - data T1 a - No C type associated - Roles: [representational] - RecFlag NonRecursive, Not promotable - = K1 :: forall a. (IO a) -> T1 a Stricts: _ - FamilyInstance: none - T2 :: * -> * - data T2 a - No C type associated - Roles: [representational] - RecFlag NonRecursive, Not promotable - = K2 :: forall a. (FunPtr a) -> T2 a Stricts: _ - FamilyInstance: none + data T1 a = K1 (IO a) + type role T2 phantom + data T2 a = K2 (FunPtr a) COERCION AXIOMS Dependent modules: [] Dependent packages: [base, ghc-prim, integer-gmp] diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index 62eb2a9474..270afca9cd 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -1,31 +1,16 @@ TYPE SIGNATURES TYPE CONSTRUCTORS - C1 :: * -> Constraint - class C1 a - Roles: [nominal] - RecFlag NonRecursive + class C1 a where meth1 :: a -> a - C2 :: * -> * -> Constraint - class C2 a b - Roles: [nominal, nominal] - RecFlag NonRecursive - meth2 :: (~) * a b -> a -> b - C3 :: * -> * -> Constraint - class C3 a b - Roles: [nominal, nominal] - RecFlag NonRecursive - type family F3 b :: * (open) + class C2 a b where + meth2 :: a ~ b => a -> b + class C3 a b where + type family F3 b :: * open meth3 :: a -> F3 b -> F3 b - C4 :: * -> * -> Constraint - class C4 a b - Roles: [nominal, nominal] - RecFlag NonRecursive + class C4 a b where meth4 :: a -> F4 b -> F4 b - F4 :: * -> * - type family F4 a :: * (open) - Syn1 :: * -> * + type family F4 a :: * open type Syn1 a = F4 a - Syn2 :: * -> * type Syn2 a = [a] COERCION AXIOMS axiom Roles3.NTCo:C1 :: C1 a = a -> a diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr index 32862ea073..f2b590fadd 100644 --- a/testsuite/tests/roles/should_compile/Roles4.stderr +++ b/testsuite/tests/roles/should_compile/Roles4.stderr @@ -1,16 +1,9 @@ TYPE SIGNATURES TYPE CONSTRUCTORS - C1 :: * -> Constraint - class C1 a - Roles: [nominal] - RecFlag NonRecursive + class C1 a where meth1 :: a -> a - C3 :: * -> Constraint - class C3 a - Roles: [nominal] - RecFlag NonRecursive + class C3 a where meth3 :: a -> Syn1 a - Syn1 :: * -> * type Syn1 a = [a] COERCION AXIOMS axiom Roles4.NTCo:C1 :: C1 a = a -> a diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr index 919530bb03..d400b9190c 100644 --- a/testsuite/tests/roles/should_compile/T8958.stderr +++ b/testsuite/tests/roles/should_compile/T8958.stderr @@ -1,49 +1,40 @@ -
-T8958.hs:1:31: Warning:
- -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
-TYPE SIGNATURES
-TYPE CONSTRUCTORS
- Map :: * -> * -> *
- newtype (Nominal k, Representational v) => Map k v
- No C type associated
- Roles: [nominal, representational]
- RecFlag NonRecursive, Promotable
- = MkMap :: [(k, v)] -> Map k v Stricts: _
- FamilyInstance: none
- Nominal :: * -> Constraint
- class Nominal a
- Roles: [nominal]
- RecFlag NonRecursive
- Representational :: * -> Constraint
- class Representational a
- Roles: [representational]
- RecFlag NonRecursive
-COERCION AXIOMS
- axiom T8958.NTCo:Map :: Map k v = [(k, v)]
-INSTANCES
- instance [incoherent] Representational a
- -- Defined at T8958.hs:10:10
- instance [incoherent] Nominal a -- Defined at T8958.hs:7:10
-Dependent modules: []
-Dependent packages: [base, ghc-prim, integer-gmp]
-
-==================== Typechecker ====================
-AbsBinds [a] []
- {Exports: [T8958.$fRepresentationala <= $dRepresentational
- <>]
- Exported types: T8958.$fRepresentationala [InlPrag=[ALWAYS] CONLIKE]
- :: forall a. Representational a
- [LclIdX[DFunId],
- Str=DmdType,
- Unf=DFun: \ (@ a) -> T8958.D:Representational TYPE a]
- Binds: $dRepresentational = T8958.D:Representational}
-AbsBinds [a] []
- {Exports: [T8958.$fNominala <= $dNominal
- <>]
- Exported types: T8958.$fNominala [InlPrag=[ALWAYS] CONLIKE]
- :: forall a. Nominal a
- [LclIdX[DFunId],
- Str=DmdType,
- Unf=DFun: \ (@ a) -> T8958.D:Nominal TYPE a]
- Binds: $dNominal = T8958.D:Nominal}
-
+ +T8958.hs:1:31: Warning: + -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. +TYPE SIGNATURES +TYPE CONSTRUCTORS + type role Map nominal representational + newtype (Nominal k, Representational v) => Map k v = MkMap [(k, v)] + Promotable + class Nominal a + type role Representational representational + class Representational a +COERCION AXIOMS + axiom T8958.NTCo:Map :: Map k v = [(k, v)] +INSTANCES + instance [incoherent] Representational a + -- Defined at T8958.hs:10:10 + instance [incoherent] Nominal a -- Defined at T8958.hs:7:10 +Dependent modules: [] +Dependent packages: [base, ghc-prim, integer-gmp] + +==================== Typechecker ==================== +AbsBinds [a] [] + {Exports: [T8958.$fRepresentationala <= $dRepresentational + <>] + Exported types: T8958.$fRepresentationala [InlPrag=[ALWAYS] CONLIKE] + :: forall a. Representational a + [LclIdX[DFunId], + Str=DmdType, + Unf=DFun: \ (@ a) -> T8958.D:Representational TYPE a] + Binds: $dRepresentational = T8958.D:Representational} +AbsBinds [a] [] + {Exports: [T8958.$fNominala <= $dNominal + <>] + Exported types: T8958.$fNominala [InlPrag=[ALWAYS] CONLIKE] + :: forall a. Nominal a + [LclIdX[DFunId], + Str=DmdType, + Unf=DFun: \ (@ a) -> T8958.D:Nominal TYPE a] + Binds: $dNominal = T8958.D:Nominal} + diff --git a/testsuite/tests/roles/should_fail/Roles12.stderr b/testsuite/tests/roles/should_fail/Roles12.stderr index bb830beae3..9b0f2cfdb5 100644 --- a/testsuite/tests/roles/should_fail/Roles12.stderr +++ b/testsuite/tests/roles/should_fail/Roles12.stderr @@ -4,4 +4,4 @@ Roles12.hs:5:1: and its hs-boot file Main module: type role T phantom data T a - Boot file: data T a + Boot file: abstract T a diff --git a/testsuite/tests/rts/T9045.hs b/testsuite/tests/rts/T9045.hs new file mode 100644 index 0000000000..1e581efa35 --- /dev/null +++ b/testsuite/tests/rts/T9045.hs @@ -0,0 +1,22 @@ +-- This is nofib/smp/threads006. It fails in GHC 7.8.2 with a GC crash. + +{-# OPTIONS_GHC -O2 #-} +import System.IO +import System.Environment +import System.CPUTime +import Text.Printf +import Control.Monad +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Exception + +main :: IO () +main = do + hSetBuffering stdout NoBuffering + [nthreads] <- fmap (map read) getArgs + tids <- replicateM nthreads . mask $ \_ -> forkIO $ return () + m <- newEmptyMVar + -- do it in a subthread to avoid bound-thread overhead + forkIO $ do mapM_ killThread tids; putMVar m () + takeMVar m + return () diff --git a/testsuite/tests/rts/T9078.hs b/testsuite/tests/rts/T9078.hs new file mode 100644 index 0000000000..d0389f1330 --- /dev/null +++ b/testsuite/tests/rts/T9078.hs @@ -0,0 +1,10 @@ +module Main where + +import Control.Monad +import System.Mem.StableName + +main :: IO () +main = replicateM_ 500000 (makeStableName foo) + +foo :: Int +foo = 1 diff --git a/testsuite/tests/rts/T9078.stderr b/testsuite/tests/rts/T9078.stderr new file mode 100644 index 0000000000..901a1ca49c --- /dev/null +++ b/testsuite/tests/rts/T9078.stderr @@ -0,0 +1,2 @@ +cap 0: initialised +cap 0: shutting down diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 9239f44a21..d7c74c5847 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -222,3 +222,16 @@ test('T8124', [ only_ways(threaded_ways), omit_ways(['ghci']), # T8124_stub.h before compiling T8124_c.c, which # needs it. compile_and_run, ['T8124_c.c -no-hs-main']) + +# +RTS -A8k makes it fail faster +# The ghci way gets confused by the RTS options +test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], compile_and_run, ['']) + +# I couldn't reproduce 9078 with the -threaded runtime, but could easily +# with the non-threaded one. +test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) + +# 251 = RTS exit code for "out of memory" +test('overflow1', [ exit_code(251) ], compile_and_run, ['']) +test('overflow2', [ exit_code(251) ], compile_and_run, ['']) +test('overflow3', [ exit_code(251) ], compile_and_run, ['']) diff --git a/testsuite/tests/rts/exec_signals_prepare.c b/testsuite/tests/rts/exec_signals_prepare.c index 26f30acc57..2b01dd5d1c 100644 --- a/testsuite/tests/rts/exec_signals_prepare.c +++ b/testsuite/tests/rts/exec_signals_prepare.c @@ -2,6 +2,7 @@ #include <stdio.h> #include <errno.h> #include <string.h> +#include <unistd.h> // Invokes a process, making sure that the state of the signal // handlers has all been set back to the unix default. diff --git a/testsuite/tests/rts/overflow1.hs b/testsuite/tests/rts/overflow1.hs new file mode 100644 index 0000000000..63ed5a4e02 --- /dev/null +++ b/testsuite/tests/rts/overflow1.hs @@ -0,0 +1,11 @@ +module Main where + +import Data.Array.IO +import Data.Word + +-- Try to overflow BLOCK_ROUND_UP in the computation of req_blocks in allocate() +-- Here we invoke allocate() via newByteArray# and the array package. +-- Request a number of bytes close to HS_WORD_MAX, +-- subtracting a few words for overhead in newByteArray#. +-- Allocate Word32s (rather than Word8s) to get around bounds-checking in array. +main = newArray (0,maxBound `div` 4 - 10) 0 :: IO (IOUArray Word Word32) diff --git a/testsuite/tests/rts/overflow1.stderr b/testsuite/tests/rts/overflow1.stderr new file mode 100644 index 0000000000..734ca954ca --- /dev/null +++ b/testsuite/tests/rts/overflow1.stderr @@ -0,0 +1 @@ +overflow1: out of memory diff --git a/testsuite/tests/rts/overflow2.hs b/testsuite/tests/rts/overflow2.hs new file mode 100644 index 0000000000..ac72158f45 --- /dev/null +++ b/testsuite/tests/rts/overflow2.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign + +-- Test allocate(), the easy way. +data Cap = Cap +foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap) +foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ()) + +-- Number of words n such that n * sizeof(W_) exactly overflows a word +-- (2^30 on a 32-bit system, 2^61 on a 64-bit system) +overflowWordCount :: Word +overflowWordCount = fromInteger $ + (fromIntegral (maxBound :: Word) + 1) `div` + fromIntegral (sizeOf (undefined :: Word)) + +main = do + cap <- myCapability + allocate cap (overflowWordCount - 1) diff --git a/testsuite/tests/rts/overflow2.stderr b/testsuite/tests/rts/overflow2.stderr new file mode 100644 index 0000000000..be65509ea9 --- /dev/null +++ b/testsuite/tests/rts/overflow2.stderr @@ -0,0 +1 @@ +overflow2: out of memory diff --git a/testsuite/tests/rts/overflow3.hs b/testsuite/tests/rts/overflow3.hs new file mode 100644 index 0000000000..31dfd5db53 --- /dev/null +++ b/testsuite/tests/rts/overflow3.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign + +-- Test allocate(), the easy way. +data Cap = Cap +foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap) +foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ()) + +-- Number of words n such that n * sizeof(W_) exactly overflows a word +-- (2^30 on a 32-bit system, 2^61 on a 64-bit system) +overflowWordCount :: Word +overflowWordCount = fromInteger $ + (fromIntegral (maxBound :: Word) + 1) `div` + fromIntegral (sizeOf (undefined :: Word)) + +main = do + cap <- myCapability + allocate cap (overflowWordCount + 1) diff --git a/testsuite/tests/rts/overflow3.stderr b/testsuite/tests/rts/overflow3.stderr new file mode 100644 index 0000000000..6c804e5048 --- /dev/null +++ b/testsuite/tests/rts/overflow3.stderr @@ -0,0 +1 @@ +overflow3: out of memory diff --git a/testsuite/tests/simplCore/should_compile/T4201.stdout b/testsuite/tests/simplCore/should_compile/T4201.stdout index ed519ed02f..6ff4692854 100644 --- a/testsuite/tests/simplCore/should_compile/T4201.stdout +++ b/testsuite/tests/simplCore/should_compile/T4201.stdout @@ -1,3 +1,3 @@ - {- Arity: 1, HasNoCafRefs, Strictness: <S,1*U()>m, - Unfolding: InlineRule (0, True, True) - Eta.bof `cast` (Sym (Eta.NTCo:Foo[0]) ->_R <Eta.T>_R) -} + {- Arity: 1, HasNoCafRefs, Strictness: <S,1*U()>m, + Unfolding: InlineRule (0, True, True) + Eta.bof `cast` (Sym (Eta.NTCo:Foo[0]) ->_R <Eta.T>_R) -} diff --git a/testsuite/tests/simplCore/should_compile/T4918.stdout b/testsuite/tests/simplCore/should_compile/T4918.stdout index c79b116f03..708be353c4 100644 --- a/testsuite/tests/simplCore/should_compile/T4918.stdout +++ b/testsuite/tests/simplCore/should_compile/T4918.stdout @@ -1,2 +1,2 @@ - {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'p') -} - {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'q') -} + {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'p') -} + {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'q') -} diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 616b6cc359..1ebc742f0f 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -198,7 +198,7 @@ test('T5996', ['$MAKE -s --no-print-directory T5996']) test('T8537', normal, compile, ['']) test('T8832', - extra_clean(['T8832.hi', 'T8832a.o']), + [when(wordsize(32), expect_fail), extra_clean(['T8832.hi', 'T8832a.o'])], run_command, ['$MAKE -s --no-print-directory T8832']) test('T8848', only_ways(['optasm']), compile, ['-ddump-rule-firings']) diff --git a/testsuite/tests/simplCore/should_compile/spec001.hs b/testsuite/tests/simplCore/should_compile/spec001.hs index f4b4dd0365..5a6fb039f4 100644 --- a/testsuite/tests/simplCore/should_compile/spec001.hs +++ b/testsuite/tests/simplCore/should_compile/spec001.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP, UnboxedTuples, MagicHash, StandaloneDeriving, DeriveDataTypeable #-} {-# OPTIONS_GHC -O #-} -{-# OPTIONS_GHC -fno-warn-amp #-} -- In GHC 6.4, compiling this module gave a Core Lint failure following the -- specialier, because a function was floated out that had a RULE that diff --git a/testsuite/tests/simplCore/should_run/T9128.hs b/testsuite/tests/simplCore/should_run/T9128.hs new file mode 100644 index 0000000000..73aa39b31b --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T9128.hs @@ -0,0 +1,12 @@ +module Main where + +newtype T a = MkT a + +-- Trac #9128: we treated x as absent!!!! + +f x = let {-# NOINLINE h #-} + h = case x of MkT g -> g + in + h (h (h (h (h (h True))))) + +main = print (f (MkT id)) diff --git a/testsuite/tests/simplCore/should_run/T9128.stdout b/testsuite/tests/simplCore/should_run/T9128.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T9128.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 530e4e58f2..e36fb00f0f 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -65,3 +65,5 @@ test('T7924', exit_code(1), compile_and_run, ['']) # Run this test *without* optimisation too test('T457', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, ['']) + +test('T9128', normal, compile_and_run, ['']) diff --git a/testsuite/tests/stranal/should_compile/T9208.hs b/testsuite/tests/stranal/should_compile/T9208.hs new file mode 100644 index 0000000000..bf7fb47729 --- /dev/null +++ b/testsuite/tests/stranal/should_compile/T9208.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE CPP, LambdaCase, BangPatterns, MagicHash, TupleSections, ScopedTypeVariables #-} +{-# OPTIONS_GHC -w #-} -- Suppress warnings for unimplemented methods + +{- | Evaluate Template Haskell splices on node.js, + using pipes to communicate with GHCJS + -} + +-- module GHCJS.Prim.TH.Eval +module Eval ( + runTHServer + ) where + +import Control.Applicative +import Control.Monad + +import Data.Binary +import Data.Binary.Get +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL + +import GHC.Prim + +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Syntax as TH + +import Unsafe.Coerce + +data THResultType = THExp | THPat | THType | THDec + +data Message + -- | GHCJS compiler to node.js requests + = RunTH THResultType ByteString TH.Loc + -- | node.js to GHCJS compiler responses + | RunTH' THResultType ByteString [TH.Dec] -- ^ serialized AST and additional toplevel declarations + +instance Binary THResultType where + put _ = return () + get = return undefined + +instance Binary Message where + put _ = return () + get = return undefined + +data QState = QState + +data GHCJSQ a = GHCJSQ { runGHCJSQ :: QState -> IO (a, QState) } + +instance Functor GHCJSQ where + fmap f (GHCJSQ s) = GHCJSQ $ fmap (\(x,s') -> (f x,s')) . s + +instance Applicative GHCJSQ where + f <*> a = GHCJSQ $ \s -> + do (f',s') <- runGHCJSQ f s + (a', s'') <- runGHCJSQ a s' + return (f' a', s'') + pure x = GHCJSQ (\s -> return (x,s)) + +instance Monad GHCJSQ where + (>>=) m f = GHCJSQ $ \s -> + do (m', s') <- runGHCJSQ m s + (a, s'') <- runGHCJSQ (f m') s' + return (a, s'') + return = pure + +instance TH.Quasi GHCJSQ where qRunIO m = GHCJSQ $ \s -> fmap (,s) m + +-- | the Template Haskell server +runTHServer :: IO () +runTHServer = void $ runGHCJSQ server QState + where + server = TH.qRunIO awaitMessage >>= \case + RunTH t code loc -> do + a <- TH.qRunIO $ loadTHData code + runTH t a loc + _ -> TH.qRunIO (putStrLn "warning: ignoring unexpected message type") + +runTH :: THResultType -> Any -> TH.Loc -> GHCJSQ () +runTH rt obj loc = do + res <- case rt of + THExp -> runTHCode (unsafeCoerce obj :: TH.Q TH.Exp) + THPat -> runTHCode (unsafeCoerce obj :: TH.Q TH.Pat) + THType -> runTHCode (unsafeCoerce obj :: TH.Q TH.Type) + THDec -> runTHCode (unsafeCoerce obj :: TH.Q [TH.Dec]) + TH.qRunIO (sendResult $ RunTH' rt res []) + +runTHCode :: {- Binary a => -} TH.Q a -> GHCJSQ ByteString +runTHCode c = TH.runQ c >> return B.empty + +loadTHData :: ByteString -> IO Any +loadTHData bs = return (unsafeCoerce ()) + +awaitMessage :: IO Message +awaitMessage = fmap (runGet get) (return BL.empty) + +-- | send result back +sendResult :: Message -> IO () +sendResult msg = return ()
\ No newline at end of file diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index 0d10a99fe6..184ff1ec88 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -20,3 +20,6 @@ test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) +test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, ['']) +# T9208 fails (and should do so) if you have assertion checking on in the compiler +# Hence the above expect_broken. See comments in the Trac ticket
\ No newline at end of file diff --git a/testsuite/tests/stranal/should_run/T9254.hs b/testsuite/tests/stranal/should_run/T9254.hs new file mode 100644 index 0000000000..279eb5c1ec --- /dev/null +++ b/testsuite/tests/stranal/should_run/T9254.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} +module Main where +import GHC.Exts + +f :: (() -> (# Int#, () #)) -> () +{-# NOINLINE f #-} +-- Strictness signature was (7.8.2) +-- <C(S(LS)), 1*C1(U(A,1*U()))> +-- I.e. calls k, but discards first component of result +f k = case k () of (# _, r #) -> r + +g :: Int -> () +g y = f (\n -> (# case y of I# y2 -> h (h (h (h (h (h (h y2)))))), n #)) + -- RHS is big enough to force worker/wrapper + +{-# NOINLINE h #-} +h :: Int# -> Int# +h n = n +# 1# + +main = print (g 1) diff --git a/testsuite/tests/stranal/should_run/T9254.stdout b/testsuite/tests/stranal/should_run/T9254.stdout new file mode 100644 index 0000000000..6a452c185a --- /dev/null +++ b/testsuite/tests/stranal/should_run/T9254.stdout @@ -0,0 +1 @@ +() diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index 0c43aac8c4..2ca65b5110 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -7,3 +7,4 @@ test('strun003', normal, compile_and_run, ['']) test('strun004', normal, compile_and_run, ['']) test('T2756b', normal, compile_and_run, ['']) test('T7649', normal, compile_and_run, ['']) +test('T9254', normal, compile_and_run, ['']) diff --git a/testsuite/tests/th/T7241.hs b/testsuite/tests/th/T7241.hs new file mode 100644 index 0000000000..971a2678f8 --- /dev/null +++ b/testsuite/tests/th/T7241.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T7241 where + +import Language.Haskell.TH + +$(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] []]) diff --git a/testsuite/tests/th/T7241.stderr b/testsuite/tests/th/T7241.stderr new file mode 100644 index 0000000000..343cdc827d --- /dev/null +++ b/testsuite/tests/th/T7241.stderr @@ -0,0 +1,6 @@ + +T7241.hs:7:3: + Duplicate exact Name ‘Foo’ + Probable cause: you used a unique Template Haskell name (NameU), + perhaps via newName, but bound it multiple times + If that's it, then -ddump-splices might be useful diff --git a/testsuite/tests/th/T8932.stderr b/testsuite/tests/th/T8932.stderr index 0e0f9774d5..c861235091 100644 --- a/testsuite/tests/th/T8932.stderr +++ b/testsuite/tests/th/T8932.stderr @@ -1,5 +1,11 @@ -
-T8932.hs:11:1:
- Multiple declarations of ‘foo’
- Declared at: T8932.hs:5:3
- T8932.hs:11:1
+ +T8932.hs:5:3: + Duplicate exact Name ‘foo’ + Probable cause: you used a unique Template Haskell name (NameU), + perhaps via newName, but bound it multiple times + If that's it, then -ddump-splices might be useful + +T8932.hs:11:1: + Multiple declarations of ‘foo’ + Declared at: T8932.hs:5:3 + T8932.hs:11:1 diff --git a/testsuite/tests/th/T9199.hs b/testsuite/tests/th/T9199.hs new file mode 100644 index 0000000000..aa41198b57 --- /dev/null +++ b/testsuite/tests/th/T9199.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell, PolyKinds, TypeFamilies #-} + +module T9160 where + +$( [d| class C (a :: k) where + type F (a :: k) :: * + |] + ) + diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr index bd44d12c6b..ab61060000 100644 --- a/testsuite/tests/th/TH_Roles2.stderr +++ b/testsuite/tests/th/TH_Roles2.stderr @@ -1,12 +1,7 @@ TYPE SIGNATURES TYPE CONSTRUCTORS - T :: k -> * - data T (k::BOX) (a::k) - No C type associated - Roles: [nominal, representational] - RecFlag NonRecursive, Not promotable - = - FamilyInstance: none + type role T representational + data T (a :: k) COERCION AXIOMS Dependent modules: [] Dependent packages: [base, ghc-prim, integer-gmp, pretty-1.1.1.1, diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 22bb7cc637..6e86d303e5 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -326,4 +326,6 @@ test('T8884', normal, compile, ['-v0']) test('T8954', normal, compile, ['-v0']) test('T8932', normal, compile_fail, ['-v0']) test('T8987', normal, compile_fail, ['-v0']) +test('T7241', normal, compile_fail, ['-v0']) +test('T9199', normal, compile, ['-v0']) diff --git a/testsuite/tests/typecheck/should_compile/T4912.stderr b/testsuite/tests/typecheck/should_compile/T4912.stderr index 50d2deb3cd..0e0920f034 100644 --- a/testsuite/tests/typecheck/should_compile/T4912.stderr +++ b/testsuite/tests/typecheck/should_compile/T4912.stderr @@ -1,4 +1,12 @@ -T4912.hs:10:10: Warning: Orphan instance: instance Foo TheirData +T4912.hs:10:10: Warning: + Orphan instance: instance Foo TheirData + To avoid this + move the instance declaration to the module of the class or of the type, or + wrap the type with a newtype and declare the instance on the new type. -T4912.hs:13:10: Warning: Orphan instance: instance Bar OurData +T4912.hs:13:10: Warning: + Orphan instance: instance Bar OurData + To avoid this + move the instance declaration to the module of the class or of the type, or + wrap the type with a newtype and declare the instance on the new type. diff --git a/testsuite/tests/typecheck/should_compile/T5481.stderr b/testsuite/tests/typecheck/should_compile/T5481.stderr index df5d23b360..719c4ce5c7 100644 --- a/testsuite/tests/typecheck/should_compile/T5481.stderr +++ b/testsuite/tests/typecheck/should_compile/T5481.stderr @@ -1,8 +1,4 @@ -T5481.hs:6:5: - The RHS of an associated type declaration mentions type variable ‘b’ - All such variables must be bound on the LHS +T5481.hs:6:16: Not in scope: type variable ‘b’ -T5481.hs:8:5: - The RHS of an associated type declaration mentions type variable ‘a’ - All such variables must be bound on the LHS +T5481.hs:8:16: Not in scope: type variable ‘a’ diff --git a/testsuite/tests/typecheck/should_compile/T9117.hs b/testsuite/tests/typecheck/should_compile/T9117.hs new file mode 100644 index 0000000000..cb05bf2c23 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T9117.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE RoleAnnotations #-} + +-- Also see Note [Order of Coercible Instances] + +module T9117 where + +import Data.Coerce + +newtype Phant a = MkPhant Char +type role Phant representational + +ex1 :: Phant Bool +ex1 = coerce (MkPhant 'x' :: Phant Int) diff --git a/testsuite/tests/typecheck/should_compile/T9117_2.hs b/testsuite/tests/typecheck/should_compile/T9117_2.hs new file mode 100644 index 0000000000..e7b08d8b6c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T9117_2.hs @@ -0,0 +1,10 @@ +module T9117_2 where + + +import Data.Coerce + +newtype Foo a = Foo (Foo a) +newtype Age = MkAge Int + +ex1 :: (Foo Age) -> (Foo Int) +ex1 = coerce diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 373e739a3f..07d05b8a0e 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -418,3 +418,5 @@ test('T8644', normal, compile, ['']) test('T8762', normal, compile, ['']) test('MutRec', normal, compile, ['']) test('T8856', normal, compile, ['']) +test('T9117', normal, compile, ['']) +test('T9117_2', expect_broken('9117'), compile, ['']) diff --git a/testsuite/tests/typecheck/should_compile/tc168.stderr b/testsuite/tests/typecheck/should_compile/tc168.stderr index de1467b2b4..b46cdd04b3 100644 --- a/testsuite/tests/typecheck/should_compile/tc168.stderr +++ b/testsuite/tests/typecheck/should_compile/tc168.stderr @@ -1,11 +1,11 @@ - -tc168.hs:17:1: - Could not deduce (C a1 (a, b0)) - arising from the ambiguity check for ‘g’ - from the context (C a1 (a, b)) - bound by the inferred type for ‘g’: C a1 (a, b) => a1 -> a - at tc168.hs:17:1-16 - The type variable ‘b0’ is ambiguous - When checking that ‘g’ - has the inferred type ‘forall a b a1. C a1 (a, b) => a1 -> a’ - Probable cause: the inferred type is ambiguous +
+tc168.hs:17:1:
+ Could not deduce (C a1 (a, b0))
+ arising from the ambiguity check for ‘g’
+ from the context (C a1 (a, b))
+ bound by the inferred type for ‘g’: C a1 (a, b) => a1 -> a
+ at tc168.hs:17:1-16
+ The type variable ‘b0’ is ambiguous
+ When checking that ‘g’ has the inferred type
+ g :: forall a b a1. C a1 (a, b) => a1 -> a
+ Probable cause: the inferred type is ambiguous
diff --git a/testsuite/tests/typecheck/should_compile/tc211.stderr b/testsuite/tests/typecheck/should_compile/tc211.stderr index bdc5bd1879..533155a657 100644 --- a/testsuite/tests/typecheck/should_compile/tc211.stderr +++ b/testsuite/tests/typecheck/should_compile/tc211.stderr @@ -1,82 +1,25 @@ - -tc211.hs:15:22: - Couldn't match type ‘forall a6. a6 -> a6’ with ‘a -> a’ - Expected type: [a -> a] - Actual type: [forall a. a -> a] - In the first argument of ‘head’, namely ‘foo’ - In the first argument of ‘(:) :: - (forall a. a -> a) - -> [forall a. a -> a] -> [forall a. a -> a]’, namely - ‘(head foo)’ - -tc211.hs:48:19: - Could not deduce (Num a2) arising from the literal ‘3’ - from the context (Num a) - bound by the inferred type of - h1 :: Num a => (forall a1. a1 -> a1) -> a - at tc211.hs:(47,1)-(49,9) - The type variable ‘a2’ is ambiguous - Relevant bindings include - y :: Pair a2 (Pair a3 b1) (bound at tc211.hs:48:10) - Note: there are several potential instances: - instance Num Double -- Defined in ‘GHC.Float’ - instance Num Float -- Defined in ‘GHC.Float’ - instance Integral a => Num (GHC.Real.Ratio a) - -- Defined in ‘GHC.Real’ - ...plus three others - In the first argument of ‘g’, namely ‘3’ - In the first argument of ‘P’, namely ‘(g 3)’ - In the expression: P (g 3) (g (P 3 4)) - -tc211.hs:48:28: - Could not deduce (Num a3) arising from the literal ‘3’ - from the context (Num a) - bound by the inferred type of - h1 :: Num a => (forall a1. a1 -> a1) -> a - at tc211.hs:(47,1)-(49,9) - The type variable ‘a3’ is ambiguous - Relevant bindings include - y :: Pair a2 (Pair a3 b1) (bound at tc211.hs:48:10) - Note: there are several potential instances: - instance Num Double -- Defined in ‘GHC.Float’ - instance Num Float -- Defined in ‘GHC.Float’ - instance Integral a => Num (GHC.Real.Ratio a) - -- Defined in ‘GHC.Real’ - ...plus three others - In the first argument of ‘P’, namely ‘3’ - In the first argument of ‘g’, namely ‘(P 3 4)’ - In the second argument of ‘P’, namely ‘(g (P 3 4))’ - -tc211.hs:48:30: - Could not deduce (Num b1) arising from the literal ‘4’ - from the context (Num a) - bound by the inferred type of - h1 :: Num a => (forall a1. a1 -> a1) -> a - at tc211.hs:(47,1)-(49,9) - The type variable ‘b1’ is ambiguous - Relevant bindings include - y :: Pair a2 (Pair a3 b1) (bound at tc211.hs:48:10) - Note: there are several potential instances: - instance Num Double -- Defined in ‘GHC.Float’ - instance Num Float -- Defined in ‘GHC.Float’ - instance Integral a => Num (GHC.Real.Ratio a) - -- Defined in ‘GHC.Real’ - ...plus three others - In the second argument of ‘P’, namely ‘4’ - In the first argument of ‘g’, namely ‘(P 3 4)’ - In the second argument of ‘P’, namely ‘(g (P 3 4))’ - -tc211.hs:70:9: - Couldn't match type ‘forall a7. a7 -> a7’ with ‘a6 -> a6’ - Expected type: List (forall a. a -> a) - -> (forall a. a -> a) -> a6 -> a6 - Actual type: List (forall a. a -> a) - -> (forall a. a -> a) -> forall a. a -> a - In the expression: - foo2 :: - List (forall a. a -> a) -> (forall a. a -> a) -> (forall a. a -> a) - In the expression: - (foo2 :: - List (forall a. a -> a) - -> (forall a. a -> a) -> (forall a. a -> a)) - xs1 (\ x -> x) +
+tc211.hs:15:22:
+ Couldn't match type ‘forall a1. a1 -> a1’ with ‘a -> a’
+ Expected type: [a -> a]
+ Actual type: [forall a. a -> a]
+ In the first argument of ‘head’, namely ‘foo’
+ In the first argument of ‘(:) ::
+ (forall a. a -> a)
+ -> [forall a. a -> a] -> [forall a. a -> a]’, namely
+ ‘(head foo)’
+
+tc211.hs:70:9:
+ Couldn't match type ‘forall a2. a2 -> a2’ with ‘a1 -> a1’
+ Expected type: List (forall a. a -> a)
+ -> (forall a. a -> a) -> a1 -> a1
+ Actual type: List (forall a. a -> a)
+ -> (forall a. a -> a) -> forall a. a -> a
+ In the expression:
+ foo2 ::
+ List (forall a. a -> a) -> (forall a. a -> a) -> (forall a. a -> a)
+ In the expression:
+ (foo2 ::
+ List (forall a. a -> a)
+ -> (forall a. a -> a) -> (forall a. a -> a))
+ xs1 (\ x -> x)
diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr index 16ddddac09..4421e8aba3 100644 --- a/testsuite/tests/typecheck/should_compile/tc231.stderr +++ b/testsuite/tests/typecheck/should_compile/tc231.stderr @@ -5,24 +5,11 @@ TYPE SIGNATURES Q s (Z [Char]) chain -> ST s () s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1 TYPE CONSTRUCTORS - Q :: * -> * -> * -> * - data Q s a chain - No C type associated - Roles: [representational, representational, representational] - RecFlag NonRecursive, Promotable - = Node :: s -> a -> chain -> Q s a chain Stricts: _ _ _ - FamilyInstance: none - Z :: * -> * - data Z a - No C type associated - Roles: [representational] - RecFlag NonRecursive, Promotable - = Z :: a -> Z a Stricts: _ - FamilyInstance: none - Zork :: * -> * -> * -> Constraint - class Zork s a b | a -> b - Roles: [nominal, nominal, nominal] - RecFlag NonRecursive + data Q s a chain = Node s a chain + Promotable + data Z a = Z a + Promotable + class Zork s a b | a -> b where huh :: Q s a chain -> ST s () COERCION AXIOMS axiom ShouldCompile.NTCo:Zork :: diff --git a/testsuite/tests/typecheck/should_compile/tc253.hs b/testsuite/tests/typecheck/should_compile/tc253.hs index 4771b82435..3ce439e4f2 100644 --- a/testsuite/tests/typecheck/should_compile/tc253.hs +++ b/testsuite/tests/typecheck/should_compile/tc253.hs @@ -4,8 +4,11 @@ module ShouldCompile where class Cls a where type Fam a b :: * -- Multiple defaults! - type Fam a Bool = Maybe a - type Fam a Int = (String, a) + type Fam a x = FamHelper a x + +type family FamHelper a x +type instance FamHelper a Bool = Maybe a +type instance FamHelper a Int = (String, a) instance Cls Int where -- Gets type family from default diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr index 9b3ac0e364..b310a79a6f 100644 --- a/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr +++ b/testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr @@ -1,6 +1,6 @@ -AssocTyDef02.hs:6:10: - Type indexes must match class instance head - Found ‘[b]’ but expected ‘a’ - In the type synonym instance default declaration for ‘Typ’ - In the class declaration for ‘Cls’ +AssocTyDef02.hs:6:14: + Unexpected type ‘[b]’ + In the default declaration for ‘Typ’ + A default declaration should have form + default Typ a = ... diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr index e62a2afcc5..c0950bcc74 100644 --- a/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr +++ b/testsuite/tests/typecheck/should_fail/AssocTyDef03.stderr @@ -1,5 +1,5 @@ - -AssocTyDef03.hs:6:5: - Wrong category of family instance; declaration was for a data type - In the type instance declaration for ‘Typ’ - In the class declaration for ‘Cls’ +
+AssocTyDef03.hs:6:5:
+ Wrong category of family instance; declaration was for a data type
+ In the default type instance declaration for ‘Typ’
+ In the class declaration for ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr index 550d09895f..4fbaaef199 100644 --- a/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr +++ b/testsuite/tests/typecheck/should_fail/AssocTyDef04.stderr @@ -1,7 +1,7 @@ - -AssocTyDef04.hs:6:18: - Expecting one more argument to ‘Maybe’ - Expected kind ‘*’, but ‘Maybe’ has kind ‘* -> *’ - In the type ‘Maybe’ - In the type instance declaration for ‘Typ’ - In the class declaration for ‘Cls’ +
+AssocTyDef04.hs:6:18:
+ Expecting one more argument to ‘Maybe’
+ Expected kind ‘*’, but ‘Maybe’ has kind ‘* -> *’
+ In the type ‘Maybe’
+ In the default type instance declaration for ‘Typ’
+ In the class declaration for ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr index 8f5b5a5316..660d081ca3 100644 --- a/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr +++ b/testsuite/tests/typecheck/should_fail/AssocTyDef05.stderr @@ -1,5 +1,5 @@ - -AssocTyDef05.hs:6:10: - Number of parameters must match family declaration; expected 1 - In the type synonym instance default declaration for ‘Typ’ - In the class declaration for ‘Cls’ +
+AssocTyDef05.hs:6:5:
+ Number of parameters must match family declaration; expected 1
+ In the default type instance declaration for ‘Typ’
+ In the class declaration for ‘Cls’
diff --git a/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr b/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr index 29db541832..665ad223d2 100644 --- a/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr +++ b/testsuite/tests/typecheck/should_fail/AssocTyDef06.stderr @@ -1,5 +1,6 @@ - -AssocTyDef06.hs:6:10: - Number of parameters must match family declaration; expected no more than 1 - In the type instance declaration for ‘Typ’ - In the class declaration for ‘Cls’ +
+AssocTyDef06.hs:6:16:
+ Unexpected type ‘Int’
+ In the default declaration for ‘Typ’
+ A default declaration should have form
+ default Typ a b = ...
diff --git a/testsuite/tests/typecheck/should_fail/ContextStack2.stderr b/testsuite/tests/typecheck/should_fail/ContextStack2.stderr index a9c5cbc13a..e99e4c4264 100644 --- a/testsuite/tests/typecheck/should_fail/ContextStack2.stderr +++ b/testsuite/tests/typecheck/should_fail/ContextStack2.stderr @@ -6,4 +6,4 @@ ContextStack2.hs:8:6: TF (TF (TF (TF (TF (TF (TF (TF (TF (TF (TF Int))))))))))) ~ TF (TF (TF (TF (TF (TF (TF (TF (TF (TF a))))))))) In the ambiguity check for: forall a. a ~ TF (a, Int) => Int - In the type signature for ‘t’: t :: a ~ TF (a, Int) => Int + In the type signature for ‘t’: t :: (a ~ TF (a, Int)) => Int diff --git a/testsuite/tests/typecheck/should_fail/T1897a.stderr b/testsuite/tests/typecheck/should_fail/T1897a.stderr index 8a9e23bb9d..58f1a2d6ff 100644 --- a/testsuite/tests/typecheck/should_fail/T1897a.stderr +++ b/testsuite/tests/typecheck/should_fail/T1897a.stderr @@ -1,11 +1,11 @@ - -T1897a.hs:9:1: - Could not deduce (Wob a0 b) - arising from the ambiguity check for ‘foo’ - from the context (Wob a b) - bound by the inferred type for ‘foo’: Wob a b => b -> [b] - at T1897a.hs:9:1-24 - The type variable ‘a0’ is ambiguous - When checking that ‘foo’ - has the inferred type ‘forall a b. Wob a b => b -> [b]’ - Probable cause: the inferred type is ambiguous +
+T1897a.hs:9:1:
+ Could not deduce (Wob a0 b)
+ arising from the ambiguity check for ‘foo’
+ from the context (Wob a b)
+ bound by the inferred type for ‘foo’: Wob a b => b -> [b]
+ at T1897a.hs:9:1-24
+ The type variable ‘a0’ is ambiguous
+ When checking that ‘foo’ has the inferred type
+ foo :: forall a b. Wob a b => b -> [b]
+ Probable cause: the inferred type is ambiguous
diff --git a/testsuite/tests/typecheck/should_fail/T3468.stderr b/testsuite/tests/typecheck/should_fail/T3468.stderr index 17bc7fba01..26ec1920a6 100644 --- a/testsuite/tests/typecheck/should_fail/T3468.stderr +++ b/testsuite/tests/typecheck/should_fail/T3468.stderr @@ -5,4 +5,4 @@ T3468.hs-boot:3:1: Main module: type role Tool phantom data Tool d where F :: a -> Tool d - Boot file: data Tool + Boot file: abstract Tool diff --git a/testsuite/tests/typecheck/should_fail/T7019.stderr b/testsuite/tests/typecheck/should_fail/T7019.stderr index dd967c8785..6e47926037 100644 --- a/testsuite/tests/typecheck/should_fail/T7019.stderr +++ b/testsuite/tests/typecheck/should_fail/T7019.stderr @@ -1,6 +1,5 @@ -T7019.hs:14:10: - Illegal polymorphic or qualified type: C c - In the context: (C c) - While checking an instance declaration - In the instance declaration for ‘Monad (Free c)’ +T7019.hs:11:12: + Illegal constraint: forall a. c (Free c a) + In the type ‘forall a. c (Free c a)’ + In the type declaration for ‘C’ diff --git a/testsuite/tests/typecheck/should_fail/T7019a.stderr b/testsuite/tests/typecheck/should_fail/T7019a.stderr index 301a6cd11c..f88893153f 100644 --- a/testsuite/tests/typecheck/should_fail/T7019a.stderr +++ b/testsuite/tests/typecheck/should_fail/T7019a.stderr @@ -1,7 +1,4 @@ -T7019a.hs:11:1: - Illegal polymorphic or qualified type: - forall b. Context (Associated a b) - In the context: (forall b. Context (Associated a b)) - While checking the super-classes of class ‘Class’ +T7019a.hs:11:8: + Illegal constraint: forall b. Context (Associated a b) In the class declaration for ‘Class’ diff --git a/testsuite/tests/typecheck/should_fail/T7609.stderr b/testsuite/tests/typecheck/should_fail/T7609.stderr index 1b904bbec7..b02dbe20f8 100644 --- a/testsuite/tests/typecheck/should_fail/T7609.stderr +++ b/testsuite/tests/typecheck/should_fail/T7609.stderr @@ -1,10 +1,10 @@ -
-T7609.hs:7:16:
- Expecting one more argument to ‘Maybe’
- The second argument of a tuple should have kind ‘*’,
- but ‘Maybe’ has kind ‘* -> *’
- In the type signature for ‘f’: f :: (a `X` a, Maybe)
-
-T7609.hs:10:7:
- Expected a constraint, but ‘a `X` a’ has kind ‘*’
- In the type signature for ‘g’: g :: a `X` a => Maybe
+ +T7609.hs:7:16: + Expecting one more argument to ‘Maybe’ + The second argument of a tuple should have kind ‘*’, + but ‘Maybe’ has kind ‘* -> *’ + In the type signature for ‘f’: f :: (a `X` a, Maybe) + +T7609.hs:10:7: + Expected a constraint, but ‘a `X` a’ has kind ‘*’ + In the type signature for ‘g’: g :: (a `X` a) => Maybe diff --git a/testsuite/tests/typecheck/should_fail/T7778.stderr b/testsuite/tests/typecheck/should_fail/T7778.stderr index 714e2a6e27..136625af75 100644 --- a/testsuite/tests/typecheck/should_fail/T7778.stderr +++ b/testsuite/tests/typecheck/should_fail/T7778.stderr @@ -2,4 +2,4 @@ T7778.hs:3:19: Expecting one more argument to ‘Num’ Expected a type, but ‘Num’ has kind ‘* -> Constraint’ - In the type signature for ‘v’: v :: (Num Int => Num) () => () + In the type signature for ‘v’: v :: ((Num Int => Num) ()) => () diff --git a/testsuite/tests/typecheck/should_fail/T8142.stderr b/testsuite/tests/typecheck/should_fail/T8142.stderr index 5940df4384..d585abdcd2 100644 --- a/testsuite/tests/typecheck/should_fail/T8142.stderr +++ b/testsuite/tests/typecheck/should_fail/T8142.stderr @@ -1,28 +1,28 @@ - -T8142.hs:6:18: - Couldn't match type ‘Nu ((,) t0)’ with ‘Nu ((,) t)’ - NB: ‘Nu’ is a type function, and may not be injective - The type variable ‘t0’ is ambiguous - Expected type: Nu ((,) t) -> Nu f - Actual type: Nu ((,) t0) -> Nu f0 - When checking that ‘h’ - has the inferred type ‘forall t (f :: * -> *). Nu ((,) t) -> Nu f’ - Probable cause: the inferred type is ambiguous - In an equation for ‘tracer’: - tracer - = h - where - h = (\ (_, b) -> ((outI . fmap h) b)) . out - -T8142.hs:6:57: - Could not deduce (Nu ((,) t) ~ f1 (Nu ((,) t))) - from the context (Functor f, Coinductive f) - bound by the type signature for - tracer :: (Functor f, Coinductive f) => (c -> f c) -> c -> f c - at T8142.hs:5:11-64 - Expected type: Nu ((,) t) -> (t, f1 (Nu ((,) t))) - Actual type: Nu ((,) t) -> (t, Nu ((,) t)) - Relevant bindings include - h :: Nu ((,) t) -> Nu f1 (bound at T8142.hs:6:18) - In the second argument of ‘(.)’, namely ‘out’ - In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out +
+T8142.hs:6:18:
+ Couldn't match type ‘Nu ((,) t0)’ with ‘Nu ((,) t)’
+ NB: ‘Nu’ is a type function, and may not be injective
+ The type variable ‘t0’ is ambiguous
+ Expected type: Nu ((,) t) -> Nu f
+ Actual type: Nu ((,) t0) -> Nu f0
+ When checking that ‘h’ has the inferred type
+ h :: forall t (f :: * -> *). Nu ((,) t) -> Nu f
+ Probable cause: the inferred type is ambiguous
+ In an equation for ‘tracer’:
+ tracer
+ = h
+ where
+ h = (\ (_, b) -> ((outI . fmap h) b)) . out
+
+T8142.hs:6:57:
+ Could not deduce (Nu ((,) t) ~ f1 (Nu ((,) t)))
+ from the context (Functor f, Coinductive f)
+ bound by the type signature for
+ tracer :: (Functor f, Coinductive f) => (c -> f c) -> c -> f c
+ at T8142.hs:5:11-64
+ Expected type: Nu ((,) t) -> (t, f1 (Nu ((,) t)))
+ Actual type: Nu ((,) t) -> (t, Nu ((,) t))
+ Relevant bindings include
+ h :: Nu ((,) t) -> Nu f1 (bound at T8142.hs:6:18)
+ In the second argument of ‘(.)’, namely ‘out’
+ In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out
diff --git a/testsuite/tests/typecheck/should_fail/T8392a.stderr b/testsuite/tests/typecheck/should_fail/T8392a.stderr index ae7fc2ca6a..ed33600a1e 100644 --- a/testsuite/tests/typecheck/should_fail/T8392a.stderr +++ b/testsuite/tests/typecheck/should_fail/T8392a.stderr @@ -4,4 +4,4 @@ T8392a.hs:6:8: Inaccessible code in the type signature for foo :: Int ~ Bool => a -> a In the ambiguity check for: forall a. Int ~ Bool => a -> a - In the type signature for ‘foo’: foo :: Int ~ Bool => a -> a + In the type signature for ‘foo’: foo :: (Int ~ Bool) => a -> a diff --git a/testsuite/tests/typecheck/should_fail/T8603.stderr b/testsuite/tests/typecheck/should_fail/T8603.stderr index cf12725281..8ee8cccb4a 100644 --- a/testsuite/tests/typecheck/should_fail/T8603.stderr +++ b/testsuite/tests/typecheck/should_fail/T8603.stderr @@ -1,11 +1,11 @@ T8603.hs:29:17:
- Couldn't match type ‘(->) [a0]’ with ‘[t1]’
- Expected type: [t1] -> StateT s RV t0
- Actual type: t2 ((->) [a0]) (StateT s RV t0)
+ Couldn't match type ‘(->) [a0]’ with ‘[Integer]’
+ Expected type: [Integer] -> StateT s RV t0
+ Actual type: t1 ((->) [a0]) (StateT s RV t0)
The function ‘lift’ is applied to two arguments,
but its type ‘([a0] -> StateT s RV t0)
- -> t2 ((->) [a0]) (StateT s RV t0)’
+ -> t1 ((->) [a0]) (StateT s RV t0)’
has only one
In a stmt of a 'do' block: prize <- lift uniform [1, 2, 3]
In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/T8806.stderr b/testsuite/tests/typecheck/should_fail/T8806.stderr index 0a5a3d731f..ab88b7f2eb 100644 --- a/testsuite/tests/typecheck/should_fail/T8806.stderr +++ b/testsuite/tests/typecheck/should_fail/T8806.stderr @@ -4,5 +4,5 @@ T8806.hs:5:6: In the type signature for ‘f’: f :: Int => Int T8806.hs:8:7: - Expected a constraint, but ‘Int’ has kind ‘*’ - In the type signature for ‘g’: g :: Int => Show a => Int + Illegal constraint: Int => Show a + In the type signature for ‘g’: g :: (Int => Show a) => Int diff --git a/testsuite/tests/typecheck/should_fail/T8883.stderr b/testsuite/tests/typecheck/should_fail/T8883.stderr index 0ea136869b..d02f02338e 100644 --- a/testsuite/tests/typecheck/should_fail/T8883.stderr +++ b/testsuite/tests/typecheck/should_fail/T8883.stderr @@ -1,7 +1,8 @@ - - -T8883.hs:17:1: - Non type-variable argument in the constraint: Functor (PF a) - (Use FlexibleContexts to permit this) - In the context: (Regular a, Functor (PF a)) - While checking the inferred type for ‘fold’ +
+T8883.hs:20:1:
+ Non type-variable argument in the constraint: Functor (PF a)
+ (Use FlexibleContexts to permit this)
+ When checking that ‘fold’ has the inferred type
+ fold :: forall a b.
+ (Regular a, Functor (PF a)) =>
+ (PF a b -> b) -> a -> b
diff --git a/testsuite/tests/typecheck/should_fail/T8912.stderr b/testsuite/tests/typecheck/should_fail/T8912.stderr index 24607c29be..ad343f33c5 100644 --- a/testsuite/tests/typecheck/should_fail/T8912.stderr +++ b/testsuite/tests/typecheck/should_fail/T8912.stderr @@ -1,6 +1,6 @@ T8912.hs:7:10: - Illegal implict parameter ‘?imp::Int’ + Illegal implicit parameter ‘?imp::Int’ In the context: (?imp::Int) While checking an instance declaration In the instance declaration for ‘C [a]’ diff --git a/testsuite/tests/typecheck/should_fail/T9033.hs b/testsuite/tests/typecheck/should_fail/T9033.hs new file mode 100644 index 0000000000..cc9277fc17 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9033.hs @@ -0,0 +1,7 @@ +module T9030 where + +bad :: Bool +bad = () + +square :: Integral i => i -> i +square x = x^2 diff --git a/testsuite/tests/typecheck/should_fail/T9033.stderr b/testsuite/tests/typecheck/should_fail/T9033.stderr new file mode 100644 index 0000000000..c2fd563124 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9033.stderr @@ -0,0 +1,5 @@ + +T9033.hs:4:7: + Couldn't match expected type ‘Bool’ with actual type ‘()’ + In the expression: () + In an equation for ‘bad’: bad = () diff --git a/testsuite/tests/typecheck/should_fail/T9196.hs b/testsuite/tests/typecheck/should_fail/T9196.hs new file mode 100644 index 0000000000..11d713b5e9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9196.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE RankNTypes #-} +module T9196 where + +f :: (forall a. Eq a) => a -> a +f x = x + +g :: (Eq a => Ord a) => a -> a +g x = x diff --git a/testsuite/tests/typecheck/should_fail/T9196.stderr b/testsuite/tests/typecheck/should_fail/T9196.stderr new file mode 100644 index 0000000000..6f5a204edd --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9196.stderr @@ -0,0 +1,8 @@ + +T9196.hs:4:7: + Illegal constraint: forall a. Eq a + In the type signature for ‘f’: f :: (forall a. Eq a) => a -> a + +T9196.hs:7:7: + Illegal constraint: Eq a => Ord a + In the type signature for ‘g’: g :: (Eq a => Ord a) => a -> a diff --git a/testsuite/tests/typecheck/should_fail/T9305.hs b/testsuite/tests/typecheck/should_fail/T9305.hs new file mode 100644 index 0000000000..b6ad3b780e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9305.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DeriveFunctor#-} +module Main where + +data Event a b = Event a deriving (Functor) + +newtype F f = F (f (F f)) + +data EventF a = EventF (F (Event a)) deriving (Functor) diff --git a/testsuite/tests/typecheck/should_fail/T9305.stderr b/testsuite/tests/typecheck/should_fail/T9305.stderr new file mode 100644 index 0000000000..16104237b9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9305.stderr @@ -0,0 +1,8 @@ + +T9305.hs:8:48: + No instance for (Functor Event) + arising from the first field of ‘EventF’ (type ‘F (Event a)’) + Possible fix: + use a standalone 'deriving instance' declaration, + so you can specify the instance context yourself + When deriving the instance for (Functor EventF) diff --git a/testsuite/tests/typecheck/should_fail/T9323.hs b/testsuite/tests/typecheck/should_fail/T9323.hs new file mode 100644 index 0000000000..1aea288bbe --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9323.hs @@ -0,0 +1,7 @@ +module T9323 where + +broken :: [Int] +broken = () + +ambiguous :: a -> String +ambiguous _ = show 0 diff --git a/testsuite/tests/typecheck/should_fail/T9323.stderr b/testsuite/tests/typecheck/should_fail/T9323.stderr new file mode 100644 index 0000000000..f98ce7bafe --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T9323.stderr @@ -0,0 +1,5 @@ + +T9323.hs:4:10: + Couldn't match expected type ‘[Int]’ with actual type ‘()’ + In the expression: () + In an equation for ‘broken’: broken = () diff --git a/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr b/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr index 9e8175d99f..80f6ec4ec0 100644 --- a/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr +++ b/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr @@ -1,5 +1,5 @@ TcNoNullaryTC.hs:3:1: No parameters for class ‘A’ - (Use NullaryTypeClasses to allow no-parameter classes) + (Use MultiParamTypeClasses to allow no-parameter classes) In the class declaration for ‘A’ diff --git a/testsuite/tests/typecheck/should_fail/TcNullaryTCFail.hs b/testsuite/tests/typecheck/should_fail/TcNullaryTCFail.hs index b127300b75..b00200db2a 100644 --- a/testsuite/tests/typecheck/should_fail/TcNullaryTCFail.hs +++ b/testsuite/tests/typecheck/should_fail/TcNullaryTCFail.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NullaryTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses #-} module TcNullaryTCFail where class A diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 2407af51be..cf2af3090d 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -331,3 +331,8 @@ test('T8570', extra_clean(['T85570a.o', 'T8570a.hi','T85570b.o', 'T8570b.hi']), test('T8603', normal, compile_fail, ['']) test('T8806', normal, compile_fail, ['']) test('T8912', normal, compile_fail, ['']) +test('T9033', normal, compile_fail, ['']) +test('T8883', normal, compile_fail, ['']) +test('T9196', normal, compile_fail, ['']) +test('T9305', normal, compile_fail, ['']) +test('T9323', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/mc24.stderr b/testsuite/tests/typecheck/should_fail/mc24.stderr index 0ddc66d97a..495693c9f8 100644 --- a/testsuite/tests/typecheck/should_fail/mc24.stderr +++ b/testsuite/tests/typecheck/should_fail/mc24.stderr @@ -1,8 +1,8 @@ - -mc24.hs:10:31: - Couldn't match type ‘[a0]’ with ‘a -> a1’ - Expected type: (a -> a1) -> [a] -> t [a] - Actual type: [a0] -> [a0] - Possible cause: ‘take’ is applied to too many arguments - In the expression: take 2 - In a stmt of a monad comprehension: then group by x using take 2 +
+mc24.hs:10:31:
+ Couldn't match type ‘[a0]’ with ‘a -> Integer’
+ Expected type: (a -> Integer) -> [a] -> t [a]
+ Actual type: [a0] -> [a0]
+ Possible cause: ‘take’ is applied to too many arguments
+ In the expression: take 2
+ In a stmt of a monad comprehension: then group by x using take 2
diff --git a/testsuite/tests/typecheck/should_fail/tcfail004.stderr b/testsuite/tests/typecheck/should_fail/tcfail004.stderr index df54f950c6..48840e7298 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail004.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail004.stderr @@ -1,9 +1,9 @@ - -tcfail004.hs:3:9: - Couldn't match expected type ‘(t, t3)’ - with actual type ‘(t0, t1, t2)’ - Relevant bindings include - f :: t (bound at tcfail004.hs:3:2) - g :: t3 (bound at tcfail004.hs:3:4) - In the expression: (1, 2, 3) - In a pattern binding: (f, g) = (1, 2, 3) +
+tcfail004.hs:3:9:
+ Couldn't match expected type ‘(t, t1)’
+ with actual type ‘(Integer, Integer, Integer)’
+ Relevant bindings include
+ f :: t (bound at tcfail004.hs:3:2)
+ g :: t1 (bound at tcfail004.hs:3:4)
+ In the expression: (1, 2, 3)
+ In a pattern binding: (f, g) = (1, 2, 3)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail005.stderr b/testsuite/tests/typecheck/should_fail/tcfail005.stderr index bae8697fe8..36f0e738e4 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail005.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail005.stderr @@ -1,8 +1,9 @@ - -tcfail005.hs:3:9: - Couldn't match expected type ‘[t]’ with actual type ‘(t0, Char)’ - Relevant bindings include - h :: t (bound at tcfail005.hs:3:2) - i :: [t] (bound at tcfail005.hs:3:4) - In the expression: (1, 'a') - In a pattern binding: (h : i) = (1, 'a') +
+tcfail005.hs:3:9:
+ Couldn't match expected type ‘[t]’
+ with actual type ‘(Integer, Char)’
+ Relevant bindings include
+ h :: t (bound at tcfail005.hs:3:2)
+ i :: [t] (bound at tcfail005.hs:3:4)
+ In the expression: (1, 'a')
+ In a pattern binding: (h : i) = (1, 'a')
diff --git a/testsuite/tests/typecheck/should_fail/tcfail032.stderr b/testsuite/tests/typecheck/should_fail/tcfail032.stderr index 954a6fd5ec..4d41c103da 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail032.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail032.stderr @@ -8,5 +8,5 @@ tcfail032.hs:14:8: Relevant bindings include x :: t (bound at tcfail032.hs:14:3) f :: t -> a -> Int (bound at tcfail032.hs:14:1) - In the expression: (x :: Eq a => a -> Int) - In an equation for ‘f’: f x = (x :: Eq a => a -> Int) + In the expression: (x :: (Eq a) => a -> Int) + In an equation for ‘f’: f x = (x :: (Eq a) => a -> Int) diff --git a/testsuite/tests/typecheck/should_fail/tcfail041.stderr b/testsuite/tests/typecheck/should_fail/tcfail041.stderr index ba5d4a15d7..c81d30979a 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail041.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail041.stderr @@ -1,6 +1,6 @@ tcfail041.hs:5:1: - Illegal implict parameter ‘?imp::Int’ + Illegal implicit parameter ‘?imp::Int’ In the context: (?imp::Int) While checking the super-classes of class ‘D’ In the class declaration for ‘D’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail058.stderr b/testsuite/tests/typecheck/should_fail/tcfail058.stderr index 101a6a07d2..74db76afd8 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail058.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail058.stderr @@ -2,4 +2,4 @@ tcfail058.hs:6:7: Expecting one more argument to ‘Array a’ Expected a constraint, but ‘Array a’ has kind ‘* -> *’ - In the type signature for ‘f’: f :: Array a => a -> b + In the type signature for ‘f’: f :: (Array a) => a -> b diff --git a/testsuite/tests/typecheck/should_fail/tcfail062.stderr b/testsuite/tests/typecheck/should_fail/tcfail062.stderr index 1396b536ee..ff4915dfd2 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail062.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail062.stderr @@ -1,6 +1,8 @@ tcfail062.hs:34:6: Not in scope: type variable ‘behaviouralExpression’ + Perhaps you meant type constructor or class ‘BehaviouralExpression’ (line 25) tcfail062.hs:34:29: Not in scope: type variable ‘behaviouralExpression’ + Perhaps you meant type constructor or class ‘BehaviouralExpression’ (line 25) diff --git a/testsuite/tests/typecheck/should_fail/tcfail080.stderr b/testsuite/tests/typecheck/should_fail/tcfail080.stderr index 589d6cf342..4e02b3e012 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail080.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail080.stderr @@ -1,13 +1,11 @@ - -tcfail080.hs:27:1: - Could not deduce (Collection c0 a) - arising from the ambiguity check for ‘q’ - from the context (Collection c a) - bound by the inferred type for ‘q’: Collection c a => a -> Bool - at tcfail080.hs:27:1-27 - The type variable ‘c0’ is ambiguous - When checking that ‘q’ - has the inferred type ‘forall (c :: * -> *) a. - Collection c a => - a -> Bool’ - Probable cause: the inferred type is ambiguous +
+tcfail080.hs:27:1:
+ Could not deduce (Collection c0 a)
+ arising from the ambiguity check for ‘q’
+ from the context (Collection c a)
+ bound by the inferred type for ‘q’: Collection c a => a -> Bool
+ at tcfail080.hs:27:1-27
+ The type variable ‘c0’ is ambiguous
+ When checking that ‘q’ has the inferred type
+ q :: forall (c :: * -> *) a. Collection c a => a -> Bool
+ Probable cause: the inferred type is ambiguous
diff --git a/testsuite/tests/typecheck/should_fail/tcfail116.stderr b/testsuite/tests/typecheck/should_fail/tcfail116.stderr index 0fdafcfaba..0136173201 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail116.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail116.stderr @@ -1,6 +1,6 @@ tcfail116.hs:5:1: The class method ‘bug’ - mentions none of the type variables of the class Foo a + mentions none of the type or kind variables of the class ‘Foo a’ When checking the class method: bug :: () In the class declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail140.stderr b/testsuite/tests/typecheck/should_fail/tcfail140.stderr index bb45df3dee..7593497fe2 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail140.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail140.stderr @@ -1,38 +1,38 @@ - -tcfail140.hs:10:7: - Couldn't match expected type ‘a0 -> t’ with actual type ‘Int’ - Relevant bindings include bar :: t (bound at tcfail140.hs:10:1) - The function ‘f’ is applied to two arguments, - but its type ‘Int -> Int’ has only one - In the expression: f 3 9 - In an equation for ‘bar’: bar = f 3 9 - -tcfail140.hs:12:10: - Couldn't match expected type ‘a1 -> t1’ with actual type ‘Int’ - Relevant bindings include - rot :: t -> t1 (bound at tcfail140.hs:12:1) - The operator ‘f’ takes two arguments, - but its type ‘Int -> Int’ has only one - In the expression: 3 `f` 4 - In an equation for ‘rot’: rot xs = 3 `f` 4 - -tcfail140.hs:14:15: - Couldn't match expected type ‘a -> b’ with actual type ‘Int’ - Relevant bindings include - xs :: [a] (bound at tcfail140.hs:14:5) - bot :: [a] -> [b] (bound at tcfail140.hs:14:1) - The operator ‘f’ takes two arguments, - but its type ‘Int -> Int’ has only one - In the first argument of ‘map’, namely ‘(3 `f`)’ - In the expression: map (3 `f`) xs - -tcfail140.hs:16:8: - Constructor ‘Just’ should have 1 argument, but has been given none - In the pattern: Just - In the expression: (\ Just x -> x) :: Maybe a -> a - In the expression: ((\ Just x -> x) :: Maybe a -> a) (Just 1) - -tcfail140.hs:19:1: - Couldn't match expected type ‘t0 -> Bool’ with actual type ‘Int’ - The equation(s) for ‘g’ have two arguments, - but its type ‘Int -> Int’ has only one +
+tcfail140.hs:10:7:
+ Couldn't match expected type ‘Integer -> t’ with actual type ‘Int’
+ Relevant bindings include bar :: t (bound at tcfail140.hs:10:1)
+ The function ‘f’ is applied to two arguments,
+ but its type ‘Int -> Int’ has only one
+ In the expression: f 3 9
+ In an equation for ‘bar’: bar = f 3 9
+
+tcfail140.hs:12:10:
+ Couldn't match expected type ‘Integer -> t1’ with actual type ‘Int’
+ Relevant bindings include
+ rot :: t -> t1 (bound at tcfail140.hs:12:1)
+ The operator ‘f’ takes two arguments,
+ but its type ‘Int -> Int’ has only one
+ In the expression: 3 `f` 4
+ In an equation for ‘rot’: rot xs = 3 `f` 4
+
+tcfail140.hs:14:15:
+ Couldn't match expected type ‘a -> b’ with actual type ‘Int’
+ Relevant bindings include
+ xs :: [a] (bound at tcfail140.hs:14:5)
+ bot :: [a] -> [b] (bound at tcfail140.hs:14:1)
+ The operator ‘f’ takes two arguments,
+ but its type ‘Int -> Int’ has only one
+ In the first argument of ‘map’, namely ‘(3 `f`)’
+ In the expression: map (3 `f`) xs
+
+tcfail140.hs:16:8:
+ Constructor ‘Just’ should have 1 argument, but has been given none
+ In the pattern: Just
+ In the expression: (\ Just x -> x) :: Maybe a -> a
+ In the expression: ((\ Just x -> x) :: Maybe a -> a) (Just 1)
+
+tcfail140.hs:19:1:
+ Couldn't match expected type ‘t0 -> Bool’ with actual type ‘Int’
+ The equation(s) for ‘g’ have two arguments,
+ but its type ‘Int -> Int’ has only one
diff --git a/testsuite/tests/typecheck/should_fail/tcfail189.stderr b/testsuite/tests/typecheck/should_fail/tcfail189.stderr index 69e8b3dbba..6bd08a266c 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail189.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail189.stderr @@ -1,8 +1,8 @@ - -tcfail189.hs:10:31: - Couldn't match type ‘[a0]’ with ‘a -> a1’ - Expected type: (a -> a1) -> [a] -> [[a]] - Actual type: [a0] -> [a0] - Possible cause: ‘take’ is applied to too many arguments - In the expression: take 2 - In a stmt of a list comprehension: then group by x using take 2 +
+tcfail189.hs:10:31:
+ Couldn't match type ‘[a0]’ with ‘a -> Integer’
+ Expected type: (a -> Integer) -> [a] -> [[a]]
+ Actual type: [a0] -> [a0]
+ Possible cause: ‘take’ is applied to too many arguments
+ In the expression: take 2
+ In a stmt of a list comprehension: then group by x using take 2
diff --git a/testsuite/tests/typecheck/should_fail/tcfail206.stderr b/testsuite/tests/typecheck/should_fail/tcfail206.stderr index 4fe402982a..3eec7088cd 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail206.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail206.stderr @@ -7,9 +7,9 @@ tcfail206.hs:5:5: In an equation for ‘a’: a = (, True)
tcfail206.hs:8:5:
- Couldn't match type ‘(t0, Int)’ with ‘Bool -> (Int, Bool)’
+ Couldn't match type ‘(Integer, Int)’ with ‘Bool -> (Int, Bool)’
Expected type: Int -> Bool -> (Int, Bool)
- Actual type: Int -> (t0, Int)
+ Actual type: Int -> (Integer, Int)
In the expression: (1,)
In an equation for ‘b’: b = (1,)
@@ -32,9 +32,10 @@ tcfail206.hs:14:5: In an equation for ‘d’: d = (# , True #)
tcfail206.hs:17:5:
- Couldn't match type ‘(# a0, Int #)’ with ‘Bool -> (# Int, Bool #)’
+ Couldn't match type ‘(# Integer, Int #)’
+ with ‘Bool -> (# Int, Bool #)’
Expected type: Int -> Bool -> (# Int, Bool #)
- Actual type: Int -> (# a0, Int #)
+ Actual type: Int -> (# Integer, Int #)
In the expression: (# 1, #)
In an equation for ‘e’: e = (# 1, #)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail211.stderr b/testsuite/tests/typecheck/should_fail/tcfail211.stderr index 3adb97cd75..0d9d23d9b1 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail211.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail211.stderr @@ -1,6 +1,6 @@ tcfail211.hs:5:1: - Illegal implict parameter ‘?imp::Int’ + Illegal implicit parameter ‘?imp::Int’ In the context: (?imp::Int) While checking the super-classes of class ‘D’ In the class declaration for ‘D’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail215.stderr b/testsuite/tests/typecheck/should_fail/tcfail215.stderr index d7fa2d84f7..2157561827 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail215.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail215.stderr @@ -1,4 +1,4 @@ tcfail215.hs:8:15: Expecting a lifted type, but ‘Int#’ is unlifted - In the type signature for ‘foo’: foo :: ?x :: Int# => Int + In the type signature for ‘foo’: foo :: (?x :: Int#) => Int diff --git a/testsuite/tests/typecheck/should_run/TcCoercible.hs b/testsuite/tests/typecheck/should_run/TcCoercible.hs index 7bb8e48b51..284984029f 100644 --- a/testsuite/tests/typecheck/should_run/TcCoercible.hs +++ b/testsuite/tests/typecheck/should_run/TcCoercible.hs @@ -23,7 +23,8 @@ newtype NonEtad a b = NonEtad (Either b a) deriving Show newtype Fix f = Fix (f (Fix f)) deriving instance Show (f (Fix f)) => Show (Fix f) -newtype FixEither a = FixEither (Either a (FixEither a)) deriving Show +-- Later, however, this stopped working (#9117) +-- newtype FixEither a = FixEither (Either a (FixEither a)) deriving Show -- This ensures that explicitly given constraints are consulted, even -- at higher depths @@ -59,8 +60,8 @@ main = do print (coerce $ (Fix (Left ()) :: Fix (Either ())) :: Either () (Fix (Either ()))) print (coerce $ (Left () :: Either () (Fix (Either ()))) :: Fix (Either ())) - print (coerce $ (FixEither (Left age) :: FixEither Age) :: Either Int (FixEither Int)) - print (coerce $ (Left one :: Either Int (FixEither Age)) :: FixEither Age) + -- print (coerce $ (FixEither (Left age) :: FixEither Age) :: Either Int (FixEither Int)) + -- print (coerce $ (Left one :: Either Int (FixEither Age)) :: FixEither Age) print (coerce $ True :: Fam Int) print (coerce $ FamInt True :: Bool) diff --git a/testsuite/tests/typecheck/should_run/TcCoercible.stdout b/testsuite/tests/typecheck/should_run/TcCoercible.stdout index 7b8071fe12..8ac2181440 100644 --- a/testsuite/tests/typecheck/should_run/TcCoercible.stdout +++ b/testsuite/tests/typecheck/should_run/TcCoercible.stdout @@ -14,7 +14,5 @@ List [1] NonEtad (Right 1) Left () Fix (Left ()) -Left 1 -FixEither (Left (Age 1)) FamInt True True diff --git a/testsuite/tests/typecheck/should_run/TcNullaryTC.hs b/testsuite/tests/typecheck/should_run/TcNullaryTC.hs index a94d3058b0..17e3f4c425 100644 --- a/testsuite/tests/typecheck/should_run/TcNullaryTC.hs +++ b/testsuite/tests/typecheck/should_run/TcNullaryTC.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NullaryTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses #-} module Main where diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 735fa54fd5..760d5e1452 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -12,6 +12,8 @@ test('tcrun003', normal, compile_and_run, ['']) test('tcrun004', normal, compile_and_run, ['']) test('tcrun005', normal, compile_and_run, ['']) test('Defer01', normal, compile_and_run, ['']) +test('TcNullaryTC', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, ['']) +test('TcCoercible', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, ['']) # ----------------------------------------------------------------------------- # Skip everything else if fast is on @@ -35,9 +37,7 @@ test('tcrun017', normal, compile_and_run, ['']) test('tcrun018', normal, compile_and_run, ['']) test('tcrun019', normal, compile_and_run, ['']) test('tcrun020', normal, compile_and_run, ['']) -# Doesn't work with External Core due to datatype with no constructors -test('tcrun021', expect_fail_for(['extcore','optextcore']), - compile_and_run, ['-package containers']) +test('tcrun021', normal, compile_and_run, ['-package containers']) test('tcrun022', [omit_ways(['ghci']),only_compiler_types(['ghc'])], compile_and_run, ['-O']) test('tcrun023', normal, compile_and_run, ['-O']) @@ -46,8 +46,7 @@ test('tcrun025', extra_clean(['TcRun025_B.hi', 'TcRun025_B.o']), multimod_compile_and_run, ['tcrun025','']) test('tcrun026', normal, compile_and_run, ['']) test('tcrun027', normal, compile_and_run, ['']) -# Doesn't work with External Core due to datatype with no constructors -test('tcrun028', expect_fail_for(['extcore','optextcore']), compile_and_run, ['']) +test('tcrun028', normal, compile_and_run, ['']) test('tcrun029', normal, compile_and_run, ['']) test('tcrun030', normal, compile_and_run, ['']) test('tcrun031', only_compiler_types(['ghc']), compile_and_run, ['']) @@ -69,7 +68,7 @@ test('tcrun041', omit_ways(['ghci']), compile_and_run, ['']) test('tcrun042', normal, compile_and_run, ['']) test('tcrun043', normal, compile_and_run, ['']) test('tcrun044', normal, compile_and_run, ['']) -test('tcrun045', normal, compile_and_run, ['']) +test('tcrun045', normal, compile_fail, ['']) test('tcrun046', normal, compile_and_run, ['']) test('tcrun047', [omit_ways(['ghci']), only_compiler_types(['ghc'])], compile_and_run, ['']) @@ -108,10 +107,8 @@ test('T6117', normal, compile_and_run, ['']) test('T5751', normal, compile_and_run, ['']) test('T5913', normal, compile_and_run, ['']) test('T7748', normal, compile_and_run, ['']) -test('TcNullaryTC', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, ['']) test('T7861', exit_code(1), compile_and_run, ['']) test('TcTypeNatSimpleRun', normal, compile_and_run, ['']) -test('TcCoercible', when(compiler_lt('ghc', '7.7'), skip), compile_and_run, ['']) test('T8119', normal, ghci_script, ['T8119.script']) test('T8492', normal, compile_and_run, ['']) test('T8739', normal, compile_and_run, ['']) diff --git a/testsuite/tests/typecheck/should_run/tcrun.stderr b/testsuite/tests/typecheck/should_run/tcrun.stderr new file mode 100644 index 0000000000..0519ecba6e --- /dev/null +++ b/testsuite/tests/typecheck/should_run/tcrun.stderr @@ -0,0 +1 @@ +
\ No newline at end of file diff --git a/testsuite/tests/typecheck/should_run/tcrun045.stderr b/testsuite/tests/typecheck/should_run/tcrun045.stderr new file mode 100644 index 0000000000..4017279ecc --- /dev/null +++ b/testsuite/tests/typecheck/should_run/tcrun045.stderr @@ -0,0 +1,6 @@ + +tcrun045.hs:24:1: + Illegal implicit parameter ‘?imp::Int’ + In the context: (?imp::Int) + While checking the super-classes of class ‘D’ + In the class declaration for ‘D’ diff --git a/testsuite/tests/warnings/should_compile/Makefile b/testsuite/tests/warnings/should_compile/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/warnings/should_compile/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/warnings/should_compile/T9178.hs b/testsuite/tests/warnings/should_compile/T9178.hs new file mode 100644 index 0000000000..9171381e35 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T9178.hs @@ -0,0 +1,9 @@ + + +module T9178 where + +import T9178DataType + + +instance Show T9178_Type where + show _ = undefined
\ No newline at end of file diff --git a/testsuite/tests/warnings/should_compile/T9178.stderr b/testsuite/tests/warnings/should_compile/T9178.stderr new file mode 100644 index 0000000000..6f4b6c0295 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T9178.stderr @@ -0,0 +1,8 @@ +[1 of 2] Compiling T9178DataType ( T9178DataType.hs, T9178DataType.o ) +[2 of 2] Compiling T9178 ( T9178.hs, T9178.o ) + +T9178.hs:8:10: Warning: + Orphan instance: instance Show T9178_Type + To avoid this + move the instance declaration to the module of the class or of the type, or + wrap the type with a newtype and declare the instance on the new type. diff --git a/testsuite/tests/warnings/should_compile/T9178DataType.hs b/testsuite/tests/warnings/should_compile/T9178DataType.hs new file mode 100644 index 0000000000..e274117fe3 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/T9178DataType.hs @@ -0,0 +1,5 @@ + + +module T9178DataType where + +data T9178_Type diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T new file mode 100644 index 0000000000..f6747bf849 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/all.T @@ -0,0 +1,3 @@ +test('T9178', extra_clean(['T9178.o', 'T9178DataType.o', + 'T9178.hi', 'T9178DataType.hi']), + multimod_compile, ['T9178', '-Wall'])
\ No newline at end of file |