[Git][ghc/ghc][master] Include CPP preprocessor dependencies in -M output
Marge Bot
gitlab at gitlab.haskell.org
Tue May 21 21:01:12 UTC 2019
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
8fc654c3 by David Eichmann at 2019-05-21T20:57:37Z
Include CPP preprocessor dependencies in -M output
Issue #16521
- - - - -
10 changed files:
- compiler/main/DriverMkDepend.hs
- compiler/main/DynFlags.hs
- docs/users_guide/separate_compilation.rst
- + testsuite/tests/driver/T16521/A.hs
- + testsuite/tests/driver/T16521/Makefile
- + testsuite/tests/driver/T16521/a.h
- + testsuite/tests/driver/T16521/all.T
- + testsuite/tests/driver/T16521/b.h
- + testsuite/tests/driver/T16521/b2.h
- + testsuite/tests/driver/T16521/check.sh
Changes:
=====================================
compiler/main/DriverMkDepend.hs
=====================================
@@ -41,6 +41,7 @@ import System.IO
import System.IO.Error ( isEOFError )
import Control.Monad ( when )
import Data.Maybe ( isJust )
+import Data.IORef
-----------------------------------------------------------------
--
@@ -85,7 +86,7 @@ doMkDependHS srcs = do
-- Print out the dependencies if wanted
liftIO $ debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
- -- Prcess them one by one, dumping results into makefile
+ -- Process them one by one, dumping results into makefile
-- and complaining about cycles
hsc_env <- getSession
root <- liftIO getCurrentDirectory
@@ -224,6 +225,18 @@ processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node)
-- Something like A.o : A.hs
; writeDependency root hdl obj_files src_file
+ -- Emit a dependency for each CPP import
+ ; when (depIncludeCppDeps dflags) $ do
+ -- CPP deps are descovered in the module parsing phase by parsing
+ -- comment lines left by the preprocessor.
+ -- Note that GHC.parseModule may throw an exception if the module
+ -- fails to parse, which may not be desirable (see #16616).
+ { session <- Session <$> newIORef hsc_env
+ ; parsedMod <- reflectGhc (GHC.parseModule node) session
+ ; mapM_ (writeDependency root hdl obj_files)
+ (GHC.pm_extra_src_files parsedMod)
+ }
+
-- Emit a dependency for each import
; let do_imps is_boot idecls = sequence_
=====================================
compiler/main/DynFlags.hs
=====================================
@@ -1022,6 +1022,7 @@ data DynFlags = DynFlags {
-- For ghc -M
depMakefile :: FilePath,
depIncludePkgDeps :: Bool,
+ depIncludeCppDeps :: Bool,
depExcludeMods :: [ModuleName],
depSuffixes :: [String],
@@ -2010,6 +2011,7 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
-- ghc -M values
depMakefile = "Makefile",
depIncludePkgDeps = False,
+ depIncludeCppDeps = False,
depExcludeMods = [],
depSuffixes = [],
-- end of ghc -M values
@@ -2684,6 +2686,9 @@ addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s
setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = f }
+setDepIncludeCppDeps :: Bool -> DynFlags -> DynFlags
+setDepIncludeCppDeps b d = d { depIncludeCppDeps = b }
+
setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
@@ -3100,6 +3105,8 @@ dynamic_flags_deps = [
-------- ghc -M -----------------------------------------------------
, make_ord_flag defGhcFlag "dep-suffix" (hasArg addDepSuffix)
, make_ord_flag defGhcFlag "dep-makefile" (hasArg setDepMakefile)
+ , make_ord_flag defGhcFlag "include-cpp-deps"
+ (noArg (setDepIncludeCppDeps True))
, make_ord_flag defGhcFlag "include-pkg-deps"
(noArg (setDepIncludePkgDeps True))
, make_ord_flag defGhcFlag "exclude-module" (hasArg addDepExcludeMod)
=====================================
docs/users_guide/separate_compilation.rst
=====================================
@@ -1425,6 +1425,20 @@ generation are:
imported by the home package module. This option is normally only
used by the various system libraries.
+.. ghc-flag:: -include-cpp-deps
+ :shortdesc: Include preprocessor dependencies
+ :type: dynamic
+ :category:
+
+ Output preprocessor dependencies. This only has an effect when the CPP
+ language extension is enabled. These dependencies are files included with
+ the ``#include`` preprocessor directive (as well as transitive includes) and
+ implicitly included files such as standard c preprocessor headers and a GHC
+ version header. One exception to this is that GHC generates a temporary
+ header file (during compilation) containing package version macros. As this
+ is only a temporary file that GHC will always generate, it is not output as
+ a dependency.
+
.. _orphan-modules:
Orphan modules and instance declarations
=====================================
testsuite/tests/driver/T16521/A.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE CPP #-}
+
+module A where
+
+#include "a.h"
+#include "b.h"
+
+-- Test including a header from an external package.
+#include "processFlags.h"
+
+main :: IO ()
+main = do
+ putStrLn a
+ putStrLn b
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/Makefile
=====================================
@@ -0,0 +1,9 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T16521 :
+ rm -f Makefile.out
+ '$(TEST_HC)' $(TEST_HC_OPTS) -package process -M -include-cpp-deps -dep-suffix "" -dep-makefile Makefile1.out A.hs 2>&1 > /dev/null
+ '$(TEST_HC)' $(TEST_HC_OPTS) -package process -M -include-cpp-deps -dep-suffix "" -dep-suffix "_" -dep-makefile Makefile2.out A.hs 2>&1 > /dev/null
+ ./check.sh
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/a.h
=====================================
@@ -0,0 +1 @@
+a = "a"
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/all.T
=====================================
@@ -0,0 +1,7 @@
+test('T16521', extra_files( \
+ [ 'A.hs' \
+ , 'a.h' \
+ , 'b.h' \
+ , 'b2.h' \
+ , 'check.sh'
+ ]), makefile_test, [])
=====================================
testsuite/tests/driver/T16521/b.h
=====================================
@@ -0,0 +1,2 @@
+#include "b2.h"
+b = "b" ++ b2
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/b2.h
=====================================
@@ -0,0 +1 @@
+b2 = "bb"
\ No newline at end of file
=====================================
testsuite/tests/driver/T16521/check.sh
=====================================
@@ -0,0 +1,33 @@
+#! /bin/sh
+
+checkDups() {
+ # Check for duplicate lines
+ if [ $(uniq $1 -d | wc -l) -ne 0 ]
+ then
+ echo "Duplicate dependencies:"
+ uniq $1 -d
+ fi
+}
+
+expectDep() {
+ if ! grep -q $1 "$2" $3
+ then
+ echo "Missing: \"$2\""
+ fi
+}
+
+checkDups Makefile1.out
+expectDep -F "A.o : A.hs" Makefile1.out
+expectDep -F "A.o : a.h" Makefile1.out
+expectDep -F "A.o : b.h" Makefile1.out
+expectDep -F "A.o : b2.h" Makefile1.out
+expectDep "" "A\.o : .*/ghcversion.h" Makefile1.out
+expectDep "" "A\.o : .*/processFlags.h" Makefile1.out
+
+checkDups Makefile2.out
+expectDep -F "A._o A.o : A.hs" Makefile2.out
+expectDep -F "A._o A.o : a.h" Makefile2.out
+expectDep -F "A._o A.o : b.h" Makefile2.out
+expectDep -F "A._o A.o : b2.h" Makefile2.out
+expectDep "" "A\._o A\.o : .*/ghcversion.h" Makefile2.out
+expectDep "" "A\._o A\.o : .*/processFlags.h" Makefile2.out
\ No newline at end of file
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8fc654c3a00ab0cd842c3e8316f832170ea561d6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8fc654c3a00ab0cd842c3e8316f832170ea561d6
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/20190521/cd712491/attachment-0001.html>
More information about the ghc-commits
mailing list