testsuite: Add T20494wip/T20494

4 files changed, 88 insertions, 0 deletions

diff --git a/testsuite/tests/rts/linker/Makefile b/testsuite/tests/rts/linker/Makefile
index 3c78908d5d..cd04858e4e 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)" -c T20494-obj.cpp -o T20494-obj.o
+	"$(TEST_HC)" T20494.hs -package system-cxx-std-lib
+	./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.cpp b/testsuite/tests/rts/linker/T20494-obj.cpp
new file mode 100644
index 0000000000..d0cc52704a
--- /dev/null
+++ b/testsuite/tests/rts/linker/T20494-obj.cpp
@@ -0,0 +1,22 @@
+#include <cstdio>
+
+class A {
+public:
+    const char *msg;
+    A(const char *msg) {
+        printf("constr %s\n", msg); 
+        this->msg = msg;
+    }
+
+    ~A() {
+        printf("destroy %s\n", this->msg); 
+    }
+};
+
+A a("helloA");
+A b("helloB");
+
+int main() {
+    printf("main\n");
+    return 0;
+}
diff --git a/testsuite/tests/rts/linker/T20494.hs b/testsuite/tests/rts/linker/T20494.hs
new file mode 100644
index 0000000000..590a9aa258
--- /dev/null
+++ b/testsuite/tests/rts/linker/T20494.hs
@@ -0,0 +1,55 @@
+{-# 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
+
+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 "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
+    putStrLn "done"
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']),