[Git][ghc/ghc][wip/revert-optP] Revert "Pass preprocessor options to C compiler when building foreign C files (#16737)"

Matthew Pickering (@mpickering) gitlab at gitlab.haskell.org
Thu Sep 7 14:14:57 UTC 2023



Matthew Pickering pushed to branch wip/revert-optP at Glasgow Haskell Compiler / GHC


Commits:
d384d63a by Matthew Pickering at 2023-09-07T15:14:47+01:00
Revert "Pass preprocessor options to C compiler when building foreign C files (#16737)"

This reverts commit 1c18d3b41f897f34a93669edaebe6069f319f9e2.

`-optP` should pass options to the preprocessor, that might be a very
different program to the C compiler, so passing the options to the C
compiler is likely to result in `-optP` being useless.

Fixes #17185 and #21291

- - - - -


7 changed files:

- compiler/GHC/Driver/Pipeline/Execute.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Settings/Packages.hs
- − testsuite/tests/driver/T16737.hs
- − testsuite/tests/driver/T16737.stdout
- − testsuite/tests/driver/T16737include/T16737.h
- testsuite/tests/driver/all.T


Changes:

=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -411,19 +411,6 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
          includePathsQuoteImplicit cmdline_include_paths)
   let include_paths = include_paths_quote ++ include_paths_global
 
-  -- pass -D or -optP to preprocessor when compiling foreign C files
-  -- (#16737). Doing it in this way is simpler and also enable the C
-  -- compiler to perform preprocessing and parsing in a single pass,
-  -- but it may introduce inconsistency if a different pgm_P is specified.
-  let opts = getOpts dflags opt_P
-      aug_imports = augmentImports dflags opts
-
-      more_preprocessor_opts = concat
-        [ ["-Xpreprocessor", i]
-        | not hcc
-        , i <- aug_imports
-        ]
-
   let gcc_extra_viac_flags = extraGccViaCFlags dflags
   let pic_c_flags = picCCOpts dflags
 
@@ -512,7 +499,6 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
                  ++ [ "-include", ghcVersionH ]
                  ++ framework_paths
                  ++ include_paths
-                 ++ more_preprocessor_opts
                  ++ pkg_extra_cc_opts
                  ))
 


=====================================
hadrian/src/Rules/BinaryDist.hs
=====================================
@@ -509,8 +509,8 @@ createVersionWrapper pkg versioned_exe install_path = do
         | otherwise = 0
 
   cmd ghcPath (["-no-hs-main", "-o", install_path, "-I"++version_wrapper_dir
-              , "-DEXE_PATH=\"" ++ versioned_exe ++ "\""
-              , "-DINTERACTIVE_PROCESS=" ++ show interactive
+              , "-optc-DEXE_PATH=\"" ++ versioned_exe ++ "\""
+              , "-optc-DINTERACTIVE_PROCESS=" ++ show interactive
               ] ++ wrapper_files)
 
 {-


=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -297,14 +297,11 @@ rtsPackageArgs = package rts ? do
     libzstdIncludeDir <- getSetting LibZstdIncludeDir
     libzstdLibraryDir <- getSetting LibZstdLibDir
 
+
     -- Arguments passed to GHC when compiling C and .cmm sources.
     let ghcArgs = mconcat
           [ arg "-Irts"
           , arg $ "-I" ++ path
-          , arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
-          -- Set the namespace for the rts fs functions
-          , arg $ "-DFS_NAMESPACE=rts"
-          , arg $ "-DCOMPILING_RTS"
           , notM targetSupportsSMP           ? arg "-DNOSMP"
           , way `elem` [debug, debugDynamic] ? pure [ "-DTICKY_TICKY"
                                                     , "-optc-DTICKY_TICKY"]
@@ -333,9 +330,16 @@ rtsPackageArgs = package rts ? do
                                                     , "-fno-omit-frame-pointer"
                                                     , "-g3"
                                                     , "-O0" ]
+          -- Set the namespace for the rts fs functions
+          , arg $ "-DFS_NAMESPACE=rts"
+
+          , arg $ "-DCOMPILING_RTS"
 
           , inputs ["**/RtsMessages.c", "**/Trace.c"] ?
-            arg ("-DProjectVersion=" ++ show projectVersion)
+            pure
+              ["-DProjectVersion=" ++ show projectVersion
+              , "-DRtsWay=\"rts_" ++ show way ++ "\""
+              ]
 
           , input "**/RtsUtils.c" ? pure
             [ "-DProjectVersion="            ++ show projectVersion
@@ -353,6 +357,7 @@ rtsPackageArgs = package rts ? do
             , "-DTargetVendor="              ++ show targetVendor
             , "-DGhcUnregisterised="         ++ show ghcUnreg
             , "-DTablesNextToCode="          ++ show ghcEnableTNC
+            , "-DRtsWay=\"rts_" ++ show way ++ "\""
             ]
 
           -- We're after pur performance here. So make sure fast math and


=====================================
testsuite/tests/driver/T16737.hs deleted
=====================================
@@ -1,32 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -DFOO=2 -optP=-DBAR=3 -optc=-DBAZ=5 -optcxx=-DBAZ=7 #-}
-
-import Language.Haskell.TH.Syntax
-
-do
-  let code = unlines
-        [ "#if defined(__cplusplus)"
-        , "extern \"C\" {"
-        , "#endif"
-        , "#include <T16737.h>"
-        , "int FUN(void) {"
-        , "  return FOO * BAR * BAZ;"
-        , "}"
-        , "#if defined(__cplusplus)"
-        , "}"
-        , "#endif"
-        ]
-  addForeignSource LangC code
-  addForeignSource LangCxx code
-  pure []
-
-foreign import ccall unsafe "c_value"
-  c_value :: IO Int
-
-foreign import ccall unsafe "cxx_value"
-  cxx_value :: IO Int
-
-main :: IO ()
-main = do
-  print =<< c_value
-  print =<< cxx_value


=====================================
testsuite/tests/driver/T16737.stdout deleted
=====================================
@@ -1,2 +0,0 @@
-30
-42


=====================================
testsuite/tests/driver/T16737include/T16737.h deleted
=====================================
@@ -1,7 +0,0 @@
-#pragma once
-
-#if defined(__cplusplus)
-#define FUN cxx_value
-#else
-#define FUN c_value
-#endif


=====================================
testsuite/tests/driver/all.T
=====================================
@@ -285,12 +285,6 @@ test('inline-check', [omit_ways(['hpc', 'profasm'])]
 test('T14452', js_broken(22261), makefile_test, [])
 test('T14923', normal, makefile_test, [])
 test('T15396', normal, compile_and_run, ['-package ghc'])
-test('T16737',
-     [extra_files(['T16737include/']),
-      req_th,
-      req_c,
-      expect_broken_for(16541, ghci_ways)],
-     compile_and_run, ['-optP=-isystem -optP=T16737include'])
 
 test('T17143', exit_code(1), run_command, ['{compiler} T17143.hs -S -fno-code'])
 test('T17786', unless(opsys('mingw32'), skip), makefile_test, [])



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d384d63a6934d99801643d5c5b16c44389e41e19
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/20230907/2b07f189/attachment-0001.html>


More information about the ghc-commits mailing list