[commit: ghc] master: Fix safe haskell bug: instances in safe-inferred (eecef17)
git at git.haskell.org
git at git.haskell.org
Tue May 12 01:20:37 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/eecef1733d5de342383665943b955bc1c96472f4/ghc
>---------------------------------------------------------------
commit eecef1733d5de342383665943b955bc1c96472f4
Author: David Terei <code at davidterei.com>
Date: Sat Aug 2 13:37:26 2014 -0700
Fix safe haskell bug: instances in safe-inferred
Instances in Safe Inferred modules weren't marked being marked as coming
from a Safe module.
>---------------------------------------------------------------
eecef1733d5de342383665943b955bc1c96472f4
compiler/deSugar/Desugar.hs | 4 ++--
compiler/iface/MkIface.hs | 2 +-
compiler/main/GHC.hs | 5 +++--
compiler/typecheck/TcRnMonad.hs | 7 +++++++
.../safeHaskell/safeInfered/SafeInfered05.stderr | 19 +++++++++++++++++++
.../tests/safeHaskell/safeInfered/SafeInfered05_A.hs | 1 +
testsuite/tests/safeHaskell/safeInfered/all.T | 6 +++---
7 files changed, 36 insertions(+), 8 deletions(-)
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index e4181b9..c8e3f64 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -14,7 +14,7 @@ import DynFlags
import HscTypes
import HsSyn
import TcRnTypes
-import TcRnMonad ( finalSafeMode )
+import TcRnMonad ( finalSafeMode, fixSafeInstances )
import MkIface
import Id
import Name
@@ -179,7 +179,7 @@ deSugar hsc_env
mg_warns = warns,
mg_anns = anns,
mg_tcs = tcs,
- mg_insts = insts,
+ mg_insts = fixSafeInstances safe_mode insts,
mg_fam_insts = fam_insts,
mg_inst_env = inst_env,
mg_fam_inst_env = fam_inst_env,
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 49f86fd..9a2cd35 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -272,7 +272,7 @@ mkIface_ hsc_env maybe_old_fingerprint
fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
warns = src_warns
iface_rules = map (coreRuleToIfaceRule this_mod) rules
- iface_insts = map instanceToIfaceInst insts
+ iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts
iface_fam_insts = map famInstToIfaceFamInst fam_insts
iface_vect_info = flattenVectInfo vect_info
trust_info = setSafeMode safe_mode
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 79c6dca..d6aa227 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -295,7 +295,7 @@ import HscMain
import GhcMake
import DriverPipeline ( compileOne' )
import GhcMonad
-import TcRnMonad ( finalSafeMode )
+import TcRnMonad ( finalSafeMode, fixSafeInstances )
import TcRnTypes
import Packages
import NameSet
@@ -887,6 +887,7 @@ typecheckModule pmod = do
hpm_annotations = pm_annotations pmod }
details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
safe <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env
+
return $
TypecheckedModule {
tm_internals_ = (tc_gbl_env, details),
@@ -898,7 +899,7 @@ typecheckModule pmod = do
minf_type_env = md_types details,
minf_exports = availsToNameSet $ md_exports details,
minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
- minf_instances = md_insts details,
+ minf_instances = fixSafeInstances safe $ md_insts details,
minf_iface = Nothing,
minf_safe = safe
#ifdef GHCI
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index f576e33..5507e60 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -1304,6 +1304,13 @@ finalSafeMode dflags tcg_env = do
| otherwise -> Sf_None
s -> s
+-- | Switch instances to safe instances if we're in Safe mode.
+fixSafeInstances :: SafeHaskellMode -> [ClsInst] -> [ClsInst]
+fixSafeInstances sfMode | sfMode /= Sf_Safe = id
+fixSafeInstances _ = map fixSafe
+ where fixSafe inst = let new_flag = (is_flag inst) { isSafeOverlap = True }
+ in inst { is_flag = new_flag }
+
{-
************************************************************************
* *
diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr
new file mode 100644
index 0000000..10e70c4
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05.stderr
@@ -0,0 +1,19 @@
+
+SafeInfered05.hs:2:14: Warning:
+ -XOverlappingInstances is deprecated: instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS
+[1 of 2] Compiling SafeInfered05_A ( SafeInfered05_A.hs, SafeInfered05_A.o )
+
+SafeInfered05_A.hs:2:16: Warning:
+ ‘SafeInfered05_A’ has been inferred as safe!
+[2 of 2] Compiling SafeInfered05 ( SafeInfered05.hs, SafeInfered05.o )
+
+SafeInfered05.hs:31:9:
+ Unsafe overlapping instances for C [Int] arising from a use of ‘f’
+ The matching instance is:
+ instance [safe] C [Int] -- Defined at SafeInfered05_A.hs:8:10
+ It is compiled in a Safe module and as such can only
+ overlap instances from the same module, however it
+ overlaps the following instances from different modules:
+ instance [overlap ok] C [a] -- Defined at SafeInfered05.hs:27:10
+ In the expression: f ([1, 2, 3, 4] :: [Int])
+ In an equation for ‘test2’: test2 = f ([1, 2, 3, 4] :: [Int])
diff --git a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs
index a1e12a6..c9e5c96 100644
--- a/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs
+++ b/testsuite/tests/safeHaskell/safeInfered/SafeInfered05_A.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -fwarn-safe #-}
module SafeInfered05_A where
class C a where
diff --git a/testsuite/tests/safeHaskell/safeInfered/all.T b/testsuite/tests/safeHaskell/safeInfered/all.T
index 12e80a7..9fb4b2c 100644
--- a/testsuite/tests/safeHaskell/safeInfered/all.T
+++ b/testsuite/tests/safeHaskell/safeInfered/all.T
@@ -22,9 +22,9 @@ test('SafeInfered04',
multimod_compile, ['SafeInfered04', ''])
# Test should fail, tests an earlier bug in 7.8
-# test('SafeInfered05',
-# [ extra_clean(['SafeInfered05_A.hi', 'SafeInfered05_A.o']) ],
-# multimod_compile_fail, ['SafeInfered05', ''])
+test('SafeInfered05',
+ [ extra_clean(['SafeInfered05_A.hi', 'SafeInfered05_A.o']) ],
+ multimod_compile_fail, ['SafeInfered05', ''])
# Tests that should fail to compile as they should be infered unsafe
test('UnsafeInfered01',
More information about the ghc-commits
mailing list