[Git][ghc/ghc][wip/t25150] driver: Fix -working-dir for foreign files

[Zubin (@wz1000)]

Zubin pushed to branch wip/t25150 at Glasgow Haskell Compiler / GHC


Commits:
37e03564 by Matthew Pickering at 2024-09-24T14:50:16+05:30
driver: Fix -working-dir for foreign files

-working-dir definitely needs more serious testing, there are some easy
ways to test this.

* Modify Cabal to call ghc using -working-dir rather than changing
  directory.
* Modify the testsuite to run ghc using `-working-dir` rather than
  running GHC with cwd = temporary directory.

However this will have to wait until after 9.12.

Fixes #25150

- - - - -


5 changed files:

- compiler/GHC/Driver/Pipeline.hs
- testsuite/tests/driver/all.T
- testsuite/tests/driver/multipleHomeUnits/unitCFile
- + testsuite/tests/driver/t25150/dir/Main.hs
- + testsuite/tests/driver/t25150/dir/a.c


Changes:

=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -544,28 +544,28 @@ oneShot orig_hsc_env stop_phase srcs = do
 
 compileFile :: HscEnv -> StopPhase -> (FilePath, Maybe Phase) -> IO (Maybe FilePath)
 compileFile hsc_env stop_phase (src, mb_phase) = do
-   exists <- doesFileExist src
+   let offset_file = augmentByWorkingDirectory dflags src
+       dflags    = hsc_dflags hsc_env
+       mb_o_file = outputFile dflags
+       ghc_link  = ghcLink dflags      -- Set by -c or -no-link
+       notStopPreprocess | StopPreprocess <- stop_phase = False
+                         | _              <- stop_phase = True
+       -- When linking, the -o argument refers to the linker's output.
+       -- otherwise, we use it as the name for the pipeline's output.
+       output
+        | not (backendGeneratesCode (backend dflags)), notStopPreprocess = NoOutputFile
+               -- avoid -E -fno-code undesirable interactions. see #20439
+        | NoStop <- stop_phase, not (isNoLink ghc_link) = Persistent
+               -- -o foo applies to linker
+        | isJust mb_o_file = SpecificFile
+               -- -o foo applies to the file we are compiling now
+        | otherwise = Persistent
+       pipe_env = mkPipeEnv stop_phase offset_file mb_phase output
+       pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) offset_file mb_phase
+
+   exists <- doesFileExist offset_file
    when (not exists) $
-        throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src))
-
-   let
-        dflags    = hsc_dflags hsc_env
-        mb_o_file = outputFile dflags
-        ghc_link  = ghcLink dflags      -- Set by -c or -no-link
-        notStopPreprocess | StopPreprocess <- stop_phase = False
-                          | _              <- stop_phase = True
-        -- When linking, the -o argument refers to the linker's output.
-        -- otherwise, we use it as the name for the pipeline's output.
-        output
-         | not (backendGeneratesCode (backend dflags)), notStopPreprocess = NoOutputFile
-                -- avoid -E -fno-code undesirable interactions. see #20439
-         | NoStop <- stop_phase, not (isNoLink ghc_link) = Persistent
-                -- -o foo applies to linker
-         | isJust mb_o_file = SpecificFile
-                -- -o foo applies to the file we are compiling now
-         | otherwise = Persistent
-        pipe_env = mkPipeEnv stop_phase src mb_phase output
-        pipeline = pipelineStart pipe_env (setDumpPrefix pipe_env hsc_env) src mb_phase
+        throwGhcExceptionIO (CmdLineError ("does not exist: " ++ offset_file))
    runPipeline (hsc_hooks hsc_env) pipeline
 
 


=====================================
testsuite/tests/driver/all.T
=====================================
@@ -328,3 +328,4 @@ 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'])
+test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -working-dir t25150/dir a.c'])


=====================================
testsuite/tests/driver/multipleHomeUnits/unitCFile
=====================================
@@ -1 +1 @@
--working-dir c-file C c-file/c.c -Iinclude
+-working-dir c-file C c.c -Iinclude


=====================================
testsuite/tests/driver/t25150/dir/Main.hs
=====================================
@@ -0,0 +1,6 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Main where
+foreign import ccall "hello"
+  hello :: IO ()
+main :: IO ()
+main = hello


=====================================
testsuite/tests/driver/t25150/dir/a.c
=====================================
@@ -0,0 +1,5 @@
+// dir/Aux.c
+#include <stdio.h>
+void hello() {
+   printf("hi");
+}



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37e035642a934407f4bafbc9efc722e45061a69f

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37e035642a934407f4bafbc9efc722e45061a69f
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/20240924/a71724ce/attachment-0001.html>