[Git][ghc/ghc][master] Show dynamic object files (#16062)

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
57eb5bc6 by erthalion at 2019-04-16T19:40:36Z
Show dynamic object files (#16062)

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 )

- - - - -


7 changed files:

- compiler/main/DynFlags.hs
- compiler/main/HscTypes.hs
- + testsuite/tests/driver/dynamicToo/dynamicToo006/Main.hs
- + testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile
- + testsuite/tests/driver/dynamicToo/dynamicToo006/all.T
- + testsuite/tests/driver/dynamicToo/dynamicToo006/dynamicToo006.stdout
- testsuite/tests/safeHaskell/safeInfered/UnsafeInfered02.stderr


Changes:

=====================================
compiler/main/DynFlags.hs
=====================================
@@ -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


=====================================
compiler/main/HscTypes.hs
=====================================
@@ -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)
 
 {-
 ************************************************************************


=====================================
testsuite/tests/driver/dynamicToo/dynamicToo006/Main.hs
=====================================
@@ -0,0 +1 @@
+main = print "a"


=====================================
testsuite/tests/driver/dynamicToo/dynamicToo006/Makefile
=====================================
@@ -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


=====================================
testsuite/tests/driver/dynamicToo/dynamicToo006/all.T
=====================================
@@ -0,0 +1,2 @@
+test('dynamicToo006', [normalise_slashes, extra_files(['Main.hs'])],
+     run_command, ['$MAKE -s main --no-print-director'])


=====================================
testsuite/tests/driver/dynamicToo/dynamicToo006/dynamicToo006.stdout
=====================================
@@ -0,0 +1,2 @@
+[1 of 1] Compiling Main             ( Main.hs, Main.o, Main.dyn_o )
+Linking Main ...


=====================================
testsuite/tests/safeHaskell/safeInfered/UnsafeInfered02.stderr
=====================================
@@ -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!



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/57eb5bc61317e5cdf1fd5745036e443037a37451

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/57eb5bc61317e5cdf1fd5745036e443037a37451
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190416/0ca378f7/attachment-0001.html>