[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Fix irrelevant dodgy-foreign-imports warning on import f-pointers by value

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
1f98ad2a by Alexey Radkov at 2024-01-30T16:11:37-05:00
Fix irrelevant dodgy-foreign-imports warning on import f-pointers by value

A test *сс018* is attached (not sure about the naming convention though).
Note that without the fix, the test fails with the *dodgy-foreign-imports*
warning passed to stderr. The warning disappears after the fix.

GHC shouldn't warn on imports of natural function pointers from C by value
(which is feasible with CApiFFI), such as

```haskell
foreign import capi "cc018.h value f" f :: FunPtr (Int -> IO ())
```

where

```c
void (*f)(int);
```

See a related real-world use-case
[here](https://gitlab.com/daniel-casanueva/pcre-light/-/merge_requests/17).
There, GHC warns on import of C function pointer `pcre_free`.

- - - - -
fb1a427e by Alexey Radkov at 2024-01-30T16:11:38-05:00
Rename test cc018 -> T24034

- - - - -
a2ab5a20 by Ben Gamari at 2024-01-30T16:11:38-05:00
rts/TraverseHeap.c: Ensure that PosixSource.h is included first
- - - - -


5 changed files:

- compiler/GHC/Tc/Gen/Foreign.hs
- rts/TraverseHeap.c
- + testsuite/tests/ffi/should_compile/T24034.h
- + testsuite/tests/ffi/should_compile/T24034.hs
- testsuite/tests/ffi/should_compile/all.T


Changes:

=====================================
compiler/GHC/Tc/Gen/Foreign.hs
=====================================
@@ -356,7 +356,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) (L ls safety) mh
       dflags <- getDynFlags
       checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
       checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
-      checkMissingAmpersand idecl (map scaledThing arg_tys) res_ty
+      checkMissingAmpersand idecl target (map scaledThing arg_tys) res_ty
       case target of
           StaticTarget _ _ _ False
            | not (null arg_tys) ->
@@ -373,8 +373,10 @@ checkCTarget idecl (StaticTarget _ str _ _) = do
 
 checkCTarget _ DynamicTarget = panic "checkCTarget DynamicTarget"
 
-checkMissingAmpersand :: ForeignImport GhcRn -> [Type] -> Type -> TcM ()
-checkMissingAmpersand idecl arg_tys res_ty
+checkMissingAmpersand :: ForeignImport GhcRn -> CCallTarget -> [Type] -> Type -> TcM ()
+checkMissingAmpersand _ (StaticTarget _ _ _ False) _ _ = return ()
+
+checkMissingAmpersand idecl _ arg_tys res_ty
   | null arg_tys && isFunPtrTy res_ty
   = addDiagnosticTc $ TcRnFunPtrImportWithoutAmpersand idecl
   | otherwise


=====================================
rts/TraverseHeap.c
=====================================
@@ -9,10 +9,10 @@
 
 #if defined(PROFILING)
 
-#include <string.h>
 #include "rts/PosixSource.h"
 #include "Rts.h"
 #include "sm/Storage.h"
+#include <string.h>
 
 #include "TraverseHeap.h"
 


=====================================
testsuite/tests/ffi/should_compile/T24034.h
=====================================
@@ -0,0 +1 @@
+void (*f)(int);


=====================================
testsuite/tests/ffi/should_compile/T24034.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE ForeignFunctionInterface, CApiFFI #-}
+module ShouldCompile where
+
+import Foreign
+foreign import capi "T24034.h value f" f :: FunPtr (Int -> IO ())


=====================================
testsuite/tests/ffi/should_compile/all.T
=====================================
@@ -47,3 +47,5 @@ test('T22043', normal, compile, [''])
 
 test('T22774', unless(js_arch(), expect_fail), compile, [''])
 
+test('T24034', normal, compile, [''])
+



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd2989052f9b0bca5935e67995fdec05d2da7cbb...a2ab5a206f1f21cc476d134301933457a1816cf0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fd2989052f9b0bca5935e67995fdec05d2da7cbb...a2ab5a206f1f21cc476d134301933457a1816cf0
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240130/44d51632/attachment-0001.html>