Fix safe haskell bug: instances in safe-inferred

Instances in Safe Inferred modules weren't marked being marked as coming
from a Safe module.

7 files changed, 36 insertions, 8 deletions

diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index e4181b9bdb..c8e3f64b03 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 49f86fd58b..9a2cd35c91 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 79c6dca5ef..d6aa2273dc 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 f576e335e5..5507e60e51 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 0000000000..10e70c409c
--- /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 a1e12a6526..c9e5c964cb 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 12e80a7fde..9fb4b2c4ea 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',