Show dynamic object files (#16062)
authorerthalion <9erthalion6@gmail.com>
Fri, 5 Apr 2019 20:01:52 +0000 (22:01 +0200)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Tue, 16 Apr 2019 19:40:36 +0000 (15:40 -0400)
Closes #16062. When -dynamic-too is specified, reflect that in the
progress message, like:

$ ghc Main.hs -dynamic-too
[1 of 1] Compiling Lib              ( Main.hs, Main.o, Main.dyn_o )

instead of:

$ ghc Main.hs -dynamic-too
[1 of 1] Compiling Lib              ( Main.hs, Main.o )

compiler/main/DynFlags.hs
compiler/main/HscTypes.hs
testsuite/tests/driver/dynamicToo/dynamicToo006/Main.hs [new file with mode: 0644]
testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile [new file with mode: 0644]
testsuite/tests/driver/dynamicToo/dynamicToo006/all.T [new file with mode: 0644]
testsuite/tests/driver/dynamicToo/dynamicToo006/dynamicToo006.stdout [new file with mode: 0644]
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered02.stderr

index dc12879..786decc 100644 (file)
@@ -41,6 +41,7 @@ module DynFlags (
         whenGeneratingDynamicToo, ifGeneratingDynamicToo,
         whenCannotGenerateDynamicToo,
         dynamicTooMkDynamicDynFlags,
+        dynamicOutputFile,
         DynFlags(..),
         FlagSpec(..),
         HasDynFlags(..), ContainsDynFlags(..),
@@ -1823,6 +1824,12 @@ dynamicTooMkDynamicDynFlags dflags0
           dflags4 = gopt_unset dflags3 Opt_BuildDynamicToo
       in dflags4
 
+-- | 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
+
 -----------------------------------------------------------------------------
 
 -- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value
@@ -2772,11 +2779,11 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
   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) }
+        = return $ dflags3 { dynOutputFile = Just $ dynamicOutputFile dflags3 outFile }
         | otherwise
         = return dflags3
         where
-          dynOut = flip addExtension (dynObjectSuf dflags3) . dropExtension
+          outFile = fromJust $ outputFile dflags3
   dflags4 <- ifGeneratingDynamicToo dflags3 chooseOutput (return dflags3)
 
   let (dflags5, consistency_warnings) = makeDynFlagsConsistent dflags4
index f4306f3..8c41f9b 100644 (file)
@@ -2805,6 +2805,9 @@ msHsFilePath  ms = expectJust "msHsFilePath" (ml_hs_file  (ms_location ms))
 msHiFilePath  ms = ml_hi_file  (ms_location ms)
 msObjFilePath ms = ml_obj_file (ms_location ms)
 
+msDynObjFilePath :: ModSummary -> DynFlags -> FilePath
+msDynObjFilePath ms dflags = dynamicOutputFile dflags (msObjFilePath ms)
+
 -- | Did this 'ModSummary' originate from a hs-boot file?
 isBootSummary :: ModSummary -> Bool
 isBootSummary ms = ms_hsc_src ms == HsBootFile
@@ -2824,20 +2827,26 @@ showModMsg :: DynFlags -> HscTarget -> Bool -> ModSummary -> String
 showModMsg dflags target recomp mod_summary = showSDoc dflags $
    if gopt Opt_HideSourcePaths dflags
       then text mod_str
-      else hsep
+      else hsep $
          [ text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' ')
          , char '('
          , text (op $ msHsFilePath mod_summary) <> char ','
-         , case target of
-              HscInterpreted | recomp -> text "interpreted"
-              HscNothing              -> text "nothing"
-              _                       -> text (op $ msObjFilePath mod_summary)
-         , char ')'
-         ]
+         ] ++
+         if gopt Opt_BuildDynamicToo dflags
+            then [ text obj_file <> char ','
+                 , text dyn_file
+                 , char ')'
+                 ]
+            else [ text obj_file, char ')' ]
   where
-    op      = normalise
-    mod     = moduleName (ms_mod mod_summary)
-    mod_str = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary)
+    op       = normalise
+    mod      = moduleName (ms_mod mod_summary)
+    mod_str  = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary)
+    dyn_file = op $ msDynObjFilePath mod_summary dflags
+    obj_file = case target of
+                HscInterpreted | recomp -> "interpreted"
+                HscNothing              -> "nothing"
+                _                       -> (op $ msObjFilePath mod_summary)
 
 {-
 ************************************************************************
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo006/Main.hs b/testsuite/tests/driver/dynamicToo/dynamicToo006/Main.hs
new file mode 100644 (file)
index 0000000..aab8d3c
--- /dev/null
@@ -0,0 +1 @@
+main = print "a"
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile b/testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile
new file mode 100644 (file)
index 0000000..b78fc4a
--- /dev/null
@@ -0,0 +1,16 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean:
+       rm -f *.o
+       rm -f *.hi
+       rm -f Main
+
+# check that the compilation progress message will contain
+# *.dyn_o file with -dynamic-too
+main:
+       rm -f *.o
+       rm -f *.hi
+       rm -f Main
+       '$(TEST_HC)' $(TEST_HC_OPTS) -dynamic-too Main.hs
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo006/all.T b/testsuite/tests/driver/dynamicToo/dynamicToo006/all.T
new file mode 100644 (file)
index 0000000..c9e1b52
--- /dev/null
@@ -0,0 +1,2 @@
+test('dynamicToo006', [normalise_slashes, extra_files(['Main.hs'])],
+     run_command, ['$MAKE -s main --no-print-director'])
diff --git a/testsuite/tests/driver/dynamicToo/dynamicToo006/dynamicToo006.stdout b/testsuite/tests/driver/dynamicToo/dynamicToo006/dynamicToo006.stdout
new file mode 100644 (file)
index 0000000..5c33cb2
--- /dev/null
@@ -0,0 +1,2 @@
+[1 of 1] Compiling Main             ( Main.hs, Main.o, Main.dyn_o )
+Linking Main ...
index c76996f..e5593d5 100644 (file)
@@ -1,5 +1,5 @@
-[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o )
-[2 of 2] Compiling UnsafeInfered02  ( UnsafeInfered02.hs, UnsafeInfered02.o )
+[1 of 2] Compiling UnsafeInfered02_A ( UnsafeInfered02_A.hs, UnsafeInfered02_A.o, UnsafeInfered02_A.dyn_o )
+[2 of 2] Compiling UnsafeInfered02  ( UnsafeInfered02.hs, UnsafeInfered02.o, UnsafeInfered02.dyn_o )
 
 UnsafeInfered02.hs:4:1: error:
     UnsafeInfered02_A: Can't be safely imported!