From 07ac3f8e8b3337ebd5b4e0627a66557676f224c7 Mon Sep 17 00:00:00 2001
From: Tamar Christina <tamar@zhox.com>
Date: Sat, 10 Oct 2015 15:21:09 +0200
Subject: [PATCH] Add short library names support to Windows linker

Make Linker.hs try asking gcc for lib%s.dll as well, also changed tryGcc
to pass -L to all components by using -B instead. These two fix
shortnames linking on windows.

re-enabled tests: ghcilink003, ghcilink006 and T3333
Added two tests: load_short_name and enabled T1407 on windows.

Reviewed By: thomie, bgamari

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

GHC Trac Issues: #9878, #1407, #1883, #5289
---
 compiler/ghci/Linker.hs                       |  8 +++++--
 testsuite/tests/ghci/linking/Makefile         |  8 +++++++
 testsuite/tests/ghci/linking/T1407.script     |  4 ----
 testsuite/tests/ghci/linking/all.T            |  7 +-----
 testsuite/tests/ghci/linking/dyn/A.c          | 17 ++++++++++++++
 testsuite/tests/ghci/linking/dyn/Makefile     | 23 +++++++++++++++++++
 testsuite/tests/ghci/linking/dyn/T1407.script |  4 ++++
 testsuite/tests/ghci/linking/dyn/all.T        | 12 ++++++++++
 testsuite/tests/ghci/scripts/all.T            |  2 +-
 9 files changed, 72 insertions(+), 13 deletions(-)
 delete mode 100644 testsuite/tests/ghci/linking/T1407.script
 create mode 100644 testsuite/tests/ghci/linking/dyn/A.c
 create mode 100644 testsuite/tests/ghci/linking/dyn/Makefile
 create mode 100644 testsuite/tests/ghci/linking/dyn/T1407.script
 create mode 100644 testsuite/tests/ghci/linking/dyn/all.T

diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index b5979e83bb31..4b33f4c239bf 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -1201,7 +1201,7 @@ locateLib dflags is_hs dirs lib
     --       for a dynamic library (#5289)
     --   otherwise, assume loadDLL can find it
     --
-  = findDll `orElse` findArchive `orElse` tryGcc `orElse` assumeDll
+  = findDll `orElse` findArchive `orElse` tryGcc `orElse` tryGccPrefixed `orElse` assumeDll
 
   | not dynamicGhc
     -- When the GHC package was not compiled as dynamic library
@@ -1222,6 +1222,7 @@ locateLib dflags is_hs dirs lib
      mk_hs_dyn_lib_path dir = dir </> mkHsSOName platform hs_dyn_lib_name
 
      so_name = mkSOName platform lib
+     lib_so_name = "lib" ++ so_name
      mk_dyn_lib_path dir = case (arch, os) of
                              (ArchX86_64, OSSolaris2) -> dir </> ("64/" ++ so_name)
                              _ -> dir </> so_name
@@ -1232,6 +1233,7 @@ locateLib dflags is_hs dirs lib
      findHSDll      = liftM (fmap DLLPath) $ findFile mk_hs_dyn_lib_path dirs
      findDll        = liftM (fmap DLLPath) $ findFile mk_dyn_lib_path    dirs
      tryGcc         = liftM (fmap DLLPath) $ searchForLibUsingGcc dflags so_name dirs
+     tryGccPrefixed = liftM (fmap DLLPath) $ searchForLibUsingGcc dflags lib_so_name dirs
 
      assumeDll   = return (DLL lib)
      infixr `orElse`
@@ -1246,7 +1248,9 @@ locateLib dflags is_hs dirs lib
 
 searchForLibUsingGcc :: DynFlags -> String -> [FilePath] -> IO (Maybe FilePath)
 searchForLibUsingGcc dflags so dirs = do
-   str <- askCc dflags (map (FileOption "-L") dirs
+   -- GCC does not seem to extend the library search path (using -L) when using
+   -- --print-file-name. So instead pass it a new base location.
+   str <- askCc dflags (map (FileOption "-B") dirs
                           ++ [Option "--print-file-name", Option so])
    let file = case lines str of
                 []  -> ""
diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile
index 5b8e23c66cca..c833454ea788 100644
--- a/testsuite/tests/ghci/linking/Makefile
+++ b/testsuite/tests/ghci/linking/Makefile
@@ -40,7 +40,11 @@ ghcilink002 :
 
 .PHONY: ghcilink003
 ghcilink003 :
+ifeq "$(WINDOWS)" "YES"
+	echo ":q" | "$(TEST_HC)" --interactive -ignore-dot-ghci -v0 -lstdc++-6
+else
 	echo ":q" | "$(TEST_HC)" --interactive -ignore-dot-ghci -v0 -lstdc++
+endif
 
 # Test 4: 
 #   package P
@@ -114,7 +118,11 @@ ghcilink006 :
 	echo "version: 1.0" >>$(PKG006)
 	echo "id: test-XXX" >>$(PKG006)
 	echo "key: test-1.0" >>$(PKG006)
+ifeq "$(WINDOWS)" "YES"
+	echo "extra-libraries: stdc++-6" >>$(PKG006)
+else
 	echo "extra-libraries: stdc++" >>$(PKG006)
+endif
 	'$(GHC_PKG)' init $(LOCAL_PKGCONF006)
 	'$(GHC_PKG)' --no-user-package-db -f $(LOCAL_PKGCONF006) register $(PKG006) -v0
 	#
diff --git a/testsuite/tests/ghci/linking/T1407.script b/testsuite/tests/ghci/linking/T1407.script
deleted file mode 100644
index 97164359d04e..000000000000
--- a/testsuite/tests/ghci/linking/T1407.script
+++ /dev/null
@@ -1,4 +0,0 @@
-: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 6675a539ec49..a8aa5a3b9435 100644
--- a/testsuite/tests/ghci/linking/all.T
+++ b/testsuite/tests/ghci/linking/all.T
@@ -12,8 +12,6 @@ test('ghcilink002',
 
 test('ghcilink003',
      [
-       # still cannot load libstdc++ on Windows.  See also #4468.
-       when(opsys('mingw32'), expect_broken(5289)),
        unless(doing_ghci, skip),
        extra_clean(['dir003/*','dir003'])
      ],
@@ -33,8 +31,6 @@ test('ghcilink005',
 
 test('ghcilink006',
      [
-       # still cannot load libstdc++ on Windows.  See also #4468.
-       when(opsys('mingw32'), expect_broken(5289)),
        unless(doing_ghci, skip),
        extra_clean(['dir006/*','dir006'])
      ],
@@ -44,8 +40,7 @@ test('ghcilink006',
 test('T3333',
      [extra_clean('T3333.o'),
      unless(doing_ghci, skip),
-     unless(opsys('linux') or ghci_dynamic(), expect_broken(3333))],
+     unless(ghci_dynamic(), expect_broken(3333))],
      run_command,
      ['$MAKE -s --no-print-directory T3333'])
 
-test('T1407', normal, ghci_script, ['T1407.script'])
diff --git a/testsuite/tests/ghci/linking/dyn/A.c b/testsuite/tests/ghci/linking/dyn/A.c
new file mode 100644
index 000000000000..fec94f2829fe
--- /dev/null
+++ b/testsuite/tests/ghci/linking/dyn/A.c
@@ -0,0 +1,17 @@
+#if defined(_MSC_VER)
+    //  Microsoft
+    #define EXPORT __declspec(dllexport)
+#elif defined(_GCC)
+    //  GCC
+    #define EXPORT __attribute__((visibility("default")))
+#else
+    //  do nothing and hope for the best?
+    #define EXPORT
+#endif
+
+extern EXPORT int foo();
+
+EXPORT int foo()
+{
+    return 2;
+}
diff --git a/testsuite/tests/ghci/linking/dyn/Makefile b/testsuite/tests/ghci/linking/dyn/Makefile
new file mode 100644
index 000000000000..8a3b7363e458
--- /dev/null
+++ b/testsuite/tests/ghci/linking/dyn/Makefile
@@ -0,0 +1,23 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+ifeq "$(WINDOWS)" "YES"
+DLL = lib$1.dll
+else ifeq "$(DARWIN)" "YES"
+DLL = lib$1.dylib
+else
+DLL = lib$1.so
+endif
+
+
+.PHONY: load_short_name
+load_short_name:
+	rm -rf bin_short
+	mkdir bin_short
+	gcc -shared A.c -o "bin_short/$(call DLL,A)"
+	echo ":q" | "$(TEST_HC)" --interactive -L"$(PWD)/bin_short" -lA -v0
+
+.PHONY: compile_libAS
+compile_libAS:
+	gcc -shared A.c -o $(call DLL,AS)
diff --git a/testsuite/tests/ghci/linking/dyn/T1407.script b/testsuite/tests/ghci/linking/dyn/T1407.script
new file mode 100644
index 000000000000..0274f8245dd0
--- /dev/null
+++ b/testsuite/tests/ghci/linking/dyn/T1407.script
@@ -0,0 +1,4 @@
+:set -lAS
+import Foreign
+import Foreign.C.Types
+foreign import ccall "foo" dle :: IO CInt
diff --git a/testsuite/tests/ghci/linking/dyn/all.T b/testsuite/tests/ghci/linking/dyn/all.T
new file mode 100644
index 000000000000..2810c7f29fc3
--- /dev/null
+++ b/testsuite/tests/ghci/linking/dyn/all.T
@@ -0,0 +1,12 @@
+test('load_short_name',
+	 [unless(doing_ghci, skip),
+	 extra_clean(['bin_short/*', 'bin_short'])],
+	 run_command,
+	 ['$MAKE -s --no-print-directory load_short_name'])
+
+test('T1407',
+	 [unless(doing_ghci, skip),
+	 extra_clean(['libAS.*']),
+     pre_cmd('$MAKE -s --no-print-directory compile_libAS'),
+     extra_hc_opts('-L.')],
+	 ghci_script, ['T1407.script'])
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 70a816b5e03d..ec5559ef2ddb 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -204,7 +204,7 @@ test('T9878',
     ghci_script, ['T9878.script'])
 test('T9878b',
     [ extra_run_opts('-fobject-code'),
-      extra_clean(['T9878.hi','T9878.o'])],
+      extra_clean(['T9878b.hi','T9878b.o'])],
     ghci_script, ['T9878b.script'])
 
 test('T10321', normal, ghci_script, ['T10321.script'])
-- 
GitLab