From 3b6382e443ed57d08dc676337621fc3d5cd0cb05 Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 9 Jul 2008 10:21:43 +0000
Subject: [PATCH] add -fwarn-dodgy-foreign-imports (see #1357)

From the entry in the User's guide:

-fwarn-dodgy-foreign-imports causes a warning to be emitted for
foreign imports of the following form:

foreign import "f" f :: FunPtr t

on the grounds that it probably should be

foreign import "&f" f :: FunPtr t

The first form declares that `f` is a (pure) C function that takes no
arguments and returns a pointer to a C function with type `t`, whereas
the second form declares that `f` itself is a C function with type
`t`.  The first declaration is usually a mistake, and one that is hard
to debug because it results in a crash, hence this warning.
---
 compiler/main/DynFlags.hs        |    5 ++++-
 compiler/typecheck/TcForeign.lhs |    9 +++++++++
 compiler/typecheck/TcType.lhs    |    4 ++++
 docs/users_guide/using.xml       |   30 ++++++++++++++++++++++++++++--
 4 files changed, 45 insertions(+), 3 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index f40ac43..e631cfa 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -174,6 +174,7 @@ data DynFlag
    | Opt_WarnDodgyImports
    | Opt_WarnOrphans
    | Opt_WarnTabs
+   | Opt_WarnDodgyForeignImports
 
    -- language opts
    | Opt_OverlappingInstances
@@ -754,7 +755,8 @@ standardWarnings
         Opt_WarnOverlappingPatterns,
         Opt_WarnMissingFields,
         Opt_WarnMissingMethods,
-        Opt_WarnDuplicateExports
+        Opt_WarnDuplicateExports,
+        Opt_WarnDodgyForeignImports
       ]
 
 minusWOpts :: [DynFlag]
@@ -1381,6 +1383,7 @@ deprecatedForLanguage lang turnOn =
 
 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
 fFlags = [
+  ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, const Supported ),
   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, const Supported ),
   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, const Supported ),
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, const Supported ),
diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 4f05fb7..bbf181c 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -154,6 +154,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ (CFunction t
       dflags <- getDOpts
       checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
       checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty
+      checkMissingAmpersand dflags arg_tys res_ty
       return idecl
 
 -- This makes a convenient place to check
@@ -163,6 +164,14 @@ checkCTarget (StaticTarget str) = do
     checkCg checkCOrAsmOrDotNetOrInterp
     check (isCLabelString str) (badCName str)
 checkCTarget DynamicTarget = panic "checkCTarget DynamicTarget"
+
+checkMissingAmpersand :: DynFlags -> [Type] -> Type -> TcM ()
+checkMissingAmpersand dflags arg_tys res_ty
+  | null arg_tys && isFunPtrTy res_ty &&
+    dopt Opt_WarnDodgyForeignImports dflags
+  = addWarn (ptext (sLit "possible missing & in foreign import of FunPtr"))
+  | otherwise
+  = return ()
 \end{code}
 
 On an Alpha, with foreign export dynamic, due to a giant hack when
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index 63ea4b1..5f07585 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -87,6 +87,7 @@ module TcType (
   isFFIDotnetTy,       -- :: DynFlags -> Type -> Bool
   isFFIDotnetObjTy,    -- :: Type -> Bool
   isFFITy,	       -- :: Type -> Bool
+  isFunPtrTy,          -- :: Type -> Bool
   tcSplitIOType_maybe, -- :: Type -> Maybe Type  
   toDNType,            -- :: Type -> DNType
 
@@ -1213,6 +1214,9 @@ isFFIDotnetObjTy ty
    (_, t_ty) = tcSplitForAllTys ty
    check_tc tc = getName tc == objectTyConName
 
+isFunPtrTy :: Type -> Bool
+isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
+
 toDNType :: Type -> DNType
 toDNType ty
   | isStringTy ty = DNString
diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
index d805097..3c19be5 100644
--- a/docs/users_guide/using.xml
+++ b/docs/users_guide/using.xml
@@ -844,8 +844,10 @@ ghc -c Foo.hs</screen>
     <option>-fwarn-deprecations</option>,
     <option>-fwarn-deprecated-flags</option>,
     <option>-fwarn-duplicate-exports</option>,
-    <option>-fwarn-missing-fields</option>, and
-    <option>-fwarn-missing-methods</option>.  The following flags are
+    <option>-fwarn-missing-fields</option>,
+    <option>-fwarn-missing-methods</option>, and
+    <option>-fwarn-dodgy-foreign-imports</option>.  The following
+    flags are
     simple ways to select standard &ldquo;packages&rdquo; of warnings:
     </para>
 
@@ -945,6 +947,30 @@ ghc -c Foo.hs</screen>
       </varlistentry>
 
       <varlistentry>
+	<term><option>-fwarn-dodgy-foreign-imports</option>:</term>
+	<listitem>
+	  <indexterm><primary><option>-fwarn-dodgy-foreign-imports</option></primary>
+	  </indexterm>
+	  <para>Causes a warning to be emitted for foreign imports of
+	  the following form:</para>
+<programlisting>
+foreign import "f" f :: FunPtr t
+</programlisting>
+          <para>on the grounds that it probably should be</para>
+<programlisting>
+foreign import "&amp;f" f :: FunPtr t
+</programlisting>
+          <para>The first form declares that `f` is a (pure) C
+          function that takes no arguments and returns a pointer to a
+          C function with type `t`, whereas the second form declares
+          that `f` itself is a C function with type `t`.  The first
+          declaration is usually a mistake, and one that is hard to
+          debug because it results in a crash, hence this
+          warning.</para>
+	</listitem>
+      </varlistentry>
+
+      <varlistentry>
 	<term><option>-fwarn-dodgy-imports</option>:</term>
 	<listitem>
 	  <indexterm><primary><option>-fwarn-dodgy-imports</option></primary>
-- 
1.7.10.4