From 9f614270873135e9a3791085a486b665907a0d07 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 22 May 2024 22:04:33 +0900
Subject: [PATCH] Set package include paths when assembling .S files
Fixes #24839.
Co-authored-by: Sylvain Henry <hsyl20@gmail.com>
---
compiler/GHC/Driver/Pipeline/Execute.hs | 18 ++++++++++++------
testsuite/tests/driver/T24839.hs | 8 ++++++++
testsuite/tests/driver/T24839.stdout | 1 +
testsuite/tests/driver/all.T | 1 +
testsuite/tests/driver/t24839_sub.S | 10 ++++++++++
5 files changed, 32 insertions(+), 6 deletions(-)
create mode 100644 testsuite/tests/driver/T24839.hs
create mode 100644 testsuite/tests/driver/T24839.stdout
create mode 100644 testsuite/tests/driver/t24839_sub.S
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index c0479f5735e2..64ff838aa23e 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/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]
diff --git a/testsuite/tests/driver/T24839.hs b/testsuite/tests/driver/T24839.hs
new file mode 100644
index 000000000000..a444e8dfb9d1
--- /dev/null
+++ b/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
diff --git a/testsuite/tests/driver/T24839.stdout b/testsuite/tests/driver/T24839.stdout
new file mode 100644
index 000000000000..34a9c2116c79
--- /dev/null
+++ b/testsuite/tests/driver/T24839.stdout
@@ -0,0 +1 @@
+24839
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 6525a127d058..fec27e75b1d7 100644
--- a/testsuite/tests/driver/all.T
+++ b/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'])
diff --git a/testsuite/tests/driver/t24839_sub.S b/testsuite/tests/driver/t24839_sub.S
new file mode 100644
index 000000000000..4a5a28e98a41
--- /dev/null
+++ b/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
--
GitLab