Fix -dynamic-too clashing with -o (#8180)

Signed-off-by: Austin Seipp <austin@well-typed.com>

1 files changed, 19 insertions, 14 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 70d2a81b13..829d303884 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1959,36 +1959,41 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
       throwGhcExceptionIO (CmdLineError ("combination not supported: " ++
                                intercalate "/" (map wayDesc theWays)))
 
-  whenGeneratingDynamicToo dflags3 $
-      unless (isJust (outputFile dflags3) == isJust (dynOutputFile dflags3)) $
-          liftIO $ throwGhcExceptionIO $ CmdLineError
-              "With -dynamic-too, must give -dyno iff giving -o"
+  let chooseOutput
+        | isJust (outputFile dflags3)          -- Only iff user specified -o ...
+        , not (isJust (dynOutputFile dflags3)) -- but not -dyno
+        = return $ dflags3 { dynOutputFile = Just $ dynOut (fromJust $ outputFile dflags3) }
+        | otherwise
+        = return dflags3
+        where
+          dynOut = flip addExtension (dynObjectSuf dflags3) . dropExtension
+  dflags4 <- ifGeneratingDynamicToo dflags3 chooseOutput (return dflags3)
 
-  let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3
+  let (dflags5, consistency_warnings) = makeDynFlagsConsistent dflags4
 
-  dflags5 <- case dllSplitFile dflags4 of
-             Nothing -> return (dflags4 { dllSplit = Nothing })
+  dflags6 <- case dllSplitFile dflags5 of
+             Nothing -> return (dflags5 { dllSplit = Nothing })
              Just f ->
-                 case dllSplit dflags4 of
+                 case dllSplit dflags5 of
                  Just _ ->
                      -- If dllSplit is out of date then it would have
                      -- been set to Nothing. As it's a Just, it must be
                      -- up-to-date.
-                     return dflags4
+                     return dflags5
                  Nothing ->
                      do xs <- liftIO $ readFile f
                         let ss = map (Set.fromList . words) (lines xs)
-                        return $ dflags4 { dllSplit = Just ss }
+                        return $ dflags5 { dllSplit = Just ss }
 
   -- Set timer stats & heap size
-  when (enableTimeStats dflags5) $ liftIO enableTimingStats
-  case (ghcHeapSize dflags5) of
+  when (enableTimeStats dflags6) $ liftIO enableTimingStats
+  case (ghcHeapSize dflags6) of
     Just x -> liftIO (setHeapSize x)
     _      -> return ()
 
-  liftIO $ setUnsafeGlobalDynFlags dflags5
+  liftIO $ setUnsafeGlobalDynFlags dflags6
 
-  return (dflags5, leftover, consistency_warnings ++ sh_warns ++ warns)
+  return (dflags6, leftover, consistency_warnings ++ sh_warns ++ warns)
 
 updateWays :: DynFlags -> DynFlags
 updateWays dflags