[Git][ghc/ghc][master] Set package include paths when assembling .S files

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
9f614270 by ARATA Mizuki at 2024-06-02T14:02:35-04:00
Set package include paths when assembling .S files

Fixes #24839.

Co-authored-by: Sylvain Henry <hsyl20 at gmail.com>

- - - - -


5 changed files:

- compiler/GHC/Driver/Pipeline/Execute.hs
- + testsuite/tests/driver/T24839.hs
- + testsuite/tests/driver/T24839.stdout
- testsuite/tests/driver/all.T
- + testsuite/tests/driver/t24839_sub.S


Changes:

=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -290,6 +290,7 @@ runGenericAsPhase :: (Logger -> DynFlags -> [Option] -> IO ()) -> [Option] -> Bo
 runGenericAsPhase run_as extra_opts with_cpp pipe_env hsc_env location input_fn = do
         let dflags     = hsc_dflags   hsc_env
         let logger     = hsc_logger   hsc_env
+        let unit_env   = hsc_unit_env hsc_env
 
         let cmdline_include_paths = includePaths dflags
         let pic_c_flags = picCCOpts dflags
@@ -300,16 +301,21 @@ runGenericAsPhase run_as extra_opts with_cpp pipe_env hsc_env location input_fn
         -- might be a hierarchical module.
         createDirectoryIfMissing True (takeDirectory output_fn)
 
-        let global_includes = [ GHC.SysTools.Option ("-I" ++ p)
-                              | p <- includePathsGlobal cmdline_include_paths ]
-        let local_includes = [ GHC.SysTools.Option ("-iquote" ++ p)
-                             | p <- includePathsQuote cmdline_include_paths ++
-                                includePathsQuoteImplicit cmdline_include_paths]
+        -- add package include paths
+        all_includes <- if not with_cpp
+          then pure []
+          else do
+            pkg_include_dirs <- mayThrowUnitErr (collectIncludeDirs <$> preloadUnitsInfo unit_env)
+            let global_includes = [ GHC.SysTools.Option ("-I" ++ p)
+                                  | p <- includePathsGlobal cmdline_include_paths ++ pkg_include_dirs]
+            let local_includes = [ GHC.SysTools.Option ("-iquote" ++ p)
+                                 | p <- includePathsQuote cmdline_include_paths ++ includePathsQuoteImplicit cmdline_include_paths]
+            pure (local_includes ++ global_includes)
         let runAssembler inputFilename outputFilename
               = withAtomicRename outputFilename $ \temp_outputFilename ->
                     run_as
                        logger dflags
-                       (local_includes ++ global_includes
+                       (all_includes
                        -- See Note [-fPIC for assembler]
                        ++ map GHC.SysTools.Option pic_c_flags
                        -- See Note [Produce big objects on Windows]


=====================================
testsuite/tests/driver/T24839.hs
=====================================
@@ -0,0 +1,8 @@
+import Data.Int
+import Foreign.Ptr
+import Foreign.Storable
+
+foreign import ccall "&" foo :: Ptr Int64
+
+main :: IO ()
+main = peek foo >>= print


=====================================
testsuite/tests/driver/T24839.stdout
=====================================
@@ -0,0 +1 @@
+24839


=====================================
testsuite/tests/driver/all.T
=====================================
@@ -327,3 +327,4 @@ test('T23339B', [extra_files(['T23339.hs']), req_c], makefile_test, [])
 test('T23613', normal, compile_and_run, ['-this-unit-id=foo'])
 test('T23944', [unless(have_dynamic(), skip), extra_files(['T23944A.hs'])], multimod_compile, ['T23944 T23944A', '-fprefer-byte-code -fbyte-code -fno-code -dynamic-too -fwrite-interface'])
 test('T24286', [cxx_src, unless(have_profiling(), skip), extra_files(['T24286.cpp'])], compile, ['-prof -no-hs-main'])
+test('T24839', [unless(arch('x86_64') or arch('aarch64'), skip), extra_files(["t24839_sub.S"])], compile_and_run, ['t24839_sub.S'])


=====================================
testsuite/tests/driver/t24839_sub.S
=====================================
@@ -0,0 +1,10 @@
+/* Note that the filename must begin with a lowercase letter, because GHC thinks it as a module name otherwise. */
+#include "ghcconfig.h"
+#if LEADING_UNDERSCORE
+    .globl _foo
+_foo:
+#else
+    .globl foo
+foo:
+#endif
+    .quad 24839



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f614270873135e9a3791085a486b665907a0d07

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f614270873135e9a3791085a486b665907a0d07
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/20240602/b04e8473/attachment-0001.html>