Warn for Safe Haskell when -XOverlappingInstances or
authorDavid Terei <code@davidterei.com>
Mon, 4 Aug 2014 21:43:09 +0000 (17:43 -0400)
committerDavid Terei <code@davidterei.com>
Thu, 6 Nov 2014 19:16:38 +0000 (11:16 -0800)
-XIncoherentInstances turned on.

compiler/main/DynFlags.hs
compiler/typecheck/TcInstDcls.lhs
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered16.hs
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered16.stderr
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.hs
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered17.stderr
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered18.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered18.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered19.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered19.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/all.T

index eb5bb77..0c6639a 100644 (file)
@@ -774,6 +774,7 @@ data DynFlags = DynFlags {
   thOnLoc               :: SrcSpan,
   newDerivOnLoc         :: SrcSpan,
   overlapInstLoc        :: SrcSpan,
+  incoherentOnLoc       :: SrcSpan,
   pkgTrustOnLoc         :: SrcSpan,
   warnSafeOnLoc         :: SrcSpan,
   warnUnsafeOnLoc       :: SrcSpan,
@@ -1461,6 +1462,7 @@ defaultDynFlags mySettings =
         thOnLoc = noSrcSpan,
         newDerivOnLoc = noSrcSpan,
         overlapInstLoc = noSrcSpan,
+        incoherentOnLoc = noSrcSpan,
         pkgTrustOnLoc = noSrcSpan,
         warnSafeOnLoc = noSrcSpan,
         warnUnsafeOnLoc = noSrcSpan,
@@ -1791,17 +1793,23 @@ combineSafeFlags a b | a == Sf_None         = return b
 --     * function to turn the flag off
 unsafeFlags, unsafeFlagsForInfer
   :: [(String, DynFlags -> SrcSpan, DynFlags -> Bool, DynFlags -> DynFlags)]
-unsafeFlags = [("-XGeneralizedNewtypeDeriving", newDerivOnLoc,
-                   xopt Opt_GeneralizedNewtypeDeriving,
-                   flip xopt_unset Opt_GeneralizedNewtypeDeriving),
-               ("-XTemplateHaskell", thOnLoc,
-                   xopt Opt_TemplateHaskell,
-                   flip xopt_unset Opt_TemplateHaskell)]
+unsafeFlags = [ ("-XGeneralizedNewtypeDeriving", newDerivOnLoc,
+                    xopt Opt_GeneralizedNewtypeDeriving,
+                    flip xopt_unset Opt_GeneralizedNewtypeDeriving)
+              , ("-XTemplateHaskell", thOnLoc,
+                    xopt Opt_TemplateHaskell,
+                    flip xopt_unset Opt_TemplateHaskell)
+              ]
 unsafeFlagsForInfer = unsafeFlags ++
               -- TODO: Can we do better than this for inference?
-              [("-XOverlappingInstances", overlapInstLoc,
+              [ ("-XOverlappingInstances", overlapInstLoc,
                   xopt Opt_OverlappingInstances,
-                  flip xopt_unset Opt_OverlappingInstances)]
+                  flip xopt_unset Opt_OverlappingInstances)
+              , ("-XIncoherentInstances", incoherentOnLoc,
+                  xopt Opt_IncoherentInstances,
+                  flip xopt_unset Opt_IncoherentInstances)
+              ]
+
 
 -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
 getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from
@@ -2881,7 +2889,7 @@ xFlags = [
   ( "ImplicitParams",                   Opt_ImplicitParams, nop ),
   ( "ImplicitPrelude",                  Opt_ImplicitPrelude, nop ),
   ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, nop),
-  ( "IncoherentInstances",              Opt_IncoherentInstances, nop ),
+  ( "IncoherentInstances",              Opt_IncoherentInstances, setIncoherentInsts  ),
   ( "InstanceSigs",                     Opt_InstanceSigs, nop ),
   ( "InterruptibleFFI",                 Opt_InterruptibleFFI, nop ),
   ( "JavaScriptFFI",                    Opt_JavaScriptFFI, nop ),
@@ -2904,9 +2912,7 @@ xFlags = [
   ( "NullaryTypeClasses",               Opt_NullaryTypeClasses,
                         deprecatedForExtension "MultiParamTypeClasses" ),
   ( "NumDecimals",                      Opt_NumDecimals, nop),
-  ( "OverlappingInstances",             Opt_OverlappingInstances,
-        \ turn_on -> when turn_on
-             $ deprecate "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS" ),
+  ( "OverlappingInstances",             Opt_OverlappingInstances, setOverlappingInsts),
   ( "OverloadedLists",                  Opt_OverloadedLists, nop),
   ( "OverloadedStrings",                Opt_OverloadedStrings, nop ),
   ( "PackageImports",                   Opt_PackageImports, nop ),
@@ -3226,6 +3232,19 @@ setGenDeriving :: TurnOnFlag -> DynP ()
 setGenDeriving True  = getCurLoc >>= \l -> upd (\d -> d { newDerivOnLoc = l })
 setGenDeriving False = return ()
 
+setOverlappingInsts :: TurnOnFlag -> DynP ()
+setOverlappingInsts False = return ()
+setOverlappingInsts True = do
+  l <- getCurLoc
+  upd (\d -> d { overlapInstLoc = l })
+  deprecate "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS"
+
+setIncoherentInsts :: TurnOnFlag -> DynP ()
+setIncoherentInsts False = return ()
+setIncoherentInsts True = do
+  l <- getCurLoc
+  upd (\d -> d { incoherentOnLoc = l })
+
 checkTemplateHaskellOk :: TurnOnFlag -> DynP ()
 #ifdef GHCI
 checkTemplateHaskellOk turn_on
index d22938e..ddb2e65 100644 (file)
@@ -432,8 +432,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
               -- (deriving can't be used there)
       && not (isHsBootOrSig (tcg_src env))
 
-    overlapCheck ty = overlapMode (is_flag $ iSpec ty) `elem`
-                        [Overlappable, Overlapping, Overlaps]
+    overlapCheck ty = overlapMode (is_flag $ iSpec ty) /= NoOverlap
     genInstCheck ty = is_cls_nm (iSpec ty) `elem` genericClassNames
     genInstErr i = hang (ptext (sLit $ "Generic instances can only be "
                             ++ "derived in Safe Haskell.") $+$
index 2df6576..b3e7f34 100644 (file)
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fwarn-unsafe -Werror #-}
 {-# LANGUAGE FlexibleInstances #-}
-module UnsafeInfered15 where
+module UnsafeInfered16 where
 
 class C a where
   f :: a -> String
index 21674c4..5ac27d3 100644 (file)
@@ -1,6 +1,6 @@
 
 UnsafeInfered16.hs:1:16: Warning:
-    ‘UnsafeInfered15’ has been inferred as unsafe!
+    ‘UnsafeInfered16’ has been inferred as unsafe!
     Reason:
         UnsafeInfered16.hs:8:30:
             [overlapping] overlap mode isn't allowed in Safe Haskell
index 04591b5..7f17a13 100644 (file)
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fwarn-unsafe -Werror #-}
 {-# LANGUAGE FlexibleInstances #-}
-module UnsafeInfered15 where
+module UnsafeInfered17 where
 
 class C a where
   f :: a -> String
index 415e9a1..aa43fbe 100644 (file)
@@ -1,6 +1,6 @@
 
 UnsafeInfered17.hs:1:16: Warning:
-    ‘UnsafeInfered15’ has been inferred as unsafe!
+    ‘UnsafeInfered17’ has been inferred as unsafe!
     Reason:
         UnsafeInfered17.hs:8:29:
             [incoherent] overlap mode isn't allowed in Safe Haskell
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered18.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered18.hs
new file mode 100644 (file)
index 0000000..a6dbfe1
--- /dev/null
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -fwarn-unsafe #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+module UnsafeInfered18 where
+
+class C a where
+  f :: a -> String
+
+instance C a where
+  f _ = "a"
+
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered18.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered18.stderr
new file mode 100644 (file)
index 0000000..0896ec5
--- /dev/null
@@ -0,0 +1,11 @@
+
+UnsafeInfered18.hs:3:14: Warning:
+    -XOverlappingInstances is deprecated: instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS
+
+UnsafeInfered18.hs:1:16: Warning:
+    ‘UnsafeInfered18’ has been inferred as unsafe!
+    Reason:
+        UnsafeInfered18.hs:3:14:
+            -XOverlappingInstances is not allowed in Safe Haskell
+        UnsafeInfered18.hs:9:10:
+            [overlap ok] overlap mode isn't allowed in Safe Haskell
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered19.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered19.hs
new file mode 100644 (file)
index 0000000..587bc4e
--- /dev/null
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE IncoherentInstances #-}
+module UnsafeInfered19 where
+
+class C a where
+  f :: a -> String
+
+instance C a where
+  f _ = "a"
+
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered19.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered19.stderr
new file mode 100644 (file)
index 0000000..002c950
--- /dev/null
@@ -0,0 +1,11 @@
+
+UnsafeInfered19.hs:1:16: Warning:
+    ‘UnsafeInfered19’ has been inferred as unsafe!
+    Reason:
+        UnsafeInfered19.hs:3:14:
+            -XIncoherentInstances is not allowed in Safe Haskell
+        UnsafeInfered19.hs:9:10:
+            [incoherent] overlap mode isn't allowed in Safe Haskell
+
+<no location info>: 
+Failing due to -Werror.
index 4fc9fce..c2222a3 100644 (file)
@@ -65,6 +65,8 @@ test('UnsafeInfered14', normal, compile_fail, [''])
 test('UnsafeInfered15', normal, compile_fail, [''])
 test('UnsafeInfered16', normal, compile_fail, [''])
 test('UnsafeInfered17', normal, compile_fail, [''])
+test('UnsafeInfered18', normal, compile, [''])
+test('UnsafeInfered19', normal, compile_fail, [''])
 
 # Mixed tests
 test('Mixed01', normal, compile_fail, [''])