Revert "Create empty dump files when there was nothing to dump"

This reverts commit 8cba907a which
broke `-ddump-to-file`.

compiler/main/DriverPipeline.hs

@@ -649,13 +649,8 @@ runPipeline' start_phase hsc_env env input_fn
   = do
   -- Execute the pipeline...
   let state = PipeState{ hsc_env, maybe_loc, maybe_stub_o = maybe_stub_o }
-      dflags = extractDynFlags hsc_env
 
-  -- #10320: Open dump files for writing. Any existing dump specified
-  -- in 'dflags' will be truncated.
-  bracket_ (openDumpFiles dflags)
-           (closeDumpFiles dflags)
-           (evalP (pipeLoop start_phase input_fn) env state)
+  evalP (pipeLoop start_phase input_fn) env state
 
 -- ---------------------------------------------------------------------------
 -- outer pipeline loop

compiler/main/DynFlags.hs

@@ -806,7 +806,7 @@ data DynFlags = DynFlags {
   -- Names of files which were generated from -ddump-to-file; used to
   -- track which ones we need to truncate because it's our first run
   -- through
-  generatedDumps        :: IORef (Map FilePath Handle),
+  generatedDumps        :: IORef (Set FilePath),
 
   -- hsc dynamic flags
   dumpFlags             :: IntSet,
@@ -1386,7 +1386,7 @@ initDynFlags dflags = do
  refFilesToClean <- newIORef []
  refDirsToClean <- newIORef Map.empty
  refFilesToNotIntermediateClean <- newIORef []
- refGeneratedDumps <- newIORef Map.empty
+ refGeneratedDumps <- newIORef Set.empty
  refRtldInfo <- newIORef Nothing
  refRtccInfo <- newIORef Nothing
  wrapperNum <- newIORef emptyModuleEnv

compiler/main/ErrUtils.hs

@@ -33,7 +33,6 @@ module ErrUtils (
         -- * Dump files
         dumpIfSet, dumpIfSet_dyn, dumpIfSet_dyn_printer,
         mkDumpDoc, dumpSDoc,
-        openDumpFiles, closeDumpFiles,
 
         -- * Issuing messages during compilation
         putMsg, printInfoForUser, printOutputForUser,
@@ -61,7 +60,7 @@ import System.Directory
 import System.Exit      ( ExitCode(..), exitWith )
 import System.FilePath  ( takeDirectory, (</>) )
 import Data.List
-import qualified Data.Map as Map
+import qualified Data.Set as Set
 import Data.IORef
 import Data.Maybe       ( fromMaybe )
 import Data.Ord
@@ -300,15 +299,6 @@ dumpIfSet_dyn_printer :: PrintUnqualified
 dumpIfSet_dyn_printer printer dflags flag doc
   = when (dopt flag dflags) $ dumpSDoc dflags printer flag "" doc
 
--- | a wrapper around 'dumpSDoc'.
--- First check whether the dump flag is set
--- Do nothing if it is unset
---
--- Makes a dummy write operation into the dump
-dumpIfSet_dyn_empty :: DynFlags -> DumpFlag -> IO ()
-dumpIfSet_dyn_empty dflags flag
-  = when (dopt flag dflags) $ dumpSDoc dflags neverQualify flag "" empty
-
 mkDumpDoc :: String -> SDoc -> SDoc
 mkDumpDoc hdr doc
    = vcat [blankLine,
@@ -318,23 +308,6 @@ mkDumpDoc hdr doc
      where
         line = text (replicate 20 '=')
 
--- | Open dump files from DynFlags for writing
---
--- #10320: This function should be called once before the pipe line
--- is started. It writes empty data into all requested dumps to initiate
--- their creation.
-openDumpFiles :: DynFlags -> IO ()
-openDumpFiles dflags
-  = let flags = enumFrom (toEnum 0 :: DumpFlag)
-    in mapM_ (dumpIfSet_dyn_empty dflags) flags
-
-
--- | Close all opened dump files
---
-closeDumpFiles :: DynFlags -> IO ()
-closeDumpFiles dflags
-  = do gd <- readIORef $ generatedDumps dflags
-       mapM_ hClose $ Map.elems gd
 
 -- | Write out a dump.
 -- If --dump-to-file is set then this goes to a file.
@@ -350,16 +323,32 @@ dumpSDoc dflags print_unqual flag hdr doc
  = do let mFile = chooseDumpFile dflags flag
           dump_style = mkDumpStyle print_unqual
       case mFile of
-            Just fileName -> do
-              handle <- getDumpFileHandle dflags fileName
-              doc' <- if null hdr
-                      then return doc
-                      else do t <- getCurrentTime
-                              let d = text (show t)
-                                   $$ blankLine
-                                   $$ doc
-                              return $ mkDumpDoc hdr d
-              defaultLogActionHPrintDoc dflags handle doc' dump_style
+            Just fileName
+                 -> do
+                        let gdref = generatedDumps dflags
+                        gd <- readIORef gdref
+                        let append = Set.member fileName gd
+                            mode = if append then AppendMode else WriteMode
+                        when (not append) $
+                            writeIORef gdref (Set.insert fileName gd)
+                        createDirectoryIfMissing True (takeDirectory fileName)
+                        handle <- openFile fileName mode
+
+                        -- We do not want the dump file to be affected by
+                        -- environment variables, but instead to always use
+                        -- UTF8. See:
+                        -- https://ghc.haskell.org/trac/ghc/ticket/10762
+                        hSetEncoding handle utf8
+
+                        doc' <- if null hdr
+                                then return doc
+                                else do t <- getCurrentTime
+                                        let d = text (show t)
+                                             $$ blankLine
+                                             $$ doc
+                                        return $ mkDumpDoc hdr d
+                        defaultLogActionHPrintDoc dflags handle doc' dump_style
+                        hClose handle
 
             -- write the dump to stdout
             Nothing -> do
@@ -368,31 +357,6 @@ dumpSDoc dflags print_unqual flag hdr doc
                     | otherwise = (mkDumpDoc hdr doc, SevDump)
               log_action dflags dflags severity noSrcSpan dump_style doc'
 
--- | Return a handle assigned to the given filename.
---
--- If the requested file doesn't exist the new one will be created
-getDumpFileHandle :: DynFlags -> FilePath -> IO Handle
-getDumpFileHandle dflags fileName
-  = do
-      let gdref = generatedDumps dflags
-      gd <- readIORef gdref
-
-      let mHandle = Map.lookup fileName gd
-      case mHandle of
-        Just handle -> return handle
-
-        Nothing -> do
-          createDirectoryIfMissing True (takeDirectory fileName)
-          handle <- openFile fileName WriteMode
-
-          -- We do not want the dump file to be affected by
-          -- environment variables, but instead to always use
-          -- UTF8. See:
-          -- https://ghc.haskell.org/trac/ghc/ticket/10762
-          hSetEncoding handle utf8
-          writeIORef gdref (Map.insert fileName handle gd)
-
-          return handle
 
 -- | Choose where to put a dump file based on DynFlags
 --

testsuite/tests/driver/Makefile

@@ -609,42 +609,3 @@ T10182:
 	"$(TEST_HC)" $(TEST_HC_OPTS) -c T10182.hs-boot
 	"$(TEST_HC)" $(TEST_HC_OPTS) -c T10182a.hs
 	"$(TEST_HC)" $(TEST_HC_OPTS) -c T10182.hs
-
-.PHONY: T10320a
-T10320a:
-	# check if an empty .dump-rule-rewrites is created when no rules were applied
-	$(RM) -rf T10320dump
-	$(CP) T10320-without-rules.hs T10320.hs
-	"$(TEST_HC)" $(TEST_HC_OPTS) -O -c T10320.hs -dumpdir T10320dump -ddump-to-file -ddump-rule-rewrites
-	[ -e T10320dump/T10320.dump-rule-rewrites ]
-
-.PHONY: T10320b
-T10320b:
-	# check if an empty .dump-rule-firings is created when no rules were applied
-	$(RM) -rf T10320dump
-	$(CP) T10320-without-rules.hs T10320.hs
-	"$(TEST_HC)" $(TEST_HC_OPTS) -O -c T10320.hs -dumpdir T10320dump -ddump-to-file -ddump-rule-firings
-	[ -e T10320dump/T10320.dump-rule-firings ]
-
-.PHONY: T10320c
-T10320c:
-	# check if existing .dump-rule-rewrites has been rewritten by an empty one when no rules were applied
-	$(RM) -rf T10320dump
-	$(CP) T10320-with-rule.hs T10320.hs
-	"$(TEST_HC)" $(TEST_HC_OPTS) -O -c T10320.hs -dumpdir T10320dump -ddump-to-file -ddump-rule-rewrites	# generate a non-empty dump
-	$(CP) T10320-without-rules.hs T10320.hs
-	"$(TEST_HC)" $(TEST_HC_OPTS) -O -c T10320.hs -dumpdir T10320dump -ddump-to-file -ddump-rule-rewrites
-	[ -e T10320dump/T10320.dump-rule-rewrites -a ! -s T10320dump/T10320.dump-rule-rewrites ]	# check if the file exists and has zero size
-
-.PHONY: T10320d
-T10320d:
-	# check if existing .dump-rule-firings has been rewritten by an empty one when no rules were applied
-	$(RM) -rf T10320dump
-	$(CP) T10320-with-rule.hs T10320.hs
-	"$(TEST_HC)" $(TEST_HC_OPTS) -O -c T10320.hs -dumpdir T10320dump -ddump-to-file -ddump-rule-firings 	# generate a non-empty dump
-	$(CP) T10320-without-rules.hs T10320.hs
-	"$(TEST_HC)" $(TEST_HC_OPTS) -O -c T10320.hs -dumpdir T10320dump -ddump-to-file -ddump-rule-firings
-	[ -e T10320dump/T10320.dump-rule-firings -a ! -s T10320dump/T10320.dump-rule-firings ]		# check if the file exists and has zero size
-
-.PHONY: T10320
-T10320: T10320a T10320b T10320c T10320d

testsuite/tests/driver/T10320-with-rule.hs

-module T10320 where
-
-{-# RULES "rule" forall x. f x = 42 #-}
-
-f :: Int -> Int
-f x = x
-{-# NOINLINE [1] f #-}
-
-n = f (0 :: Int)

testsuite/tests/driver/T10320-without-rules.hs

-module T10320 where
-
-n :: Int
-n = 42

testsuite/tests/driver/all.T

@@ -460,13 +460,3 @@ test('T9360b', normal, run_command, ['{compiler} -e "" --interactive'])
 test('T10970', normal, compile_and_run, ['-hide-all-packages -package base -package containers'])
 test('T10970a', normal, compile_and_run, [''])
 test('T4931', normal, compile_and_run, [''])
-test('T10320',
-    [
-        extra_clean([
-                        'T10320dump/T10320.dump-rule-firings',
-                        'T10320dump/T10320.dump-rule-rewrites',
-                        'T10320dump',
-                        'T10320.hs'
-                    ]),
-    ],
-    run_command, ['$MAKE -s --no-print-directory T10320'])