Commit d4a2cce1 authored by Simon Marlow's avatar Simon Marlow

Add a test for unloading object files in the linker (#8039)

parent 5314acb9
......@@ -62,3 +62,25 @@ T7037:
T7040_ghci_setup :
'$(TEST_HC)' $(TEST_HC_OPTS) $(ghciWayFlags) -c T7040_ghci_c.c
LOCAL_GHC_PKG = '$(GHC_PKG)' --no-user-package-db
BASE_DIR = $(shell $(LOCAL_GHC_PKG) field base library-dirs | sed 's/^.*: *//')
BASE_LIB = $(shell $(LOCAL_GHC_PKG) field base hs-libraries | sed 's/^.*: *//')
GHC_PRIM_DIR = $(shell $(LOCAL_GHC_PKG) field ghc-prim library-dirs | sed 's/^.*: *//')
GHC_PRIM_LIB = $(shell $(LOCAL_GHC_PKG) field ghc-prim hs-libraries | sed 's/^.*: *//')
INTEGER_GMP_DIR = $(shell $(LOCAL_GHC_PKG) field integer-gmp library-dirs | sed 's/^.*: *//')
INTEGER_GMP_LIB = $(shell $(LOCAL_GHC_PKG) field integer-gmp hs-libraries | sed 's/^.*: *//')
$(warning xxx$(BASE_DIR)xxx)
BASE = $(BASE_DIR)/lib$(BASE_LIB).a
GHC_PRIM = $(GHC_PRIM_DIR)/lib$(GHC_PRIM_LIB).a
INTEGER_GMP = $(INTEGER_GMP_DIR)/lib$(INTEGER_GMP_LIB).a
.PHONY: linker_unload
linker_unload:
$(RM) Test.o Test.hi
"$(TEST_HC)" $(TEST_HC_OPTS) -c Test.hs -v0
# -rtsopts causes a warning
"$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload.c -o linker_unload -no-hs-main
./linker_unload $(BASE) $(GHC_PRIM) $(INTEGER_GMP)
module Test where
f :: Int -> Int
f x = x + 1
foreign export ccall f :: Int -> Int
......@@ -180,3 +180,8 @@ test('T7919', [extra_clean(['T7919A.o','T7919A.hi',
compile_and_run, [''])
test('T8035', normal, compile_and_run, [''])
test('linker_unload',
[ extra_clean(['Test.o','Test.hi', 'linker_unload']) ],
run_command,
['$MAKE -s --no-print-directory linker_unload'])
#include <stdio.h>
#include "Rts.h"
#define ITERATIONS 10000
#define OBJPATH "Test.o"
typedef int testfun(int);
#define BASE "/home/simon/code-all/work/ghc-validate/libraries/base/dist-install/build/libHSbase-4.7.0.0.a"
#define GHCPRIM "/home/simon/code-all/work/ghc-validate/libraries/ghc-prim/dist-install/build/libHSghc-prim-0.3.1.0.a"
void loadPkg(char *path)
{
int r;
r = loadArchive(path);
if (!r) {
errorBelch("loadObjs(%s) failed", path);
exit(1);
}
}
int main (int argc, char *argv[])
{
testfun *f;
int i, r;
hs_init(&argc, &argv);
initLinker();
for (i=1; i < argc; i++) {
loadPkg(argv[i]);
}
for (i=0; i < ITERATIONS; i++) {
r = loadObj(OBJPATH);
if (!r) {
errorBelch("loadObj(%s) failed", OBJPATH);
exit(1);
}
r = resolveObjs();
if (!r) {
errorBelch("resolveObjs failed");
exit(1);
}
f = lookupSymbol("f");
if (!f) {
errorBelch("lookupSymbol failed");
exit(1);
}
r = f(3);
if (r != 4) {
errorBelch("call failed; %d", r);
exit(1);
}
unloadObj(OBJPATH);
performMajorGC();
printf("%d ", i);
fflush(stdout);
}
}
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment