From 52eab67a99dd928204b730355245233fa96fa24d Mon Sep 17 00:00:00 2001
From: archblob <fcsernik@gmail.com>
Date: Tue, 16 Sep 2014 07:56:09 -0500
Subject: Add the ability to :set -l{foo} in ghci, fix #1407.

Summary:
The dynamic linking code was already there but it was not called
on flag changes in ghci.

Test Plan: validate

Reviewers: hvr, simonmar, austin

Reviewed By: austin

Subscribers: simonmar, ezyang, carter

Differential Revision: https://phabricator.haskell.org/D194

GHC Trac Issues: #1407
---
 compiler/ghci/Linker.lhs                  | 29 ++++++++++++++++++++---------
 ghc/InteractiveUI.hs                      | 11 +++++++++++
 testsuite/tests/ghci/linking/T1407.script |  4 ++++
 testsuite/tests/ghci/linking/all.T        |  2 ++
 4 files changed, 37 insertions(+), 9 deletions(-)
 create mode 100644 testsuite/tests/ghci/linking/T1407.script

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 31698580a5..5b0251c54e 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -17,6 +17,7 @@ module Linker ( getHValue, showLinkerState,
                 extendLinkEnv, deleteFromLinkEnv,
                 extendLoadedPkgs,
                 linkPackages,initDynLinker,linkModule,
+                linkCmdLineLibs,
 
                 -- Saving/restoring globals
                 PersistentLinkerState, saveLinkerGlobals, restoreLinkerGlobals
@@ -283,10 +284,21 @@ reallyInitDynLinker dflags =
           -- (b) Load packages from the command-line (Note [preload packages])
         ; pls <- linkPackages' dflags (preloadPackages (pkgState dflags)) pls0
 
-          -- (c) Link libraries from the command-line
-        ; let cmdline_ld_inputs = ldInputs dflags
+          -- steps (c), (d) and (e)
+        ; linkCmdLineLibs' dflags pls
+        }
+
+linkCmdLineLibs :: DynFlags -> IO ()
+linkCmdLineLibs dflags = do
+  initDynLinker dflags
+  modifyPLS_ $ \pls -> do
+    linkCmdLineLibs' dflags pls
+
+linkCmdLineLibs' :: DynFlags -> PersistentLinkerState -> IO PersistentLinkerState
+linkCmdLineLibs' dflags@(DynFlags { ldInputs     = cmdline_ld_inputs
+                                  , libraryPaths = lib_paths}) pls =
+  do  {   -- (c) Link libraries from the command-line
         ; let minus_ls = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ]
-        ; let lib_paths = libraryPaths dflags
         ; libspecs <- mapM (locateLib dflags False lib_paths) minus_ls
 
           -- (d) Link .o files from the command-line
@@ -295,12 +307,11 @@ reallyInitDynLinker dflags =
 
           -- (e) Link any MacOS frameworks
         ; let platform = targetPlatform dflags
-        ; let framework_paths = if platformUsesFrameworks platform
-                                then frameworkPaths dflags
-                                else []
-        ; let frameworks = if platformUsesFrameworks platform
-                           then cmdlineFrameworks dflags
-                           else []
+        ; let (framework_paths, frameworks) =
+                if platformUsesFrameworks platform
+                 then (frameworkPaths dflags, cmdlineFrameworks dflags)
+                  else ([],[])
+
           -- Finally do (c),(d),(e)
         ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ]
                                ++ libspecs
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index ea90280b06..0bcecd3449 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -2146,6 +2146,17 @@ newDynFlags interactive_only minus_opts = do
                      , pkgDatabase = pkgDatabase dflags2
                      , packageFlags = packageFlags dflags2 }
 
+        let ld0length   = length $ ldInputs dflags0
+            fmrk0length = length $ cmdlineFrameworks dflags0
+
+            newLdInputs     = drop ld0length (ldInputs dflags2)
+            newCLFrameworks = drop fmrk0length (cmdlineFrameworks dflags2)
+
+        when (not (null newLdInputs && null newCLFrameworks)) $
+          liftIO $ linkCmdLineLibs $
+            dflags2 { ldInputs = newLdInputs
+                    , cmdlineFrameworks = newCLFrameworks }
+
       return ()
 
 
diff --git a/testsuite/tests/ghci/linking/T1407.script b/testsuite/tests/ghci/linking/T1407.script
new file mode 100644
index 0000000000..97164359d0
--- /dev/null
+++ b/testsuite/tests/ghci/linking/T1407.script
@@ -0,0 +1,4 @@
+:set -ldl
+import Foreign
+import Foreign.C.String
+foreign import ccall "dlerror" dle :: IO CString
diff --git a/testsuite/tests/ghci/linking/all.T b/testsuite/tests/ghci/linking/all.T
index eba2b8aaf5..6675a539ec 100644
--- a/testsuite/tests/ghci/linking/all.T
+++ b/testsuite/tests/ghci/linking/all.T
@@ -47,3 +47,5 @@ test('T3333',
      unless(opsys('linux') or ghci_dynamic(), expect_broken(3333))],
      run_command,
      ['$MAKE -s --no-print-directory T3333'])
+
+test('T1407', normal, ghci_script, ['T1407.script'])
-- 
cgit v1.2.1