Support LIBRARY_PATH and LD_LIBRARY_PATH in rts

`LIBRARY_PATH` is used to find libraries and other link artifacts while
`LD_LIBRARY_PATH` is used to find shared libraries by the loader.

Due to an implementation detail on Windows, using `LIBRARY_PATH` will
automatically add the path of any library found to the loader's path.

So in that case `LD_LIBRARY_PATH` won't be needed.

Test Plan:
./validate along with T14611 which has been made Windows only
due to linux using the system linker/loader by default. So I feel a
testcase there is unwarranted as the support is indirect via glibc.

Reviewers: hvr, bgamari, erikd, simonmar, RyanGlScott

Reviewed By: RyanGlScott

Subscribers: RyanGlScott, rwbarton, thomie, carter

GHC Trac Issues: #14611

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

9 files changed, 82 insertions, 13 deletions

diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index 3775d58438..34813798b2 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -63,6 +63,7 @@ import Control.Concurrent.MVar
 import System.FilePath
 import System.Directory
 import System.IO.Unsafe
+import System.Environment (lookupEnv)
 
 #if defined(mingw32_HOST_OS)
 import System.Win32.Info (getSystemDirectory)
@@ -336,13 +337,15 @@ linkCmdLineLibs' hsc_env pls =
       -- See Note [Fork/Exec Windows]
       gcc_paths <- getGCCPaths dflags os
 
+      lib_paths_env <- addEnvPaths "LIBRARY_PATH" lib_paths_base
+
       maybePutStrLn dflags "Search directories (user):"
-      maybePutStr dflags (unlines $ map ("  "++) lib_paths_base)
+      maybePutStr dflags (unlines $ map ("  "++) lib_paths_env)
       maybePutStrLn dflags "Search directories (gcc):"
       maybePutStr dflags (unlines $ map ("  "++) gcc_paths)
 
       libspecs
-        <- mapM (locateLib hsc_env False lib_paths_base gcc_paths) minus_ls
+        <- mapM (locateLib hsc_env False lib_paths_env gcc_paths) minus_ls
 
       -- (d) Link .o files from the command-line
       classified_ld_inputs <- mapM (classifyLdInput dflags)
@@ -370,7 +373,8 @@ linkCmdLineLibs' hsc_env pls =
                                ++ [ takeDirectory dll | DLLPath dll <- libspecs ]
                       in nub $ map normalise paths
       let lib_paths = nub $ lib_paths_base ++ gcc_paths
-      pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths
+      all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
+      pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env
 
       pls1 <- foldM (preloadLib hsc_env lib_paths framework_paths) pls
                     cmdline_lib_specs
@@ -1260,11 +1264,12 @@ linkPackage hsc_env pkg
                       ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]
         -- See Note [Fork/Exec Windows]
         gcc_paths <- getGCCPaths dflags (platformOS platform)
+        dirs_env <- addEnvPaths "LIBRARY_PATH" dirs
 
         hs_classifieds
-           <- mapM (locateLib hsc_env True  dirs gcc_paths) hs_libs'
+           <- mapM (locateLib hsc_env True  dirs_env gcc_paths) hs_libs'
         extra_classifieds
-           <- mapM (locateLib hsc_env False dirs gcc_paths) extra_libs
+           <- mapM (locateLib hsc_env False dirs_env gcc_paths) extra_libs
         let classifieds = hs_classifieds ++ extra_classifieds
 
         -- Complication: all the .so's must be loaded before any of the .o's.
@@ -1276,7 +1281,8 @@ linkPackage hsc_env pkg
         -- Add directories to library search paths
         let dll_paths  = map takeDirectory known_dlls
             all_paths  = nub $ map normalise $ dll_paths ++ dirs
-        pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths
+        all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
+        pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env
 
         maybePutStr dflags
             ("Loading package " ++ sourcePackageIdString pkg ++ " ... ")
@@ -1537,6 +1543,25 @@ getSystemDirectories = fmap (:[]) getSystemDirectory
 getSystemDirectories = return []
 #endif
 
+-- | Merge the given list of paths with those in the environment variable
+--   given. If the variable does not exist then just return the identity.
+addEnvPaths :: String -> [String] -> IO [String]
+addEnvPaths name list
+  = do values <- lookupEnv name
+       case values of
+         Nothing  -> return list
+         Just arr -> return $ list ++ splitEnv arr
+    where
+      splitEnv :: String -> [String]
+      splitEnv value = case break (== envListSep) value of
+                         (x, []    ) -> [x]
+                         (x, (_:xs)) -> x : splitEnv xs
+#if defined(mingw32_HOST_OS)
+      envListSep = ';'
+#else
+      envListSep = ':'
+#endif
+
 -- ----------------------------------------------------------------------------
 -- Loading a dynamic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
 
