diff options
| -rw-r--r-- | compiler/deSugar/DsForeign.hs | 3 | ||||
| -rw-r--r-- | compiler/iface/FlagChecker.hs | 3 | ||||
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 26 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 42 | ||||
| -rw-r--r-- | docs/users_guide/8.6.1-notes.rst | 5 | ||||
| m--------- | utils/haddock | 0 |
6 files changed, 63 insertions, 16 deletions
diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs index 492d353cc0..a23c51b943 100644 --- a/compiler/deSugar/DsForeign.hs +++ b/compiler/deSugar/DsForeign.hs @@ -229,7 +229,8 @@ dsFCall fn_id co fcall mDeclHeader = do CApiConv safety) c = includes $$ fun_proto <+> braces (cRet <> semi) - includes = vcat [ text "#include <" <> ftext h <> text ">" + includes = vcat [ text "#include \"" <> ftext h + <> text "\"" | Header _ h <- nub headers ] fun_proto = cResType <+> pprCconv <+> ppr wrapperName <> parens argTypes cRet diff --git a/compiler/iface/FlagChecker.hs b/compiler/iface/FlagChecker.hs index f81b2652e8..1fc597bdfe 100644 --- a/compiler/iface/FlagChecker.hs +++ b/compiler/iface/FlagChecker.hs @@ -46,7 +46,8 @@ fingerprintDynFlags dflags@DynFlags{..} this_mod nameio = map fromEnum $ EnumSet.toList extensionFlags) -- -I, -D and -U flags affect CPP - cpp = (map normalise includePaths, opt_P dflags ++ picPOpts dflags) + cpp = ( map normalise $ flattenIncludes includePaths + , opt_P dflags ++ picPOpts dflags) -- normalise: eliminate spurious differences due to "./foo" vs "foo" -- Note [path flags and recompilation] diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index c6c9f9e1f6..839f6d05a4 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -264,7 +264,7 @@ compileOne' m_tc_result mHscMessage old_paths = includePaths dflags1 prevailing_dflags = hsc_dflags hsc_env0 dflags = - dflags1 { includePaths = current_dir : old_paths + dflags1 { includePaths = addQuoteInclude old_paths [current_dir] , log_action = log_action prevailing_dflags , log_finaliser = log_finaliser prevailing_dflags } -- use the prevailing log_action / log_finaliser, @@ -989,8 +989,9 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0 -- the .hs files resides) to the include path, since this is -- what gcc does, and it's probably what you want. let current_dir = takeDirectory basename + new_includes = addQuoteInclude paths [current_dir] paths = includePaths dflags0 - dflags = dflags0 { includePaths = current_dir : paths } + dflags = dflags0 { includePaths = new_includes } setDynFlags dflags @@ -1157,8 +1158,11 @@ runPhase (RealPhase cc_phase) input_fn dflags -- files; this is the Value Add(TM) that using ghc instead of -- gcc gives you :) pkg_include_dirs <- liftIO $ getPackageIncludePath dflags pkgs - let include_paths = foldr (\ x xs -> ("-I" ++ x) : xs) [] - (cmdline_include_paths ++ pkg_include_dirs) + let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) [] + (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs) + let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) [] + (includePathsQuote cmdline_include_paths) + let include_paths = include_paths_quote ++ include_paths_global let gcc_extra_viac_flags = extraGccViaCFlags dflags let pic_c_flags = picCCOpts dflags @@ -1321,10 +1325,13 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags liftIO $ createDirectoryIfMissing True (takeDirectory output_fn) ccInfo <- liftIO $ getCompilerInfo dflags + let global_includes = [ SysTools.Option ("-I" ++ p) + | p <- includePathsGlobal cmdline_include_paths ] + let local_includes = [ SysTools.Option ("-iquote" ++ p) + | p <- includePathsQuote cmdline_include_paths ] let runAssembler inputFilename outputFilename = liftIO $ as_prog dflags - ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ] - + (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map SysTools.Option pic_c_flags @@ -1995,8 +2002,11 @@ doCpp dflags raw input_fn output_fn = do let cmdline_include_paths = includePaths dflags pkg_include_dirs <- getPackageIncludePath dflags [] - let include_paths = foldr (\ x xs -> "-I" : x : xs) [] - (cmdline_include_paths ++ pkg_include_dirs) + let include_paths_global = foldr (\ x xs -> ("-I" ++ x) : xs) [] + (includePathsGlobal cmdline_include_paths ++ pkg_include_dirs) + let include_paths_quote = foldr (\ x xs -> ("-iquote" ++ x) : xs) [] + (includePathsQuote cmdline_include_paths) + let include_paths = include_paths_quote ++ include_paths_global let verbFlags = getVerbFlags dflags diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index dc4967d136..e6b9cf6b93 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -164,7 +164,10 @@ module DynFlags ( CompilerInfo(..), -- * File cleanup - FilesToClean(..), emptyFilesToClean + FilesToClean(..), emptyFilesToClean, + + -- * Include specifications + IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes ) where #include "HsVersions.h" @@ -675,6 +678,33 @@ data WarnReason | ErrReason !(Maybe WarningFlag) deriving Show +-- | Used to differentiate the scope an include needs to apply to. +-- We have to split the include paths to avoid accidentally forcing recursive +-- includes since -I overrides the system search paths. See Trac #14312. +data IncludeSpecs + = IncludeSpecs { includePathsQuote :: [String] + , includePathsGlobal :: [String] + } + deriving Show + +-- | Append to the list of includes a path that shall be included using `-I` +-- when the C compiler is called. These paths override system search paths. +addGlobalInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addGlobalInclude spec paths = let f = includePathsGlobal spec + in spec { includePathsGlobal = f ++ paths } + +-- | Append to the list of includes a path that shall be included using +-- `-iquote` when the C compiler is called. These paths only apply when quoted +-- includes are used. e.g. #include "foo.h" +addQuoteInclude :: IncludeSpecs -> [String] -> IncludeSpecs +addQuoteInclude spec paths = let f = includePathsQuote spec + in spec { includePathsQuote = f ++ paths } + +-- | Concatenate and flatten the list of global and quoted includes returning +-- just a flat list of paths. +flattenIncludes :: IncludeSpecs -> [String] +flattenIncludes specs = includePathsQuote specs ++ includePathsGlobal specs + instance Outputable WarnReason where ppr = text . show @@ -874,7 +904,7 @@ data DynFlags = DynFlags { ldInputs :: [Option], - includePaths :: [String], + includePaths :: IncludeSpecs, libraryPaths :: [String], frameworkPaths :: [String], -- used on darwin only cmdlineFrameworks :: [String], -- ditto @@ -1727,7 +1757,7 @@ defaultDynFlags mySettings myLlvmTargets = dumpPrefix = Nothing, dumpPrefixForce = Nothing, ldInputs = [], - includePaths = [], + includePaths = IncludeSpecs [] [], libraryPaths = [], frameworkPaths = [], cmdlineFrameworks = [], @@ -2308,7 +2338,8 @@ setOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce setObjectDir f d = d { objectDir = Just f} setHiDir f d = d { hiDir = Just f} -setStubDir f d = d { stubDir = Just f, includePaths = f : includePaths d } +setStubDir f d = d { stubDir = Just f + , includePaths = addGlobalInclude (includePaths d) [f] } -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file -- \#included from the .hc file when compiling via C (i.e. unregisterised -- builds). @@ -5052,7 +5083,8 @@ addLibraryPath p = upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p}) addIncludePath p = - upd (\s -> s{includePaths = includePaths s ++ splitPathList p}) + upd (\s -> s{includePaths = + addGlobalInclude (includePaths s) (splitPathList p)}) addFrameworkPath p = upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p}) diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst index 8f7e961b4f..80beb6c74a 100644 --- a/docs/users_guide/8.6.1-notes.rst +++ b/docs/users_guide/8.6.1-notes.rst @@ -34,6 +34,9 @@ Language Compiler ~~~~~~~~ +- GHC now no longer adds the current file's directory as a general include path + calling the C compiler. Instead we use :ghc-flag:`-iquote` to only add it as + an include path for `#include ""`. See :ghc-ticket:`14312`. Runtime system ~~~~~~~~~~~~~~ @@ -45,7 +48,7 @@ Runtime system - The GHC runtime linker now uses ``LIBRARY_PATH`` and the runtime loader now also searches ``LD_LIBRARY_PATH``. - + Template Haskell ~~~~~~~~~~~~~~~~ diff --git a/utils/haddock b/utils/haddock -Subproject 06fc4934e96bd2e647496ec0082d6ef362328f6 +Subproject 4804e39144dc0ded9b38dbb3442b6016ac719a1 |