summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2021-10-08 08:48:19 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-07-16 23:50:36 -0400
commitcdd3be20684c696d9008b6ca7c83731adb13e1b6 (patch)
treeb58a2b9bc5807756abb3d2fee8e04894eae8c40d
parent616365b01ea6552c39e211a42df4cb33762f481e (diff)
downloadhaskell-cdd3be20684c696d9008b6ca7c83731adb13e1b6.tar.gz
testsuite: Add T20494
-rw-r--r--testsuite/tests/rts/linker/Makefile6
-rw-r--r--testsuite/tests/rts/linker/T20494-obj.c14
-rw-r--r--testsuite/tests/rts/linker/T20494.hs62
-rw-r--r--testsuite/tests/rts/linker/T20494.stdout5
-rw-r--r--testsuite/tests/rts/linker/all.T5
5 files changed, 92 insertions, 0 deletions
diff --git a/testsuite/tests/rts/linker/Makefile b/testsuite/tests/rts/linker/Makefile
index 3c78908d5d..bbfd067f30 100644
--- a/testsuite/tests/rts/linker/Makefile
+++ b/testsuite/tests/rts/linker/Makefile
@@ -120,6 +120,12 @@ T7072:
"$(TEST_HC)" T7072-main.c -o T7072-main -no-hs-main -debug
./T7072-main T7072-obj.o
+.PHONY: T20494
+T20494:
+ "$(TEST_HC)" $(TEST_HC_OPTS) -c T20494-obj.c -o T20494-obj.o
+ "$(TEST_HC)" -v0 T20494.hs
+ ./T20494 T20494-obj.o
+
.PHONY: T20918
T20918:
"$(TEST_HC)" -c T20918_v.cc -o T20918_v.o
diff --git a/testsuite/tests/rts/linker/T20494-obj.c b/testsuite/tests/rts/linker/T20494-obj.c
new file mode 100644
index 0000000000..ed073d6cfa
--- /dev/null
+++ b/testsuite/tests/rts/linker/T20494-obj.c
@@ -0,0 +1,14 @@
+#include <stdio.h>
+
+#define CONSTRUCTOR(prio) __attribute__((constructor(prio)))
+#define DESTRUCTOR(prio) __attribute__((destructor(prio)))
+#define PRINT(str) printf(str); fflush(stdout)
+
+CONSTRUCTOR(1000) void constr_a(void) { PRINT("constr a\n"); }
+CONSTRUCTOR(2000) void constr_b(void) { PRINT("constr b\n"); }
+DESTRUCTOR(2000) void destr_b(void) { PRINT("destr b\n"); }
+DESTRUCTOR(1000) void destr_a(void) { PRINT("destr a\n"); }
+
+void hello() {
+ PRINT("hello\n");
+}
diff --git a/testsuite/tests/rts/linker/T20494.hs b/testsuite/tests/rts/linker/T20494.hs
new file mode 100644
index 0000000000..dc5b68eeac
--- /dev/null
+++ b/testsuite/tests/rts/linker/T20494.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE ForeignFunctionInterface, CPP #-}
+import Foreign.C.String
+import Control.Monad
+import System.Environment
+import System.FilePath
+import Foreign.Ptr
+import System.Mem
+
+-- Type of paths is different on Windows
+#if defined(mingw32_HOST_OS)
+type PathString = CWString
+withPathString = withCWString
+#else
+type PathString = CString
+withPathString = withCString
+#endif
+
+-- | All symbols begin with an underscore on Darwin
+withUnderscore :: String -> String
+#if defined(darwin_HOST_OS)
+withUnderscore = ("_" ++)
+#else
+withUnderscore = id
+#endif
+
+foreign import ccall "initLinker"
+ initLinker :: IO ()
+foreign import ccall "loadObj"
+ loadObj :: PathString -> IO Int
+foreign import ccall "resolveObjs"
+ resolveObjs :: IO Int
+foreign import ccall "lookupSymbol"
+ lookupSymbol :: CString -> IO (FunPtr a)
+foreign import ccall "unloadObj"
+ unloadObj :: PathString -> IO Int
+
+type HelloFn = IO ()
+foreign import ccall "dynamic"
+ mkHello :: FunPtr HelloFn -> HelloFn
+
+main :: IO ()
+main = do
+ [objPath] <- getArgs
+ initLinker
+
+ r <- withPathString objPath loadObj
+ when (r /= 1) $ error "loadObj failed"
+
+ r <- resolveObjs
+ when (r /= 1) $ error "resolveObj failed"
+
+ ptr <- withCString (withUnderscore "hello") lookupSymbol
+ when (nullFunPtr == ptr) $ error "lookupSymbol failed"
+
+ let hello = mkHello ptr
+ hello
+
+ withPathString objPath unloadObj
+ when (r /= 1) $ error "unloadObj failed"
+
+ -- Perform a major GC to ensure that the object can be unloaded.
+ performMajorGC \ No newline at end of file
diff --git a/testsuite/tests/rts/linker/T20494.stdout b/testsuite/tests/rts/linker/T20494.stdout
new file mode 100644
index 0000000000..d80bddc350
--- /dev/null
+++ b/testsuite/tests/rts/linker/T20494.stdout
@@ -0,0 +1,5 @@
+constr a
+constr b
+hello
+destr b
+destr a
diff --git a/testsuite/tests/rts/linker/all.T b/testsuite/tests/rts/linker/all.T
index 0cb93370aa..b7a9eda203 100644
--- a/testsuite/tests/rts/linker/all.T
+++ b/testsuite/tests/rts/linker/all.T
@@ -118,6 +118,11 @@ test('T7072',
req_rts_linker],
makefile_test, ['T7072'])
+test('T20494',
+ [req_rts_linker,
+ # The PEi386 linker doesn't yet support finalizers
+ when(opsys('mingw32'), expect_broken(20494))],
+ makefile_test, ['T20494'])
test('T20918',
[extra_files(['T20918_v.cc']),