[Git][ghc/ghc][wip/backport-MR706] 8 commits: testsuite: Introduce fragile modifier
Ben Gamari
gitlab at gitlab.haskell.org
Wed Jun 12 12:40:43 UTC 2019
Ben Gamari pushed to branch wip/backport-MR706 at Glasgow Haskell Compiler / GHC
Commits:
175d49e6 by Ben Gamari at 2019-06-12T00:07:25Z
testsuite: Introduce fragile modifier
Now since we have been a bit more stringent in testsuite cleanliness we
have been marking a lot of tests as fragile using the `skip` modifier.
However, this unfortunately means that we lose the association with the
ticket number documenting the fragility.
Here we introduce `fragile` and `fragile_for` to retain this
information.
(cherry picked from commit 4ca271d1880a6f4c5f49869de7f1920a2073adb6)
- - - - -
18ffc386 by Ben Gamari at 2019-06-12T00:07:25Z
testsuite: Mark heapprof001 as fragile on i386
(cherry picked from commit 910185a3eb5fd2148e42d39f6374ab03d098b682)
- - - - -
a9a34082 by Ben Gamari at 2019-06-12T00:07:25Z
testsuite: Mark heapprof001 as fragile on all platforms
See #15382.
(cherry picked from commit 23fc615679072a6fa433460a92f597af2ae388b2)
- - - - -
9c385294 by Ben Gamari at 2019-06-12T00:07:25Z
base: Mark CPUTime001 as fragile
As noted in #16224, CPUTime001 has been quite problematic, reporting
non-monotonic timestamps in CI. Unfortunately I've been unable to
reproduce this locally.
(cherry picked from commit 1a3420cabdcf6d7d90c154681230f1150604c097)
- - - - -
c993dee9 by Ben Gamari at 2019-06-12T00:07:25Z
testsuite: Mark T13167 as fragile in threaded2
As noted in #16536.
(cherry picked from commit b351004702c1a595bcedfa3ffeb4f816d5fd8503)
- - - - -
5993703c by Ben Gamari at 2019-06-12T00:07:25Z
testsuite: Fix fragile_for test modifier
(cherry picked from commit 658199cce0aabeed77f3bbbbde6abc0c5c3cc83d)
- - - - -
5e6f261a by Ben Gamari at 2019-06-12T00:07:25Z
testsuite: Mark threadstatus-T9333 as fragile in ghci way
As noted in #16555.
(cherry picked from commit 64b1684da09ddb3dc480bd0370adc7b002657a39)
- - - - -
ce1e6538 by Phuong Trinh at 2019-06-12T12:40:33Z
Use binary search to speedup checkUnload
We are iterating through all object code for each heap objects when
checking whether object code can be unloaded. For large projects in
GHCi, this can be very expensive due to the large number of object code
that needs to be loaded/unloaded. To speed it up, this arrangess all
mapped sections of unloaded object code in a sorted array and use binary
search to check if an address location fall on them.
(cherry picked from commit f81f3964b718eab21f0cfe65067c195f2f2a84bd)
- - - - -
13 changed files:
- libraries/base/tests/all.T
- rts/CheckUnload.c
- testsuite/driver/testlib.py
- testsuite/tests/concurrent/should_run/all.T
- testsuite/tests/profiling/should_run/all.T
- + testsuite/tests/rts/unload_multiple_objs/A.hs
- + testsuite/tests/rts/unload_multiple_objs/B.hs
- + testsuite/tests/rts/unload_multiple_objs/C.hs
- + testsuite/tests/rts/unload_multiple_objs/D.hs
- + testsuite/tests/rts/unload_multiple_objs/Makefile
- + testsuite/tests/rts/unload_multiple_objs/all.T
- + testsuite/tests/rts/unload_multiple_objs/linker_unload_multiple_objs.c
- + testsuite/tests/rts/unload_multiple_objs/linker_unload_multiple_objs.stdout
Changes:
=====================================
libraries/base/tests/all.T
=====================================
@@ -20,7 +20,7 @@ test('tempfiles', normal, compile_and_run, [''])
test('fixed', normal, compile_and_run, [''])
test('quotOverflow', normal, compile_and_run, [''])
test('assert', exit_code(1), compile_and_run, ['-fno-ignore-asserts'])
-test('CPUTime001', normal, compile_and_run, [''])
+test('CPUTime001', fragile(16224), compile_and_run, [''])
test('readLitChar', normal, compile_and_run, [''])
test('unicode001',
when(platform('i386-unknown-openbsd'), expect_fail),
@@ -231,5 +231,5 @@ test('T3474',
test('T14425', normal, compile_and_run, [''])
test('T10412', normal, compile_and_run, [''])
test('T13896', normal, compile_and_run, [''])
-test('T13167', normal, compile_and_run, [''])
+test('T13167', fragile_for(16536, ['threaded2']), compile_and_run, [''])
test('T15349', [exit_code(1), expect_broken_for(15349, 'ghci')], compile_and_run, [''])
=====================================
rts/CheckUnload.c
=====================================
@@ -38,30 +38,130 @@
// object as referenced so that it won't get unloaded in this round.
//
-static void checkAddress (HashTable *addrs, const void *addr)
+// Note [Speeding up checkUnload]
+// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+// In certain circumstances, there may be a lot of unloaded ObjectCode structs
+// chained in `unloaded_objects` (such as when users `:load` a module in a very
+// big repo in GHCi). To speed up checking whether an address lies within any of
+// these objects, we populate the addresses of their mapped sections in
+// an array sorted by their `start` address and do binary search for our address
+// on that array. Note that this works because the sections are mapped to mutual
+// exclusive memory regions, so we can simply find the largest lower bound among
+// the `start` addresses of the sections and then check if our address is inside
+// that section. In particular, we store the start address and end address of
+// each mapped section in a OCSectionIndex, arrange them all on a contiguous
+// memory range and then sort by start address. We then put this array in an
+// OCSectionIndices struct to be passed into `checkAddress` to do binary search
+// on.
+//
+
+typedef struct {
+ W_ start;
+ W_ end;
+ ObjectCode *oc;
+} OCSectionIndex;
+
+typedef struct {
+ int n_sections;
+ OCSectionIndex *indices;
+} OCSectionIndices;
+
+static OCSectionIndices *createOCSectionIndices(int n_sections)
+{
+ OCSectionIndices *s_indices;
+ s_indices = stgMallocBytes(sizeof(OCSectionIndices), "OCSectionIndices");
+ s_indices->n_sections = n_sections;
+ s_indices->indices = stgMallocBytes(n_sections*sizeof(OCSectionIndex),
+ "OCSectionIndices::indices");
+ return s_indices;
+}
+
+static int cmpSectionIndex(const void* indexa, const void *indexb)
+{
+ W_ s1 = ((OCSectionIndex*)indexa)->start;
+ W_ s2 = ((OCSectionIndex*)indexb)->start;
+ if (s1 < s2) {
+ return -1;
+ } else if (s1 > s2) {
+ return 1;
+ }
+ return 0;
+}
+
+static OCSectionIndices* buildOCSectionIndices(ObjectCode *ocs)
+{
+ int cnt_sections = 0;
+ ObjectCode *oc;
+ for (oc = ocs; oc; oc = oc->next) {
+ cnt_sections += oc->n_sections;
+ }
+ OCSectionIndices* s_indices = createOCSectionIndices(cnt_sections);
+ int s_i = 0, i;
+ for (oc = ocs; oc; oc = oc->next) {
+ for (i = 0; i < oc->n_sections; i++) {
+ if (oc->sections[i].kind != SECTIONKIND_OTHER) {
+ s_indices->indices[s_i].start = (W_)oc->sections[i].start;
+ s_indices->indices[s_i].end = (W_)oc->sections[i].start
+ + oc->sections[i].size;
+ s_indices->indices[s_i].oc = oc;
+ s_i++;
+ }
+ }
+ }
+ s_indices->n_sections = s_i;
+ qsort(s_indices->indices,
+ s_indices->n_sections,
+ sizeof(OCSectionIndex),
+ cmpSectionIndex);
+ return s_indices;
+}
+
+static void freeOCSectionIndices(OCSectionIndices *section_indices)
+{
+ free(section_indices->indices);
+ free(section_indices);
+}
+
+static ObjectCode *findOC(OCSectionIndices *s_indices, const void *addr) {
+ W_ w_addr = (W_)addr;
+ if (s_indices->n_sections <= 0) return NULL;
+ if (w_addr < s_indices->indices[0].start) return NULL;
+
+ int left = 0, right = s_indices->n_sections;
+ while (left + 1 < right) {
+ int mid = (left + right)/2;
+ W_ w_mid = s_indices->indices[mid].start;
+ if (w_mid <= w_addr) {
+ left = mid;
+ } else {
+ right = mid;
+ }
+ }
+ ASSERT(w_addr >= s_indices->indices[left].start);
+ if (w_addr < s_indices->indices[left].end) {
+ return s_indices->indices[left].oc;
+ }
+ return NULL;
+}
+
+static void checkAddress (HashTable *addrs, const void *addr,
+ OCSectionIndices *s_indices)
{
ObjectCode *oc;
- int i;
if (!lookupHashTable(addrs, (W_)addr)) {
insertHashTable(addrs, (W_)addr, addr);
- for (oc = unloaded_objects; oc; oc = oc->next) {
- for (i = 0; i < oc->n_sections; i++) {
- if (oc->sections[i].kind != SECTIONKIND_OTHER) {
- if ((W_)addr >= (W_)oc->sections[i].start &&
- (W_)addr < (W_)oc->sections[i].start
- + oc->sections[i].size) {
- oc->referenced = 1;
- return;
- }
- }
- }
+ oc = findOC(s_indices, addr);
+ if (oc != NULL) {
+ oc->referenced = 1;
+ return;
}
}
}
-static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end)
+static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end,
+ OCSectionIndices *s_indices)
{
StgPtr p;
const StgRetInfoTable *info;
@@ -73,7 +173,7 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end)
switch (info->i.type) {
case RET_SMALL:
case RET_BIG:
- checkAddress(addrs, (const void*)info);
+ checkAddress(addrs, (const void*)info, s_indices);
break;
default:
@@ -85,7 +185,8 @@ static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end)
}
-static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
+static void searchHeapBlocks (HashTable *addrs, bdescr *bd,
+ OCSectionIndices *s_indices)
{
StgPtr p;
const StgInfoTable *info;
@@ -189,7 +290,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
prim = true;
size = ap_stack_sizeW(ap);
searchStackChunk(addrs, (StgPtr)ap->payload,
- (StgPtr)ap->payload + ap->size);
+ (StgPtr)ap->payload + ap->size, s_indices);
break;
}
@@ -223,7 +324,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
StgStack *stack = (StgStack*)p;
prim = true;
searchStackChunk(addrs, stack->sp,
- stack->stack + stack->stack_size);
+ stack->stack + stack->stack_size, s_indices);
size = stack_sizeW(stack);
break;
}
@@ -238,7 +339,7 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
}
if (!prim) {
- checkAddress(addrs,info);
+ checkAddress(addrs,info, s_indices);
}
p += size;
@@ -251,15 +352,16 @@ static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
// Do not unload the object if the CCS tree refers to a CCS or CC which
// originates in the object.
//
-static void searchCostCentres (HashTable *addrs, CostCentreStack *ccs)
+static void searchCostCentres (HashTable *addrs, CostCentreStack *ccs,
+ OCSectionIndices* s_indices)
{
IndexTable *i;
- checkAddress(addrs, ccs);
- checkAddress(addrs, ccs->cc);
+ checkAddress(addrs, ccs, s_indices);
+ checkAddress(addrs, ccs->cc, s_indices);
for (i = ccs->indexTable; i != NULL; i = i->next) {
if (!i->back_edge) {
- searchCostCentres(addrs, i->ccs);
+ searchCostCentres(addrs, i->ccs, s_indices);
}
}
}
@@ -288,6 +390,7 @@ void checkUnload (StgClosure *static_objects)
ACQUIRE_LOCK(&linker_unloaded_mutex);
+ OCSectionIndices *s_indices = buildOCSectionIndices(unloaded_objects);
// Mark every unloadable object as unreferenced initially
for (oc = unloaded_objects; oc; oc = oc->next) {
IF_DEBUG(linker, debugBelch("Checking whether to unload %" PATH_FMT "\n",
@@ -299,7 +402,7 @@ void checkUnload (StgClosure *static_objects)
for (p = static_objects; p != END_OF_STATIC_OBJECT_LIST; p = link) {
p = UNTAG_STATIC_LIST_PTR(p);
- checkAddress(addrs, p);
+ checkAddress(addrs, p, s_indices);
info = get_itbl(p);
link = *STATIC_LINK(info, p);
}
@@ -309,32 +412,33 @@ void checkUnload (StgClosure *static_objects)
p != END_OF_CAF_LIST;
p = ((StgIndStatic *)p)->static_link) {
p = UNTAG_STATIC_LIST_PTR(p);
- checkAddress(addrs, p);
+ checkAddress(addrs, p, s_indices);
}
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
- searchHeapBlocks (addrs, generations[g].blocks);
- searchHeapBlocks (addrs, generations[g].large_objects);
+ searchHeapBlocks (addrs, generations[g].blocks, s_indices);
+ searchHeapBlocks (addrs, generations[g].large_objects, s_indices);
for (n = 0; n < n_capabilities; n++) {
ws = &gc_threads[n]->gens[g];
- searchHeapBlocks(addrs, ws->todo_bd);
- searchHeapBlocks(addrs, ws->part_list);
- searchHeapBlocks(addrs, ws->scavd_list);
+ searchHeapBlocks(addrs, ws->todo_bd, s_indices);
+ searchHeapBlocks(addrs, ws->part_list, s_indices);
+ searchHeapBlocks(addrs, ws->scavd_list, s_indices);
}
}
#if defined(PROFILING)
/* Traverse the cost centre tree, calling checkAddress on each CCS/CC */
- searchCostCentres(addrs, CCS_MAIN);
+ searchCostCentres(addrs, CCS_MAIN, s_indices);
/* Also check each cost centre in the CC_LIST */
CostCentre *cc;
for (cc = CC_LIST; cc != NULL; cc = cc->link) {
- checkAddress(addrs, cc);
+ checkAddress(addrs, cc, s_indices);
}
#endif /* PROFILING */
+ freeOCSectionIndices(s_indices);
// Look through the unloadable objects, and any object that is still
// marked as unreferenced can be physically unloaded, because we
// have no references to it.
=====================================
testsuite/driver/testlib.py
=====================================
@@ -225,11 +225,35 @@ def _expect_pass(way):
# -----
+def fragile( bug ):
+ """
+ Indicates that the test should be skipped due to fragility documented in
+ the given ticket.
+ """
+ def helper( name, opts, bug=bug ):
+ record_broken(name, opts, bug)
+ opts.skip = True
+
+ return helper
+
+def fragile_for( bug, ways ):
+ """
+ Indicates that the test should be skipped due to fragility in the given
+ test ways as documented in the given ticket.
+ """
+ def helper( name, opts, bug=bug, ways=ways ):
+ record_broken(name, opts, bug)
+ opts.omit_ways += ways
+
+ return helper
+
+# -----
+
def omit_ways( ways ):
return lambda name, opts, w=ways: _omit_ways( name, opts, w )
def _omit_ways( name, opts, ways ):
- opts.omit_ways = ways
+ opts.omit_ways += ways
# -----
=====================================
testsuite/tests/concurrent/should_run/all.T
=====================================
@@ -89,7 +89,7 @@ test('T7970', normal, compile_and_run, [''])
test('AtomicPrimops', normal, compile_and_run, [''])
# test uses 2 threads and yield, scheduling can vary with threaded2
-test('threadstatus-9333', [omit_ways(['threaded2'])], compile_and_run, [''])
+test('threadstatus-9333', [fragile_for(16555, ['ghci']), omit_ways(['threaded2'])], compile_and_run, [''])
test('T9379', normal, compile_and_run, [''])
=====================================
testsuite/tests/profiling/should_run/all.T
=====================================
@@ -24,7 +24,7 @@ expect_broken_for_10037 = expect_broken_for(
test('heapprof001',
[when(have_profiling(), extra_ways(extra_prof_ways)),
- when(arch('i386'), expect_broken_for(15382, ['prof_hc_hb'])),
+ fragile(15382),
extra_run_opts('7')],
compile_and_run, [''])
=====================================
testsuite/tests/rts/unload_multiple_objs/A.hs
=====================================
@@ -0,0 +1,16 @@
+module A where
+
+import Foreign.StablePtr
+
+id1 :: Int
+id1 = 1
+
+createHeapObjectA :: IO (StablePtr [Int])
+createHeapObjectA = do
+ newStablePtr [2+id1]
+
+freeHeapObjectA :: StablePtr [Int] -> IO ()
+freeHeapObjectA obj = freeStablePtr obj
+
+foreign export ccall createHeapObjectA :: IO (StablePtr [Int])
+foreign export ccall freeHeapObjectA :: StablePtr [Int] -> IO ()
=====================================
testsuite/tests/rts/unload_multiple_objs/B.hs
=====================================
@@ -0,0 +1,16 @@
+module B where
+
+import Foreign.StablePtr
+
+id2 :: Int
+id2 = 2
+
+createHeapObjectB :: IO (StablePtr [Int])
+createHeapObjectB = do
+ newStablePtr [2+id2]
+
+freeHeapObjectB :: StablePtr [Int] -> IO ()
+freeHeapObjectB obj = freeStablePtr obj
+
+foreign export ccall createHeapObjectB :: IO (StablePtr [Int])
+foreign export ccall freeHeapObjectB :: StablePtr [Int] -> IO ()
=====================================
testsuite/tests/rts/unload_multiple_objs/C.hs
=====================================
@@ -0,0 +1,16 @@
+module C where
+
+import Foreign.StablePtr
+
+id3 :: Int
+id3 = 3
+
+createHeapObjectC :: IO (StablePtr [Int])
+createHeapObjectC = do
+ newStablePtr [2+id3]
+
+freeHeapObjectC :: StablePtr [Int] -> IO ()
+freeHeapObjectC obj = freeStablePtr obj
+
+foreign export ccall createHeapObjectC :: IO (StablePtr [Int])
+foreign export ccall freeHeapObjectC :: StablePtr [Int] -> IO ()
=====================================
testsuite/tests/rts/unload_multiple_objs/D.hs
=====================================
@@ -0,0 +1,16 @@
+module D where
+
+import Foreign.StablePtr
+
+id4 :: Int
+id4 = 4
+
+createHeapObjectD :: IO (StablePtr [Int])
+createHeapObjectD = do
+ newStablePtr [2+id4]
+
+freeHeapObjectD :: StablePtr [Int] -> IO ()
+freeHeapObjectD obj = freeStablePtr obj
+
+foreign export ccall createHeapObjectD :: IO (StablePtr [Int])
+foreign export ccall freeHeapObjectD :: StablePtr [Int] -> IO ()
=====================================
testsuite/tests/rts/unload_multiple_objs/Makefile
=====================================
@@ -0,0 +1,17 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+.PHONY: linker_unload_multiple_objs
+linker_unload_multiple_objs:
+ $(RM) A.o B.o C.o D.o
+ $(RM) A.hi B.hi C.hi D.hi
+ "$(TEST_HC)" $(TEST_HC_OPTS) -c A.hs -v0
+ "$(TEST_HC)" $(TEST_HC_OPTS) -c B.hs -v0
+ "$(TEST_HC)" $(TEST_HC_OPTS) -c C.hs -v0
+ "$(TEST_HC)" $(TEST_HC_OPTS) -c D.hs -v0
+ # -rtsopts causes a warning
+ "$(TEST_HC)" LinkerUnload.hs -package ghc $(filter-out -rtsopts, $(TEST_HC_OPTS)) linker_unload_multiple_objs.c -o linker_unload_multiple_objs -no-hs-main -optc-Werror
+ ./linker_unload_multiple_objs "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
+
+
=====================================
testsuite/tests/rts/unload_multiple_objs/all.T
=====================================
@@ -0,0 +1,4 @@
+test('linker_unload_multiple_objs',
+ [extra_files(['../LinkerUnload.hs', 'A.hs', 'B.hs', 'C.hs', 'D.hs',]),
+ when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259))],
+ run_command, ['$MAKE -s --no-print-directory linker_unload_multiple_objs'])
=====================================
testsuite/tests/rts/unload_multiple_objs/linker_unload_multiple_objs.c
=====================================
@@ -0,0 +1,147 @@
+#include "ghcconfig.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include "Rts.h"
+#include <string.h>
+#include "HsFFI.h"
+
+extern void loadPackages(void);
+
+#define NUM_OBJS 4
+
+static char *objs[NUM_OBJS] = {"A.o", "B.o", "C.o", "D.o"};
+
+pathchar* toPathchar(char* path)
+{
+#if defined(mingw32_HOST_OS)
+ size_t required = strlen(path);
+ pathchar *ret = (pathchar*)malloc(sizeof(pathchar) * (required + 1));
+ if (mbstowcs(ret, path, required) == (size_t)-1)
+ {
+ errorBelch("toPathchar failed converting char* to wchar_t*: %s", path);
+ exit(1);
+ }
+ ret[required] = '\0';
+ return ret;
+#else
+ return path;
+#endif
+}
+
+void load_and_resolve_all_objects() {
+ int i, r;
+ for (i = 0; i < NUM_OBJS; i++) {
+ r = loadObj(toPathchar(objs[i]));
+ if (!r) {
+ errorBelch("loadObj(%s) failed", objs[i]);
+ exit(1);
+ }
+ }
+
+ r = resolveObjs();
+ if (!r) {
+ errorBelch("resolveObjs failed");
+ exit(1);
+ }
+
+ for (i = 0; i < NUM_OBJS; i++) {
+ char sym_name[138] = {0};
+#if LEADING_UNDERSCORE
+ sprintf(sym_name, "_createHeapObject%c", 'A'+i);
+#else
+ sprintf(sym_name, "createHeapObject%c", 'A'+i);
+#endif
+ void *sym_addr = lookupSymbol(sym_name);
+ if (!sym_addr) {
+ errorBelch("lookupSymbol(%s) failed", sym_name);
+ exit(1);
+ }
+ }
+}
+
+void check_object_freed(char *obj_path) {
+ OStatus st;
+ st = getObjectLoadStatus(toPathchar(obj_path));
+ if (st != OBJECT_NOT_LOADED) {
+ errorBelch("object %s status != OBJECT_NOT_LOADED", obj_path);
+ exit(1);
+ }
+}
+
+void check_object_unloaded_but_not_freed(char *obj_path) {
+ OStatus st;
+ st = getObjectLoadStatus(toPathchar(obj_path));
+ if (st != OBJECT_UNLOADED) {
+ errorBelch("object %s status != OBJECT_UNLOADED, is %d instead", obj_path, st);
+ exit(1);
+ }
+}
+
+void test_no_dangling_references_to_unloaded_objects()
+{
+ load_and_resolve_all_objects();
+
+ unloadObj(toPathchar("A.o"));
+ unloadObj(toPathchar("B.o"));
+ unloadObj(toPathchar("C.o"));
+ unloadObj(toPathchar("D.o"));
+ performMajorGC();
+
+ check_object_freed("A.o");
+ check_object_freed("B.o");
+ check_object_freed("C.o");
+ check_object_freed("D.o");
+
+}
+
+typedef HsStablePtr stableptrfun_t(void);
+typedef void freeptrfun_t(HsStablePtr);
+
+void test_still_has_references_to_unloaded_objects()
+{
+ load_and_resolve_all_objects();
+#if LEADING_UNDERSCORE
+ stableptrfun_t *createHeapObject = lookupSymbol("_createHeapObjectD");
+ freeptrfun_t *freeHeapObject = lookupSymbol("_freeHeapObjectD");
+#else
+ stableptrfun_t *createHeapObject = lookupSymbol("createHeapObjectD");
+ freeptrfun_t *freeHeapObject = lookupSymbol("freeHeapObjectD");
+#endif
+ HsStablePtr ptr = createHeapObject();
+
+ unloadObj(toPathchar("A.o"));
+ unloadObj(toPathchar("B.o"));
+ unloadObj(toPathchar("C.o"));
+ unloadObj(toPathchar("D.o"));
+ performMajorGC();
+
+ check_object_freed("A.o");
+ check_object_freed("B.o");
+ check_object_freed("C.o");
+ check_object_unloaded_but_not_freed("D.o");
+
+
+ freeHeapObject(ptr);
+ performMajorGC();
+
+ check_object_freed("A.o");
+ check_object_freed("B.o");
+ check_object_freed("C.o");
+ check_object_freed("D.o");
+}
+
+int main (int argc, char *argv[])
+{
+ RtsConfig conf = defaultRtsConfig;
+ conf.rts_opts_enabled = RtsOptsAll;
+ hs_init_ghc(&argc, &argv, conf);
+
+ initLinker_(0);
+ loadPackages();
+
+ test_still_has_references_to_unloaded_objects();
+ test_no_dangling_references_to_unloaded_objects();
+
+ hs_exit();
+ exit(0);
+}
=====================================
testsuite/tests/rts/unload_multiple_objs/linker_unload_multiple_objs.stdout
=====================================
@@ -0,0 +1,2 @@
+[1 of 1] Compiling LinkerUnload ( LinkerUnload.hs, LinkerUnload.o )
+Linking linker_unload_multiple_objs ...
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/48f58fbcecbdc650fef4a7292c814bbf101fd9bd...ce1e6538dd15c145394497aa6721b17c610ac1d6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/compare/48f58fbcecbdc650fef4a7292c814bbf101fd9bd...ce1e6538dd15c145394497aa6721b17c610ac1d6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190612/2f81c8c3/attachment-0001.html>
More information about the ghc-commits
mailing list