[commit: ghc] master: Don't drop GHCi-defined functions with -fobject-code enabled (ddb870b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/ddb870bf7055ccc8ff8b86c161f31aad81d01add/ghc

>---------------------------------------------------------------

commit ddb870bf7055ccc8ff8b86c161f31aad81d01add
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Mon Aug 14 20:55:39 2017 -0400

    Don't drop GHCi-defined functions with -fobject-code enabled
    
    The desugarer was using `targetRetainsAllBindings` as a litmus test for
    determining if a function was defined in interactive mode (and thus
    should be exported). However, there is a corner case where one can be in
    interactive mode and have `targetRetainsAllBindings` return `False`: if
    `-fobject-code` is enabled (since the target will no longer be
    `HscInteractive`). In such a scenario, we should fall back on a
    different test for determining if we are in a GHCi session. I chose to
    use `isInteractiveModule`, which appears to do the trick.
    
    Test Plan: make test TEST=T12091
    
    Reviewers: austin, bgamari
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #12091
    
    Differential Revision: https://phabricator.haskell.org/D3849


>---------------------------------------------------------------

ddb870bf7055ccc8ff8b86c161f31aad81d01add
 compiler/deSugar/Desugar.hs        | 19 +++++++++++++++----
 testsuite/tests/ghci/scripts/all.T |  5 ++---
 2 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index 3d8a28f..4bfd10f 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -148,7 +148,8 @@ deSugar hsc_env
           keep_alive <- readIORef keep_var
         ; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules
               final_prs = addExportFlagsAndRules target export_set keep_alive
-                                                 rules_for_locals (fromOL all_prs)
+                                                 mod rules_for_locals
+                                                 (fromOL all_prs)
 
               final_pgm = combineEvBinds ds_ev_binds final_prs
         -- Notice that we put the whole lot in a big Rec, even the foreign binds
@@ -278,9 +279,9 @@ deSugarExpr hsc_env tc_expr = do {
 -}
 
 addExportFlagsAndRules
-    :: HscTarget -> NameSet -> NameSet -> [CoreRule]
+    :: HscTarget -> NameSet -> NameSet -> Module -> [CoreRule]
     -> [(Id, t)] -> [(Id, t)]
-addExportFlagsAndRules target exports keep_alive rules prs
+addExportFlagsAndRules target exports keep_alive mod rules prs
   = mapFst add_one prs
   where
     add_one bndr = add_rules name (add_export name bndr)
@@ -313,10 +314,20 @@ addExportFlagsAndRules target exports keep_alive rules prs
         -- simplification), and retain them all in the TypeEnv so they are
         -- available from the command line.
         --
+        -- Most of the time, this can be accomplished by use of
+        -- targetRetainsAllBindings, which returns True if the target is
+        -- HscInteractive. However, there are cases when one can use GHCi with
+        -- a target other than HscInteractive (e.g., with the -fobject-code
+        -- flag enabled, as in #12091). In such scenarios,
+        -- targetRetainsAllBindings can return False, so we must fall back on
+        -- isInteractiveModule to be doubly sure we export entities defined in
+        -- a GHCi session.
+        --
         -- isExternalName separates the user-defined top-level names from those
         -- introduced by the type checker.
     is_exported :: Name -> Bool
-    is_exported | targetRetainsAllBindings target = isExternalName
+    is_exported | targetRetainsAllBindings target
+                  || isInteractiveModule mod      = isExternalName
                 | otherwise                       = (`elemNameSet` exports)
 
 {-
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 8c3a2f5..1f4e5b1 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -240,9 +240,8 @@ test('T11975', normal, ghci_script, ['T11975.script'])
 test('T10963', normal, ghci_script, ['T10963.script'])
 test('T11547', normal, ghci_script, ['T11547.script'])
 test('T12520', normal, ghci_script, ['T12520.script'])
-test('T12091',
-     [expect_broken(12091), extra_run_opts('-fobject-code')],
-     ghci_script, ['T12091.script'])
+test('T12091', [extra_run_opts('-fobject-code')], ghci_script,
+     ['T12091.script'])
 test('T12523', normal, ghci_script, ['T12523.script'])
 test('T12024', normal, ghci_script, ['T12024.script'])
 test('T12447', expect_broken(12447), ghci_script, ['T12447.script'])