From 7613a812888424b49cb334a4e63bd7280adf2774 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri, 13 Apr 2018 11:33:54 -0400
Subject: [PATCH] Fix #9438 by converting a panic to an error message

Previously, GHC was quite eager to panic whenever it was fed
an archive file when `DYNAMIC_GHC_PROGRAMS=YES`. This ought to be an
explicit error message instead, so this patch accomplishes just that.

Test Plan: make test TEST=T14708

Reviewers: Phyx, hvr, bgamari

Reviewed By: Phyx

Subscribers: thomie, carter

GHC Trac Issues: #9438, #14708, #15032

Differential Revision: https://phabricator.haskell.org/D4589
---
 compiler/ghci/Linker.hs                    | 15 +++++++++++++--
 testsuite/.gitignore                       |  1 +
 testsuite/tests/ghci/linking/Makefile      | 18 +++++++++++++-----
 testsuite/tests/ghci/linking/T14708.hs     |  2 ++
 testsuite/tests/ghci/linking/T14708.stderr |  4 ++++
 testsuite/tests/ghci/linking/add.c         |  1 +
 testsuite/tests/ghci/linking/all.T         |  8 ++++++++
 7 files changed, 42 insertions(+), 7 deletions(-)
 create mode 100644 testsuite/tests/ghci/linking/T14708.hs
 create mode 100644 testsuite/tests/ghci/linking/T14708.stderr
 create mode 100644 testsuite/tests/ghci/linking/add.c

diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index a91df323ceb..8d0338a9ddf 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -71,7 +71,10 @@ import System.Win32.Info (getSystemDirectory)
 
 import Exception
 
-import Foreign (Ptr) -- needed for 2nd stage
+-- needed for 2nd stage
+#if STAGE >= 2
+import Foreign (Ptr)
+#endif
 
 {- **********************************************************************
 
@@ -504,9 +507,17 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do
        = do b <- doesFileExist name
             if not b then return False
                      else do if dynamicGhc
-                                 then panic "Loading archives not supported"
+                                 then throwGhcExceptionIO $
+                                      CmdLineError dynamic_msg
                                  else loadArchive hsc_env name
                              return True
+      where
+        dynamic_msg = unlines
+          [ "User-specified static library could not be loaded ("
+            ++ name ++ ")"
+          , "Loading static libraries is not supported in this configuration."
+          , "Try using a dynamic library instead."
+          ]
 
 
 {- **********************************************************************
diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index e6934f966ac..7c4453e58ab 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -776,6 +776,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
 /tests/ghci/linking/dir004/
 /tests/ghci/linking/dir005/
 /tests/ghci/linking/dir006/
+/tests/ghci/linking/T14708scratch/
 /tests/ghci/prog001/C.hs
 /tests/ghci/prog001/D.hs
 /tests/ghci/prog002/A.hs
diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile
index 793152d68e6..793998eb926 100644
--- a/testsuite/tests/ghci/linking/Makefile
+++ b/testsuite/tests/ghci/linking/Makefile
@@ -40,11 +40,11 @@ ghcilink002 :
 ghcilink003 :
 	echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -lstdc++
 
-# Test 4: 
+# Test 4:
 #   package P
 #      library-dirs: `pwd`/dir004
 #      extra-libraries: foo
-#   with 
+#   with
 #    dir004/libfoo.a
 
 LOCAL_PKGCONF004=dir004/local.package.conf
@@ -68,11 +68,11 @@ ghcilink004 :
 	"$(AR)" cqs dir004/libfoo.a dir004/foo.o
 	echo "test" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -package-db $(LOCAL_PKGCONF004) -package test TestLink.hs
 
-# Test 5: 
+# Test 5:
 #   package P
 #      library-dirs: `pwd`/dir005
 #      extra-libraries: foo
-#   with 
+#   with
 #    dir005/libfoo.so
 
 LOCAL_PKGCONF005=dir005/ghcilink005.package.conf
@@ -96,7 +96,7 @@ ghcilink005 :
 	"$(TEST_HC)" -no-auto-link-packages -shared -o dir005/$(call DLL,foo) dir005/foo.o
 	echo "test" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -package-db $(LOCAL_PKGCONF005) -package test TestLink.hs
 
-# Test 6: 
+# Test 6:
 #   package P
 #      extra-libraries: stdc++
 
@@ -126,3 +126,11 @@ endif
 T3333:
 	"$(TEST_HC)" -c T3333.c -o T3333.o
 	echo "weak_test 10" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T3333.hs T3333.o
+
+.PHONY: T14708
+T14708:
+	$(RM) -rf T14708scratch
+	mkdir T14708scratch
+	"$(TEST_HC)" -c add.c -o T14708scratch/add.o
+	"$(AR)" cqs T14708scratch/libadd.a T14708scratch/add.o
+	-"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -LT14708scratch -ladd T14708.hs
diff --git a/testsuite/tests/ghci/linking/T14708.hs b/testsuite/tests/ghci/linking/T14708.hs
new file mode 100644
index 00000000000..377b6b5516c
--- /dev/null
+++ b/testsuite/tests/ghci/linking/T14708.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = return ()
diff --git a/testsuite/tests/ghci/linking/T14708.stderr b/testsuite/tests/ghci/linking/T14708.stderr
new file mode 100644
index 00000000000..fabbdb40f2a
--- /dev/null
+++ b/testsuite/tests/ghci/linking/T14708.stderr
@@ -0,0 +1,4 @@
+<command line>: User-specified static library could not be loaded (T14708scratch/libadd.a)
+Loading static libraries is not supported in this configuration.
+Try using a dynamic library instead.
+
diff --git a/testsuite/tests/ghci/linking/add.c b/testsuite/tests/ghci/linking/add.c
new file mode 100644
index 00000000000..538880cdc10
--- /dev/null
+++ b/testsuite/tests/ghci/linking/add.c
@@ -0,0 +1 @@
+int add2(int x, int y) { return x + y; }
diff --git a/testsuite/tests/ghci/linking/all.T b/testsuite/tests/ghci/linking/all.T
index 124b3a40b7e..f9617c5cf77 100644
--- a/testsuite/tests/ghci/linking/all.T
+++ b/testsuite/tests/ghci/linking/all.T
@@ -31,3 +31,11 @@ test('T3333',
       unless(opsys('linux') or opsys('darwin') or ghc_dynamic(),
              expect_broken(3333))],
      run_command, ['$MAKE -s --no-print-directory T3333'])
+
+test('T14708',
+     [extra_files(['T14708.hs', 'add.c']),
+      unless(doing_ghci, skip),
+      unless(ghc_dynamic(), skip),
+      extra_clean(['T14708scratch/*', 'T14708'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T14708'])
-- 
GitLab