diff options
| author | David Terei <code@davidterei.com> | 2014-08-01 18:49:43 -0700 |
|---|---|---|
| committer | David Terei <code@davidterei.com> | 2014-08-01 18:59:35 -0700 |
| commit | fbd0586ea55c753f6c81b592ae01e88e22f8f0cd (patch) | |
| tree | 9d48d5c48a20a2d3b2623cd2850d1057a72724d3 | |
| parent | 105602f47f84ad17a87c68491effd0ba59ea1df6 (diff) | |
| download | haskell-fbd0586ea55c753f6c81b592ae01e88e22f8f0cd.tar.gz | |
Infer safety of modules correctly with new overlapping pragmas.
5 files changed, 37 insertions, 1 deletions
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 6ff8a2b0cf..2b123ffab6 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -424,6 +424,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls ; when (safeInferOn dflags) $ forM_ local_infos $ \x -> case x of _ | typInstCheck x -> recordUnsafeInfer _ | genInstCheck x -> recordUnsafeInfer + _ | overlapCheck x -> recordUnsafeInfer _ -> return () ; return ( gbl_env @@ -450,6 +451,8 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls ptext (sLit "Replace the following instance:")) 2 (pprInstanceHdr (iSpec i)) + overlapCheck ty = overlapMode (is_flag $ iSpec ty) `elem` + [Overlappable, Overlapping, Overlaps] genInstCheck ty = is_cls_nm (iSpec ty) `elem` genericClassNames genInstErr i = hang (ptext (sLit $ "Generic instances can only be " ++ "derived in Safe Haskell.") $+$ diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs new file mode 100644 index 0000000000..defc3a5243 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -fwarn-unsafe -Werror #-} +{-# LANGUAGE FlexibleInstances #-} +module UnsafeInfered13 where + +class C a where + f :: a -> String + +instance {-# OVERLAPS #-} C a where + f _ = "a" + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs new file mode 100644 index 0000000000..5b9f64210f --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -fwarn-unsafe -Werror #-} +{-# LANGUAGE FlexibleInstances #-} +module UnsafeInfered14 where + +class C a where + f :: a -> String + +instance {-# OVERLAPPABLE #-} C a where + f _ = "a" + diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs new file mode 100644 index 0000000000..427c97b0ac --- /dev/null +++ b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.hs @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -fwarn-unsafe -Werror #-} +{-# LANGUAGE FlexibleInstances #-} +module UnsafeInfered15 where + +class C a where + f :: a -> String + +instance {-# OVERLAPPING #-} C a where + f _ = "a" + diff --git a/testsuite/tests/safeHaskell/safeInfered/all.T b/testsuite/tests/safeHaskell/safeInfered/all.T index 47e9656279..9fb587b5f7 100644 --- a/testsuite/tests/safeHaskell/safeInfered/all.T +++ b/testsuite/tests/safeHaskell/safeInfered/all.T @@ -56,8 +56,11 @@ 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 should fail as unsafe and we made warn unsafe + -Werror test('UnsafeInfered12', normal, compile_fail, ['']) +test('UnsafeInfered13', normal, compile_fail, ['']) +test('UnsafeInfered14', normal, compile_fail, ['']) +test('UnsafeInfered15', normal, compile_fail, ['']) # Mixed tests test('Mixed01', normal, compile_fail, ['']) |