Better error messages for new per-instance overlap flags and Safe
authorDavid Terei <code@davidterei.com>
Mon, 4 Aug 2014 16:49:07 +0000 (12:49 -0400)
committerDavid Terei <code@davidterei.com>
Thu, 6 Nov 2014 19:12:39 +0000 (11:12 -0800)
Haskell.

compiler/main/HscMain.hs
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered13.stderr
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered14.stderr
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered15.stderr
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered16.hs [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered16.stderr [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/all.T

index 3f4af8d..bec66f8 100644 (file)
@@ -1025,13 +1025,21 @@ markUnsafe tcg_env whyUnsafe = do
     whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!"
                          , text "Reason:"
                          , nest 4 $ (vcat $ badFlags df) $+$
-                                    (vcat $ pprErrMsgBagWithLoc whyUnsafe)
+                                    (vcat $ pprErrMsgBagWithLoc whyUnsafe) $+$
+                                    (vcat $ badInsts $ tcg_insts tcg_env)
                          ]
     badFlags df   = concat $ map (badFlag df) unsafeFlagsForInfer
     badFlag df (str,loc,on,_)
         | on df     = [mkLocMessage SevOutput (loc df) $
                             text str <+> text "is not allowed in Safe Haskell"]
         | otherwise = []
+    badInsts insts = concat $ map badInst insts
+    badInst ins | overlapMode (is_flag ins) /= NoOverlap
+                = [mkLocMessage SevOutput (nameSrcSpan $ getName $ is_dfun ins) $
+                      ppr (overlapMode $ is_flag ins) <+>
+                      text "overlap mode isn't allowed in Safe Haskell"]
+                | otherwise = []
+
 
 -- | Figure out the final correct safe haskell mode
 hscGetSafeMode :: TcGblEnv -> Hsc SafeHaskellMode
index c545d40..30be0ec 100644 (file)
@@ -2,6 +2,8 @@
 UnsafeInfered13.hs:1:16: Warning:
     ‘UnsafeInfered13’ has been inferred as unsafe!
     Reason:
+        UnsafeInfered13.hs:8:27:
+            [overlap ok] overlap mode isn't allowed in Safe Haskell
 
 <no location info>: 
 Failing due to -Werror.
index b7c41ac..80d9526 100644 (file)
@@ -2,6 +2,8 @@
 UnsafeInfered14.hs:1:16: Warning:
     ‘UnsafeInfered14’ has been inferred as unsafe!
     Reason:
+        UnsafeInfered14.hs:8:31:
+            [overlappable] overlap mode isn't allowed in Safe Haskell
 
 <no location info>: 
 Failing due to -Werror.
index dbf2094..44a0202 100644 (file)
@@ -2,6 +2,8 @@
 UnsafeInfered15.hs:1:16: Warning:
     ‘UnsafeInfered15’ has been inferred as unsafe!
     Reason:
+        UnsafeInfered15.hs:8:30:
+            [overlapping] overlap mode isn't allowed in Safe Haskell
 
 <no location info>: 
 Failing due to -Werror.
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered16.hs b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered16.hs
new file mode 100644 (file)
index 0000000..2df6576
--- /dev/null
@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -fwarn-unsafe -Werror #-}
+{-# LANGUAGE FlexibleInstances #-}
+module UnsafeInfered15 where
+
+class C a where
+  f :: a -> String
+
+instance {-# OVERLAPPING #-} C a where
+  f _ = "a"
+
+instance {-# OVERLAPS #-} C Int where
+  f _ = "Int"
+
+instance {-# OVERLAPPABLE #-} C Bool where
+  f _ = "Bool"
+
diff --git a/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered16.stderr b/testsuite/tests/safeHaskell/safeInfered/UnsafeInfered16.stderr
new file mode 100644 (file)
index 0000000..21674c4
--- /dev/null
@@ -0,0 +1,13 @@
+
+UnsafeInfered16.hs:1:16: Warning:
+    ‘UnsafeInfered15’ has been inferred as unsafe!
+    Reason:
+        UnsafeInfered16.hs:8:30:
+            [overlapping] overlap mode isn't allowed in Safe Haskell
+        UnsafeInfered16.hs:11:27:
+            [overlap ok] overlap mode isn't allowed in Safe Haskell
+        UnsafeInfered16.hs:14:31:
+            [overlappable] overlap mode isn't allowed in Safe Haskell
+
+<no location info>: 
+Failing due to -Werror.
index 887ff68..a9600fa 100644 (file)
@@ -63,6 +63,7 @@ test('UnsafeInfered12', normal, compile_fail, [''])
 test('UnsafeInfered13', normal, compile_fail, [''])
 test('UnsafeInfered14', normal, compile_fail, [''])
 test('UnsafeInfered15', normal, compile_fail, [''])
+test('UnsafeInfered16', normal, compile_fail, [''])
 
 # Mixed tests
 test('Mixed01', normal, compile_fail, [''])