summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Driver/Main.hs6
-rw-r--r--compiler/GHC/Driver/Make.hs1
-rw-r--r--compiler/GHC/Driver/Session.hs18
-rw-r--r--docs/users_guide/separate_compilation.rst10
-rw-r--r--ghc/Main.hs5
-rw-r--r--testsuite/tests/driver/T20348/A.hs6
-rw-r--r--testsuite/tests/driver/T20348/Makefile26
-rw-r--r--testsuite/tests/driver/T20348/T20348.stdout3
-rw-r--r--testsuite/tests/driver/T20348/all.T2
9 files changed, 67 insertions, 10 deletions
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 788c2bce1f..647ce0bf26 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -961,15 +961,15 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
-- mod_location only contains the base name, so we rebuild the
-- correct file extension from the dynflags.
baseName = ml_hi_file mod_location
- buildIfName suffix
- | Just name <- outputHi dflags
+ buildIfName suffix is_dynamic
+ | Just name <- (if is_dynamic then dynOutputHi else outputHi) dflags
= name
| otherwise
= let with_hi = replaceExtension baseName suffix
in addBootSuffix_maybe (mi_boot iface) with_hi
write_iface dflags' iface =
- let !iface_name = buildIfName (hiSuf dflags')
+ let !iface_name = buildIfName (hiSuf dflags') (dynamicNow dflags')
profile = targetProfile dflags'
in
{-# SCC "writeIface" #-}
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index ef5ce36fef..bb15a919b9 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -1679,6 +1679,7 @@ enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife bcknd
setOutputFile (Just o_file) $
setDynOutputFile (Just $ dynamicOutputFile dflags o_file) $
setOutputHi (Just hi_file) $
+ setDynOutputHi (Just $ dynamicOutputHi dflags hi_file) $
dflags {backend = bcknd}
}
pure (ExtendedModSummary ms' bkp_deps)
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 9c64535c77..a6f1a50382 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -38,7 +38,7 @@ module GHC.Driver.Session (
xopt_FieldSelectors,
lang_set,
DynamicTooState(..), dynamicTooState, setDynamicNow, setDynamicTooFailed,
- dynamicOutputFile,
+ dynamicOutputFile, dynamicOutputHi,
sccProfilingEnabled,
DynFlags(..),
outputFile, hiSuf, objectSuf, ways,
@@ -149,7 +149,7 @@ module GHC.Driver.Session (
initDynFlags, -- DynFlags -> IO DynFlags
defaultFatalMessager,
defaultFlushOut,
- setOutputFile, setDynOutputFile, setOutputHi,
+ setOutputFile, setDynOutputFile, setOutputHi, setDynOutputHi,
getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a]
getVerbFlags,
@@ -539,6 +539,7 @@ data DynFlags = DynFlags {
outputFile_ :: Maybe String,
dynOutputFile_ :: Maybe String,
outputHi :: Maybe String,
+ dynOutputHi :: Maybe String,
dynLibLoader :: DynLibLoader,
dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output
@@ -1061,9 +1062,10 @@ setDynamicTooFailed dflags =
-- | Compute the path of the dynamic object corresponding to an object file.
dynamicOutputFile :: DynFlags -> FilePath -> FilePath
-dynamicOutputFile dflags outputFile = dynOut outputFile
- where
- dynOut = flip addExtension (dynObjectSuf_ dflags) . dropExtension
+dynamicOutputFile dflags outputFile = outputFile -<.> dynObjectSuf_ dflags
+
+dynamicOutputHi :: DynFlags -> FilePath -> FilePath
+dynamicOutputHi dflags hi = hi -<.> dynHiSuf_ dflags
-----------------------------------------------------------------------------
@@ -1182,6 +1184,7 @@ defaultDynFlags mySettings llvmConfig =
outputFile_ = Nothing,
dynOutputFile_ = Nothing,
outputHi = Nothing,
+ dynOutputHi = Nothing,
dynLibLoader = SystemDependent,
dumpPrefix = Nothing,
dumpPrefixForce = Nothing,
@@ -1683,7 +1686,7 @@ setObjectDir, setHiDir, setHieDir, setStubDir, setDumpDir, setOutputDir,
addCmdlineFramework, addHaddockOpts, addGhciScript,
setInteractivePrint
:: String -> DynFlags -> DynFlags
-setOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce
+setOutputFile, setDynOutputFile, setOutputHi, setDynOutputHi, setDumpPrefixForce
:: Maybe String -> DynFlags -> DynFlags
setObjectDir f d = d { objectDir = Just f}
@@ -1712,6 +1715,7 @@ setHcSuf f d = d { hcSuf = f}
setOutputFile f d = d { outputFile_ = f}
setDynOutputFile f d = d { dynOutputFile_ = f}
setOutputHi f d = d { outputHi = f}
+setDynOutputHi f d = d { dynOutputHi = f}
parseUnitInsts :: String -> Instantiations
parseUnitInsts str = case filter ((=="").snd) (readP_to_S parse str) of
@@ -2203,6 +2207,8 @@ dynamic_flags_deps = [
(sepArg (setDynOutputFile . Just))
, make_ord_flag defGhcFlag "ohi"
(hasArg (setOutputHi . Just ))
+ , make_ord_flag defGhcFlag "dynohi"
+ (hasArg (setDynOutputHi . Just ))
, make_ord_flag defGhcFlag "osuf" (hasArg setObjectSuf)
, make_ord_flag defGhcFlag "dynosuf" (hasArg setDynObjectSuf)
, make_ord_flag defGhcFlag "hcsuf" (hasArg setHcSuf)
diff --git a/docs/users_guide/separate_compilation.rst b/docs/users_guide/separate_compilation.rst
index 64e6590942..b1f792d389 100644
--- a/docs/users_guide/separate_compilation.rst
+++ b/docs/users_guide/separate_compilation.rst
@@ -283,6 +283,14 @@ Redirecting the compilation output(s)
to redirect the interface into the bit bucket: ``-ohi /dev/null``,
for example.
+.. ghc-flag:: -dynohi ⟨file⟩
+ :shortdesc: set the filename in which to put the dynamic interface
+ :type: dynamic
+ :category:
+
+ When using ``-dynamic-too``, option ``-dynohi`` ⟨file⟩ is the counterpart
+ of ``-ohi``. It redirects the dynamic interface output to ⟨file⟩.
+
.. ghc-flag:: -hidir ⟨dir⟩
:shortdesc: set directory for interface files
:type: dynamic
@@ -333,7 +341,7 @@ Redirecting the compilation output(s)
:category:
The ``-outputdir`` option is shorthand for the combination of
- :ghc-flag:`-odir ⟨dir⟩`, :ghc-flag:`-hidir ⟨dir⟩`, :ghc-flag:`-hiedir ⟨dir⟩`,
+ :ghc-flag:`-odir ⟨dir⟩`, :ghc-flag:`-hidir ⟨dir⟩`, :ghc-flag:`-hiedir ⟨dir⟩`,
:ghc-flag:`-stubdir ⟨dir⟩` and :ghc-flag:`-dumpdir ⟨dir⟩`.
.. ghc-flag:: -osuf ⟨suffix⟩
diff --git a/ghc/Main.hs b/ghc/Main.hs
index b9b1265f1e..b1c45e9cc4 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -321,6 +321,11 @@ checkOptions mode dflags srcs objs = do
then throwGhcException (UsageError "-ohi can only be used when compiling a single source file")
else do
+ if (isJust (dynOutputHi dflags) &&
+ (isCompManagerMode mode || srcs `lengthExceeds` 1))
+ then throwGhcException (UsageError "-dynohi can only be used when compiling a single source file")
+ else do
+
-- -o sanity checking
if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
&& not (isLinkMode mode))
diff --git a/testsuite/tests/driver/T20348/A.hs b/testsuite/tests/driver/T20348/A.hs
new file mode 100644
index 0000000000..39fa816b5e
--- /dev/null
+++ b/testsuite/tests/driver/T20348/A.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module A where
+
+f :: Int -> Int
+f x = x + 10
diff --git a/testsuite/tests/driver/T20348/Makefile b/testsuite/tests/driver/T20348/Makefile
new file mode 100644
index 0000000000..e6903e4cc4
--- /dev/null
+++ b/testsuite/tests/driver/T20348/Makefile
@@ -0,0 +1,26 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+# Recompilation test for -fno-code -fwrite-interface with TemplateHaskell.
+
+checkExists = [ -f $1 ] || echo $1 missing
+
+clean:
+ rm -f *.o
+ rm -f *.hi
+ rm -f *.dyn_o
+ rm -f *.dyn_hi
+
+T20348: clean
+ # First run: should produce .hi, .o, .dyn_hi, .dyn_o files.
+ echo 'first run'
+ '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface A.hs
+ $(call checkExists,A.hi)
+ $(call checkExists,A.o)
+ $(call checkExists,A.dyn_hi)
+ $(call checkExists,A.dyn_o)
+
+ # Second run: should not recompile.
+ echo 'second run'
+ '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface A.hs
diff --git a/testsuite/tests/driver/T20348/T20348.stdout b/testsuite/tests/driver/T20348/T20348.stdout
new file mode 100644
index 0000000000..1763145c31
--- /dev/null
+++ b/testsuite/tests/driver/T20348/T20348.stdout
@@ -0,0 +1,3 @@
+first run
+[1 of 1] Compiling A ( A.hs, A.o, A.dyn_o )
+second run
diff --git a/testsuite/tests/driver/T20348/all.T b/testsuite/tests/driver/T20348/all.T
new file mode 100644
index 0000000000..cd888b0105
--- /dev/null
+++ b/testsuite/tests/driver/T20348/all.T
@@ -0,0 +1,2 @@
+test('T20348', [extra_files(['A.hs']),
+ when(opsys('mingw32'), skip)], makefile_test, [])
View Lorry Controller Status