diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 375dc6ff1eaf014bbe605eaa96a976a9521a45d6..fc5ad45181666a6bb54506f8d96a3e82a19854ba 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -30,8 +30,7 @@ test('3279', normal, compile_and_run, ['']) test('3429', extra_run_opts('+RTS -C0.001 -RTS'), compile_and_run, ['']) # without -O, goes into an infinite loop -# GHCi cannot deterct the infinite loop, because the thread is always reachable -# (see also conc033 and others). We should really fix this. +# GHCi does not detect the infinite loop. We should really fix this. test('4030', omit_ways('ghci'), compile_and_run, ['-O']) # each of these runs for about a second @@ -41,8 +40,7 @@ test('throwto002', [reqlib('random')], compile_and_run, ['']) test('throwto003', normal, compile_and_run, ['']) test('mask001', normal, compile_and_run, ['']) -# ghci does not generate the BlockedIndefinitely exceptions, so omit: -test('mask002', omit_ways(['ghci']), compile_and_run, ['']) +test('mask002', normal, compile_and_run, ['']) test('async001', normal, compile_and_run, ['']) @@ -110,8 +108,7 @@ test('conc019', compose(only_compiler_types(['ghc']), extra_run_opts('+RTS -K16m -RTS')), compile_and_run, ['']) test('conc020', only_compiler_types(['ghc']), compile_and_run, ['']) -test('conc021', compose(omit_ways(['ghci']), exit_code(1)), - compile_and_run, ['']) +test('conc021', [ omit_ways(['ghci']), exit_code(1) ], compile_and_run, ['']) test('conc022', only_compiler_types(['ghc']), compile_and_run, ['']) # On Windows, the non-threaded RTS creates a real OS thread for each @@ -141,9 +138,7 @@ test('conc030', compose(only_compiler_types(['ghc']), test('conc031', normal, compile_and_run, ['']) test('conc032', only_compiler_types(['ghc']), compile_and_run, ['']) - -# Omit for GHCi, because it just sits there waiting for you to press ^C -test('conc033', omit_ways(['ghci']), compile_and_run, ['']) +test('conc033', normal, compile_and_run, ['']) # Omit for GHCi, because it just sits there waiting for you to press ^C test('conc034', compose(only_compiler_types(['ghc']), diff --git a/testsuite/tests/ghci/scripts/T5975a.script b/testsuite/tests/ghci/scripts/T5975a.script new file mode 100644 index 0000000000000000000000000000000000000000..ea0d64948b12e3dcd88320c81ff2d585ee4a9cc5 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T5975a.script @@ -0,0 +1 @@ +:load föøbàr.hs diff --git a/testsuite/tests/ghci/scripts/T5975b.script b/testsuite/tests/ghci/scripts/T5975b.script new file mode 100644 index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index b4541d644563d731a0899ee3d6e886ed801fa709..2a49c9c11289c2dd2fe48940767ebad61dd8c1ec 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -1,3 +1,4 @@ +# coding=utf8 setTestOpts(if_compiler_profiled(skip)) @@ -113,4 +114,12 @@ 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', normal, ghci_script, ['T5979.script']) +test('T5979', normalise_slashes, ghci_script, ['T5979.script']) +test('T5975a', + [pre_cmd('touch föøbàr.hs'), + clean_cmd('rm föøbàr.hs')], + ghci_script, ['T5975a.script']) +test('T5975b', + [pre_cmd('touch föøbàr.hs'), + clean_cmd('rm föøbàr.hs')], + ghci_script, ['T5975b.script']) diff --git a/testsuite/tests/indexed-types/should_fail/T5934.hs b/testsuite/tests/indexed-types/should_fail/T5934.hs new file mode 100644 index 0000000000000000000000000000000000000000..2af0b9788724495f6c29c25ef626331969ffe62d --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T5934.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE RankNTypes, TypeFamilies, KindSignatures #-} + +module T5934 where +import Control.Monad.ST + +data Gen s +type GenST s = Gen (PrimState (ST s)) + +run :: (forall s. GenST s) -> Int +run = 0 + +type family PrimState (m :: * -> *) diff --git a/testsuite/tests/indexed-types/should_fail/T5934.stderr b/testsuite/tests/indexed-types/should_fail/T5934.stderr new file mode 100644 index 0000000000000000000000000000000000000000..4ec24d3cc901d1b4e8bb6287da7ec0b85091acde --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T5934.stderr @@ -0,0 +1,8 @@ + +T5934.hs:10:7: + No instance for (Num ((forall s. GenST s) -> Int)) + arising from the literal `0' + Possible fix: + add an instance declaration for (Num ((forall s. GenST s) -> Int)) + In the expression: 0 + In an equation for `run': run = 0 diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 1f8f99ac234dcf7c68ad53f878f351d886caa621..d3e691f0b0cc14513b30601ebfc3ac7ea3799be1 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -74,3 +74,5 @@ test('T5439', normal, compile_fail, ['']) test('T5515', normal, compile_fail, ['']) test('T5763', expect_broken(5673), compile_fail, ['']) +test('T5934', normal, compile_fail, ['']) + diff --git a/testsuite/tests/polykinds/T5948.hs b/testsuite/tests/polykinds/T5948.hs new file mode 100644 index 0000000000000000000000000000000000000000..06dfc4c793f6124dd76044dd18ff6d642b9b0626 --- /dev/null +++ b/testsuite/tests/polykinds/T5948.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DataKinds, TypeOperators #-} + +module T5948 where + +type Foo = (Int ': '[]) + +type Bar = Int ': '[] diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 218ad437f6f93efcef4f34711c2f71c1bfb0f9c9..3676c8de4df515110718c5d8fc19fb7aed3636c7 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -32,3 +32,4 @@ test('T5716', normal, compile_fail, ['']) test('T5937', normal, compile, ['']) test('T5935', normal, compile, ['']) test('T5938', normal, compile, ['']) +test('T5948', normal, compile, ['']) diff --git a/testsuite/tests/rts/5993.hs b/testsuite/tests/rts/5993.hs new file mode 100644 index 0000000000000000000000000000000000000000..25626ffa749987f99adc94663e7412bb8a07842d --- /dev/null +++ b/testsuite/tests/rts/5993.hs @@ -0,0 +1,6 @@ +import Control.Concurrent +main = do + m <- newEmptyMVar + forkIO $ putStrLn "Hello World!" >> putMVar m () + takeMVar m + diff --git a/testsuite/tests/rts/5993.stdout b/testsuite/tests/rts/5993.stdout new file mode 100644 index 0000000000000000000000000000000000000000..980a0d5f19a64b4b30a87d4206aade58726b60e3 --- /dev/null +++ b/testsuite/tests/rts/5993.stdout @@ -0,0 +1 @@ +Hello World! diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index d79b62e443dcc819dc0931a2dfdb21575c873017..f1a7ae6a80ff5ce1e1dd30b0fdc6c19b923cdcc8 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -129,3 +129,4 @@ test('T5423', run_command, ['$MAKE -s --no-print-directory T5423']) +test('5993', extra_run_opts('+RTS -k8 -RTS'), compile_and_run, ['']) diff --git a/testsuite/tests/safeHaskell/check/Check09.stderr b/testsuite/tests/safeHaskell/check/Check09.stderr index e3b752d554027b6f792f72b67f8f1fb46739a3e5..71cc3cddcf4e00cc6ee7c1c5b53b3d5c421a2b4b 100644 --- a/testsuite/tests/safeHaskell/check/Check09.stderr +++ b/testsuite/tests/safeHaskell/check/Check09.stderr @@ -1,3 +1,4 @@ Check09.hs:4:1: - bytestring-0.10.0.0:Data.ByteString.Char8 can't be safely imported! The package (bytestring-0.10.0.0) the module resides in isn't trusted. + Data.ByteString.Char8: Can't be safely imported! + The package (bytestring-0.10.0.0) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/ghci/p11.stderr b/testsuite/tests/safeHaskell/ghci/p11.stderr index 0d33615020811ca53c6a74cabbb909f8a063f212..9ff951a7bc13d942351dfe426cd40e474e88b3b6 100644 --- a/testsuite/tests/safeHaskell/ghci/p11.stderr +++ b/testsuite/tests/safeHaskell/ghci/p11.stderr @@ -1,3 +1,4 @@ E.hs:3:1: - base:System.IO.Unsafe can't be safely imported! The module itself isn't safe. + System.IO.Unsafe: Can't be safely imported! + The module itself isn't safe. diff --git a/testsuite/tests/safeHaskell/ghci/p12.stderr b/testsuite/tests/safeHaskell/ghci/p12.stderr index c97035e7ab2ea915ed7b88b22eb6458bde026281..4df01fd599370cd6160fd5a7fcfbc0d05db2b27a 100644 --- a/testsuite/tests/safeHaskell/ghci/p12.stderr +++ b/testsuite/tests/safeHaskell/ghci/p12.stderr @@ -1,3 +1,4 @@ : - bytestring-0.10.0.0:Data.ByteString can't be safely imported! The package (bytestring-0.10.0.0) the module resides in isn't trusted. + Data.ByteString: Can't be safely imported! + The package (bytestring-0.10.0.0) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/ghci/p17.stderr b/testsuite/tests/safeHaskell/ghci/p17.stderr index c97035e7ab2ea915ed7b88b22eb6458bde026281..4df01fd599370cd6160fd5a7fcfbc0d05db2b27a 100644 --- a/testsuite/tests/safeHaskell/ghci/p17.stderr +++ b/testsuite/tests/safeHaskell/ghci/p17.stderr @@ -1,3 +1,4 @@ : - bytestring-0.10.0.0:Data.ByteString can't be safely imported! The package (bytestring-0.10.0.0) the module resides in isn't trusted. + Data.ByteString: Can't be safely imported! + The package (bytestring-0.10.0.0) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/ghci/p3.stderr b/testsuite/tests/safeHaskell/ghci/p3.stderr index 62aca4e2c04b21326fdc30db30bf0e38ece4196e..8e4ee4018ce67cf3b406b785dacce29d68c82646 100644 --- a/testsuite/tests/safeHaskell/ghci/p3.stderr +++ b/testsuite/tests/safeHaskell/ghci/p3.stderr @@ -1,6 +1,8 @@ : - base:System.IO.Unsafe can't be safely imported! The module itself isn't safe. + System.IO.Unsafe: Can't be safely imported! + The module itself isn't safe. : - bytestring-0.10.0.0:Data.ByteString can't be safely imported! The package (bytestring-0.10.0.0) the module resides in isn't trusted. + Data.ByteString: Can't be safely imported! + The package (bytestring-0.10.0.0) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr index 89c9cf175900fd48c3c37dc5bde363bb0184dd80..1c9b945b967fef2fe67ca8770aa3fc81a64d8ddb 100644 --- a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered11.stderr @@ -1,9 +1,9 @@ [1 of 2] Compiling UnsafeInfered11_A ( UnsafeInfered11_A.hs, UnsafeInfered11_A.o ) -UnsafeInfered11_A.hs:1:16: - Warning: `UnsafeInfered11_A' has been infered as unsafe! +UnsafeInfered11_A.hs:1:16: Warning: + `UnsafeInfered11_A' has been infered as unsafe! Reason: - UnsafeInfered11_A.hs:17:11: + UnsafeInfered11_A.hs:17:11: Warning: Rule "lookupx/T" ignored User defined rules are disabled under Safe Haskell [2 of 2] Compiling UnsafeInfered11 ( UnsafeInfered11.hs, UnsafeInfered11.o ) diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.hs new file mode 100644 index 0000000000000000000000000000000000000000..a39b46e2a073a4f12685e60e1f5d9204be91bdf8 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fwarn-unsafe -Werror #-} +module UnsafeInfered12 where + +a :: Int +a = 1 + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr new file mode 100644 index 0000000000000000000000000000000000000000..1fa0d526c80224fb9ecdd24e278bbfcd5867e7af --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered12.stderr @@ -0,0 +1,9 @@ + +UnsafeInfered12.hs:2:16: Warning: + `UnsafeInfered12' has been infered as unsafe! + Reason: + UnsafeInfered12.hs:1:14: + -XTemplateHaskell is not allowed in Safe Haskell + +: +Failing due to -Werror. diff --git a/testsuite/tests/safeHaskell/safeInfered/all.T b/testsuite/tests/safeHaskell/safeInfered/all.T index a685a79b6b9648bf0042f54937b2b6d94c2caf83..dee056a614e8f93413b444c6d51dd0aadc717b2d 100644 --- a/testsuite/tests/safeHaskell/safeInfered/all.T +++ b/testsuite/tests/safeHaskell/safeInfered/all.T @@ -56,6 +56,9 @@ test('UnsafeInfered11', [ extra_clean(['UnsafeInfered11_A.hi', 'UnsafeInfered11_A.o']) ], multimod_compile_fail, ['UnsafeInfered11', '']) +# test should fail as unsafe and we made warn unsafe + -Werror +test('UnsafeInfered12', normal, compile_fail, ['']) + # Mixed tests test('Mixed01', normal, compile_fail, ['']) test('Mixed02', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_compile/PolytypeDecomp.hs b/testsuite/tests/typecheck/should_compile/PolytypeDecomp.hs new file mode 100644 index 0000000000000000000000000000000000000000..69e4fb31c72799a46e22361de210a4ab1509bf59 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/PolytypeDecomp.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE TypeFamilies, LiberalTypeSynonyms, ImpredicativeTypes #-} +module PolyTypeDecomp where + + +{- The purpose of this test is to check if decomposition of wanted + equalities in the /constraint solver/ (vs. the unifier) works properly. + Unfortunately most equalities between polymorphic types are converted to + implication constraints early on in the unifier, so we have to make things + a bit more convoluted by introducing the myLength function. The wanted + constraints we get for this program are: + [forall a. Maybe a] ~ Id alpha + [forall a. F [a]] ~ Id alpha + Which, /after reactions/ should create a fresh implication: + forall a. Maybe a ~ F [a] + that is perfectly soluble. +-} + +type family F a +type instance F [a] = Maybe a + +type family Id a +type instance Id a = a + +f :: [forall a. F [a]] +f = undefined + + +g :: [forall a. Maybe a] -> Int +g x = myLength [x,f] + +myLength :: [Id a] -> Int +myLength = undefined diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 5fcd89fb1332fe53964f4ea884919c518257dda1..918d5c8c2ee9f3f7d2a1d9b8d53d5afb58c3b48c 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -375,3 +375,5 @@ test('T3108', normal, compile, ['']) test('T5792',normal,run_command, ['$MAKE -s --no-print-directory T5792']) + +test('PolytypeDecomp', normal, compile, ['']) \ No newline at end of file diff --git a/testsuite/tests/typecheck/should_fail/T6001.hs b/testsuite/tests/typecheck/should_fail/T6001.hs new file mode 100644 index 0000000000000000000000000000000000000000..fd918aa598a5bd47e848c0c2ed06f80505df59f2 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T6001.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE InstanceSigs #-} + +module T6001 where + +data DayKind = Work | Rest + +instance Num DayKind where + fromInteger :: Int -> DayKind + fromInteger = undefined diff --git a/testsuite/tests/typecheck/should_fail/T6001.stderr b/testsuite/tests/typecheck/should_fail/T6001.stderr new file mode 100644 index 0000000000000000000000000000000000000000..7fe591d54fc1bd886fe9d0482f4ee54d45123f2e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T6001.stderr @@ -0,0 +1,5 @@ + +T6001.hs:8:18: + Method signature does not match class; it should be + fromInteger :: Integer -> DayKind + In the instance declaration for `Num DayKind' diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index caf92fb01149b1b05c5f6956ee3a39b14f08b242..e0f95bf238c5c726ce5facb14289a57588928ce0 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -272,3 +272,4 @@ test('T5689', normal, compile_fail, ['']) test('T5684', normal, compile_fail, ['']) test('T5858', normal, compile_fail, ['']) test('T5957', normal, compile_fail, ['']) +test('T6001', normal, compile_fail, [''])