diff --git a/docs/users_guide/8.6.1-notes.rst b/docs/users_guide/8.6.1-notes.rst
index d2d5172f2b..c17664f1ae 100644
--- a/docs/users_guide/8.6.1-notes.rst
+++ b/docs/users_guide/8.6.1-notes.rst
@@ -32,9 +32,12 @@ Runtime system
 
 - The GHC runtime linker now prefers user shared libraries above system ones.
   When extra search directories are specified these are searched before anything
-  else. This fixes `iuuc` on Windows given the proper search directories (e.g
-  `-L/mingw64/lib`).
+  else. This fixes ``iuuc`` on Windows given the proper search directories (e.g
+  ``-L/mingw64/lib``).
 
+	- The GHC runtime linker now uses ``LIBRARY_PATH`` and the runtime loader now also
+	  searches ``LD_LIBRARY_PATH``.
+	
 Template Haskell
 ~~~~~~~~~~~~~~~~
 
diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index 7cda9460ff..eae98f7936 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -2062,17 +2062,28 @@ libraries, in this order:
 
 -  Paths specified using the :ghc-flag:`-L ⟨dir⟩` command-line option,
 
--  the standard library search path for your system, which on some
+-  The standard library search path for your system loader, which on some
    systems may be overridden by setting the :envvar:`LD_LIBRARY_PATH`
    environment variable.
 
+-  The linker standard library search can also be overriden on some systems using
+   the :envvar:`LIBRARY_PATH` environment variable. Because of some
+   implementation detail on Windows, setting ``LIBRARY_PATH`` will also extend
+   the system loader path for any library it finds. So often setting
+   :envvar:`LIBRARY_PATH` is enough.
+
 On systems with ``.dll``-style shared libraries, the actual library
-loaded will be ``lib.dll``. Again, GHCi will signal an error if it can't
-find the library.
+loaded will be ``lib.dll``, ``liblib.dll``. GHCi also has full support for
+import libraries, either Microsoft style ``.lib``, or GNU GCC style ``.a`` and
+``.dll.a`` libraries. If you have an import library it is advisable to always
+specify the import libary instead of the ``.dll``. e.g. use ``-lgcc` instead of
+``-llibgcc_s_seh-1``. Again, GHCi will signal an error if it can't find the
+library.
 
 GHCi can also load plain object files (``.o`` or ``.obj`` depending on
-your platform) from the command-line. Just add the name the object file
-to the command line.
+your platform) or static archives (``.a``) from the command-line. Just add the
+name the object file or library to the command line.
+On Windows GHCi also supports the ``big-obj`` format.
 
 Ordering of ``-l`` options matters: a library should be mentioned
 *before* the libraries it depends on (see :ref:`options-linker`).
diff --git a/testsuite/tests/rts/T14611/Makefile b/testsuite/tests/rts/T14611/Makefile
new file mode 100644
index 0000000000..4fc3f86ba5
--- /dev/null
+++ b/testsuite/tests/rts/T14611/Makefile
@@ -0,0 +1,10 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T14611:
+	'$(TEST_CC)' -c foo.c -o foo.o
+	'$(AR)' rsc libfoo.a foo.o
+	'$(TEST_HC)' -shared foo_dll.c -o libfoo-1.dll
+	mv libfoo-1.dll.a libfoo.dll.a
+	echo main | LIBRARY_PATH="$(PWD)" '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) main.hs -lfoo
diff --git a/testsuite/tests/rts/T14611/T14611.stdout b/testsuite/tests/rts/T14611/T14611.stdout
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/testsuite/tests/rts/T14611/T14611.stdout
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/rts/T14611/all.T b/testsuite/tests/rts/T14611/all.T
new file mode 100644
index 0000000000..1387e6752d
--- /dev/null
+++ b/testsuite/tests/rts/T14611/all.T
@@ -0,0 +1,4 @@
+test('T14611',
+     [extra_files(['foo.c', 'main.hs', 'foo_dll.c']),
+      unless(opsys('mingw32'), skip)],
+     run_command, ['$MAKE -s --no-print-directory T14611'])
diff --git a/testsuite/tests/rts/T14611/foo.c b/testsuite/tests/rts/T14611/foo.c
new file mode 100644
index 0000000000..af8ad9cb50
--- /dev/null
+++ b/testsuite/tests/rts/T14611/foo.c
@@ -0,0 +1,6 @@
+extern int bar();
+
+int foo ()
+{
+    return bar();
+}
diff --git a/testsuite/tests/rts/T14611/foo_dll.c b/testsuite/tests/rts/T14611/foo_dll.c
new file mode 100644
index 0000000000..8ea6c22735
--- /dev/null
+++ b/testsuite/tests/rts/T14611/foo_dll.c
@@ -0,0 +1,4 @@
+int foo()
+{
+    return 1;
+}
diff --git a/testsuite/tests/rts/T14611/main.hs b/testsuite/tests/rts/T14611/main.hs
new file mode 100644
index 0000000000..fbc8f5603c
--- /dev/null
+++ b/testsuite/tests/rts/T14611/main.hs
@@ -0,0 +1,5 @@
+module Main where
+
+foreign import ccall "foo" c_foo :: Int
+
+main = print c_foo