diff options
-rw-r--r-- | testsuite/tests/rts/linker/Makefile | 6 | ||||
-rw-r--r-- | testsuite/tests/rts/linker/T20494-obj.cpp | 22 | ||||
-rw-r--r-- | testsuite/tests/rts/linker/T20494.hs | 55 | ||||
-rw-r--r-- | testsuite/tests/rts/linker/all.T | 5 |
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']), |