Ensure .dyn_hi doesn't overwrite .hi

This commit fixes the following bug: when `outputHi` is set, and
both `.dyn_hi` and `.hi` are needed, both would be written to
`outputHi`, causing `.dyn_hi` to overwrite `.hi`. This causes
subsequent `readIface` to fail - "mismatched interface file profile
tag (wanted "", got "dyn")" - triggering unnecessary rebuild.

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, [])