Improve missing-sig warning
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 12 Aug 2016 14:52:07 +0000 (15:52 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 12 Aug 2016 16:34:12 +0000 (17:34 +0100)
Fixes Trac #12484

compiler/rename/RnNames.hs
testsuite/tests/patsyn/should_compile/T11213.stderr
testsuite/tests/patsyn/should_compile/T12484.hs [new file with mode: 0644]
testsuite/tests/patsyn/should_compile/T12484.stderr [new file with mode: 0644]
testsuite/tests/patsyn/should_compile/all.T
testsuite/tests/patsyn/should_fail/T11053.stderr

index 51a231c..f0c7bb9 100644 (file)
@@ -1604,27 +1604,29 @@ warnMissingSignatures gbl_env
                        (mapM_ add_bind_warn binds)
                 where
                   add_pat_syn_warn p
-                    = add_warn (patSynName p) (pprPatSynType p)
+                    = add_warn name $
+                      hang (text "Pattern synonym with no type signature:")
+                         2 (text "pattern" <+> pprPrefixName name <+> dcolon <+> pp_ty)
+                    where
+                      name  = patSynName p
+                      pp_ty = pprPatSynType p
 
                   add_bind_warn id
                     = do { env <- tcInitTidyEnv     -- Why not use emptyTidyEnv?
                          ; let name    = idName id
                                (_, ty) = tidyOpenType env (idType id)
                                ty_msg  = ppr ty
-                         ; add_warn name ty_msg }
+                         ; add_warn name $
+                           hang (text "Top-level binding with no type signature:")
+                              2 (pprPrefixName name <+> dcolon <+> ty_msg) }
 
-                  add_warn name ty_msg
+                  add_warn name msg
                     = when (name `elemNameSet` sig_ns && export_check name)
-                           (addWarnAt (Reason flag) (getSrcSpan name)
-                                                    (get_msg name ty_msg))
+                           (addWarnAt (Reason flag) (getSrcSpan name) msg)
 
                   export_check name
                     = not warn_only_exported || name `elemNameSet` exports
 
-                  get_msg name ty_msg
-                    = sep [ text "Top-level binding with no type signature:",
-                            nest 2 $ pprPrefixName name <+> dcolon <+> ty_msg ]
-
        ; add_sig_warns }
 
 {-
index 72f67e3..9c438dd 100644 (file)
@@ -1,46 +1,51 @@
 
 T11213.hs:19:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature: P :: Bool
+    Pattern synonym with no type signature: pattern P :: Bool
 
 T11213.hs:20:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      Pe :: () => forall a. a -> Ex
+    Pattern synonym with no type signature:
+      pattern Pe :: () => forall a. a -> Ex
 
 T11213.hs:21:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature: Pu :: forall t. t -> t
+    Pattern synonym with no type signature:
+      pattern Pu :: forall t. t -> t
 
 T11213.hs:22:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      Pue :: forall a. () => forall a1. a -> a1 -> (a, Ex)
+    Pattern synonym with no type signature:
+      pattern Pue :: forall a. () => forall a1. a -> a1 -> (a, Ex)
 
 T11213.hs:23:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      Pur :: forall a. (Num a, Eq a) => a -> [a]
+    Pattern synonym with no type signature:
+      pattern Pur :: forall a. (Num a, Eq a) => a -> [a]
 
 T11213.hs:24:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      Purp :: forall a a1.
-              (Num a1, Eq a1) =>
-              Show a => a1 -> a -> ([a1], UnivProv a)
+    Pattern synonym with no type signature:
+      pattern Purp :: forall a a1.
+                      (Num a1, Eq a1) =>
+                      Show a => a1 -> a -> ([a1], UnivProv a)
 
 T11213.hs:25:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      Pure :: forall a. (Num a, Eq a) => forall a1. a -> a1 -> ([a], Ex)
+    Pattern synonym with no type signature:
+      pattern Pure :: forall a.
+                      (Num a, Eq a) =>
+                      forall a1. a -> a1 -> ([a], Ex)
 
 T11213.hs:26:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      Purep :: forall a.
-               (Num a, Eq a) =>
-               forall a1. Show a1 => a -> a1 -> ([a], ExProv)
+    Pattern synonym with no type signature:
+      pattern Purep :: forall a.
+                       (Num a, Eq a) =>
+                       forall a1. Show a1 => a -> a1 -> ([a], ExProv)
 
 T11213.hs:27:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      Pep :: () => forall a. Show a => a -> ExProv
+    Pattern synonym with no type signature:
+      pattern Pep :: () => forall a. Show a => a -> ExProv
 
 T11213.hs:28:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      Pup :: forall a. () => Show a => a -> UnivProv a
+    Pattern synonym with no type signature:
+      pattern Pup :: forall a. () => Show a => a -> UnivProv a
 
 T11213.hs:29:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      Puep :: forall b. () => forall a. Show a => a -> b -> (ExProv, b)
+    Pattern synonym with no type signature:
+      pattern Puep :: forall b.
+                      () =>
+                      forall a. Show a => a -> b -> (ExProv, b)
diff --git a/testsuite/tests/patsyn/should_compile/T12484.hs b/testsuite/tests/patsyn/should_compile/T12484.hs
new file mode 100644 (file)
index 0000000..833ac8c
--- /dev/null
@@ -0,0 +1,7 @@
+{-# OPTIONS_GHC -Wmissing-pattern-synonym-signatures #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module T12484 where
+
+pattern RP x = (x, True)
+
diff --git a/testsuite/tests/patsyn/should_compile/T12484.stderr b/testsuite/tests/patsyn/should_compile/T12484.stderr
new file mode 100644 (file)
index 0000000..d51b6fe
--- /dev/null
@@ -0,0 +1,4 @@
+
+T12484.hs:6:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
+    Pattern synonym with no type signature:
+      pattern RP :: forall a. a -> (a, Bool)
index f29e56e..78320c7 100644 (file)
@@ -56,4 +56,5 @@ test('T11727', normal, compile, [''])
 test('T11959', expect_broken(11959), multimod_compile, ['T11959', '-v0'])
 test('T12094', normal, compile, [''])
 test('T11977', normal, compile, [''])
-test('T12108', normal, compile, [''])
\ No newline at end of file
+test('T12108', normal, compile, [''])
+test('T12484', normal, compile, [''])
index 40dae30..5e50a91 100644 (file)
@@ -1,19 +1,19 @@
 
 T11053.hs:7:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature: T :: Bool
+    Pattern synonym with no type signature: pattern T :: Bool
 
 T11053.hs:9:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      J :: forall a. a -> Maybe a
+    Pattern synonym with no type signature:
+      pattern J :: forall a. a -> Maybe a
 
 T11053.hs:11:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      J1 :: forall a. a -> Maybe a
+    Pattern synonym with no type signature:
+      pattern J1 :: forall a. a -> Maybe a
 
 T11053.hs:13:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      J2 :: forall a. a -> Maybe a
+    Pattern synonym with no type signature:
+      pattern J2 :: forall a. a -> Maybe a
 
 T11053.hs:15:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
-    Top-level binding with no type signature:
-      J3 :: forall a. a -> Maybe a
+    Pattern synonym with no type signature:
+      pattern J3 :: forall a. a -> Maybe a