Commit eb2daa2b authored by Tamar Christina's avatar Tamar Christina Committed by Ben Gamari

Change how includes for input file directory works

GHC Used to only allow for one include mode, namely `-I`.  The problem
with `-I` includes is that it supercedes all other includes, including
the system include paths.

This is not a problem for paths requested by the user, but it is a
problem for the ones we implicitly derive and add.

In particular we add the source directory of the input file to the
include path. This is problematic because it causes any file with the
name of a system include, to inadvertently loop as the wrong file gets
included.

Since this is an implicitly include, and as far as I can tell, only done
so local includes are found (as the sources given to GCC reside in a
temp folder) then switch from `-I` to `-iquote`.

This requires a submodule update for haddock

Test Plan: ./validate

Reviewers: austin, bgamari, hvr

Reviewed By: bgamari

Subscribers: carter, rwbarton, thomie

GHC Trac Issues: #14312

Differential Revision: https://phabricator.haskell.org/D4080
parent 71294f30
......@@ -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
......
......@@ -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]
......
......@@ -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
......
......@@ -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})
......
......@@ -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
~~~~~~~~~~~~~~~~
......
Subproject commit 06fc4934e96bd2e647496ec0082d6ef362328f64
Subproject commit 4804e39144dc0ded9b38dbb3442b6016ac719a1a
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment