Commit eecef173 authored by David Terei's avatar David Terei

Fix safe haskell bug: instances in safe-inferred

Instances in Safe Inferred modules weren't marked being marked as coming
from a Safe module.
parent 53409a7b
......@@ -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,
......
......@@ -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
......
......@@ -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
......
......@@ -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 }
{-
************************************************************************
* *
......
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])
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fwarn-safe #-}
module SafeInfered05_A where
class C a where
......
......@@ -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',
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment