diff options
Diffstat (limited to 'testsuite/tests')
| -rw-r--r-- | testsuite/tests/rts/all.T | 33 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipe/all.T | 33 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipe/ipeEventLog.c | 24 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipe/ipeEventLog.stderr (renamed from testsuite/tests/rts/ipeEventLog.stderr) | 0 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipe/ipeEventLog_fromMap.c | 29 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr | 20 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipe/ipeMap.c | 159 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipe/ipe_lib.c | 78 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipe/ipe_lib.h | 17 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipeEventLog.c | 60 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipeEventLog_fromMap.c | 35 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipeEventLog_fromMap.stderr | 2 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipeEventLog_lib.c | 42 | ||||
| -rw-r--r-- | testsuite/tests/rts/ipeMap.c | 209 |
14 files changed, 360 insertions, 381 deletions
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 955289b91f..c361e87b2f 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -196,37 +196,6 @@ test('EventlogOutput_IPE', def noCapabilityOutputFilter(s): return re.sub(r'[a-f0-9]+: IPE:', 'IPE:', s) -# Manually create IPE entries and dump them to event log (stderr). -test('ipeEventLog', - [ c_src, - extra_files(['ipeEventLog_lib.c']), - extra_run_opts('+RTS -va -RTS'), - grep_errmsg('IPE:'), - only_ways(debug_ways), - normalise_errmsg_fun(noCapabilityOutputFilter), - ignore_stdout, - # Due to issues on Darwin CI runners that couldn't be tracked down. - # In general this test should work on Darwin - Just not on our CI. - when(opsys('darwin'), fragile(0)) - ], - compile_and_run, ['ipeEventLog_lib.c']) - -# Manually create IPE entries, force the initialization of the underlying hash map -# and dump them to event log (stderr). -test('ipeEventLog_fromMap', - [ c_src, - extra_files(['ipeEventLog_lib.c']), - extra_run_opts('+RTS -va -RTS'), - grep_errmsg('IPE:'), - only_ways(debug_ways), - normalise_errmsg_fun(noCapabilityOutputFilter), - ignore_stdout, - # Due to issues on Darwin CI runners that couldn't be tracked down. - # In general this test should work on Darwin - Just not on our CI. - when(opsys('darwin'), fragile(0)) - ], - compile_and_run, ['ipeEventLog_lib.c']) - test('T4059', [], makefile_test, ['T4059']) # Test for #4274 @@ -509,8 +478,6 @@ test('T19381', test('T20199', [ grep_errmsg('Hello') ] , makefile_test, []) -test('ipeMap', [c_src], compile_and_run, ['']) - test('cloneMyStack', [extra_files(['cloneStackLib.c'])], compile_and_run, ['cloneStackLib.c']) test('cloneMyStack2', ignore_stdout, compile_and_run, ['']) test('cloneMyStack_retBigStackFrame', [extra_files(['cloneStackLib.c']), ignore_stdout], compile_and_run, ['cloneStackLib.c']) diff --git a/testsuite/tests/rts/ipe/all.T b/testsuite/tests/rts/ipe/all.T new file mode 100644 index 0000000000..15af42f588 --- /dev/null +++ b/testsuite/tests/rts/ipe/all.T @@ -0,0 +1,33 @@ +test('ipeMap', [extra_files(['ipe_lib.c', 'ipe_lib.h']), c_src], compile_and_run, ['ipe_lib.c']) + +# Manually create IPE entries and dump them to event log (stderr). +test('ipeEventLog', + [ c_src, + extra_files(['ipe_lib.c', 'ipe_lib.h']), + extra_run_opts('+RTS -va -RTS'), + grep_errmsg('table_name_'), + only_ways(debug_ways), + normalise_errmsg_fun(noCapabilityOutputFilter), + ignore_stdout, + # Due to issues on Darwin CI runners that couldn't be tracked down. + # In general this test should work on Darwin - Just not on our CI. + when(opsys('darwin'), fragile(0)) + ], + compile_and_run, ['ipe_lib.c']) + +# Manually create IPE entries, force the initialization of the underlying hash map +# and dump them to event log (stderr). +test('ipeEventLog_fromMap', + [ c_src, + extra_files(['ipe_lib.c', 'ipe_lib.h']), + extra_run_opts('+RTS -va -RTS'), + grep_errmsg('table_name_'), + only_ways(debug_ways), + normalise_errmsg_fun(noCapabilityOutputFilter), + ignore_stdout, + # Due to issues on Darwin CI runners that couldn't be tracked down. + # In general this test should work on Darwin - Just not on our CI. + when(opsys('darwin'), fragile(0)) + ], + compile_and_run, ['ipe_lib.c']) + diff --git a/testsuite/tests/rts/ipe/ipeEventLog.c b/testsuite/tests/rts/ipe/ipeEventLog.c new file mode 100644 index 0000000000..b59642fc5b --- /dev/null +++ b/testsuite/tests/rts/ipe/ipeEventLog.c @@ -0,0 +1,24 @@ +#include "Rts.h" +#include "RtsAPI.h" +#include "rts/IPE.h" +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "ipe_lib.h" + +int main(int argc, char *argv[]) { + hs_init(&argc, &argv); + Capability *cap = rts_lock(); + + IpeBufferListNode *list1 = makeAnyProvEntries(cap, 0, 10); + IpeBufferListNode *list2 = makeAnyProvEntries(cap, 0, 10); + + registerInfoProvList(list1); + registerInfoProvList(list2); + + // Trace all IPE events. Expected count (see Makefile): 381 + 2 = 383 + dumpIPEToEventLog(); + + rts_unlock(cap); + hs_exit(); +} diff --git a/testsuite/tests/rts/ipeEventLog.stderr b/testsuite/tests/rts/ipe/ipeEventLog.stderr index 95e012c710..95e012c710 100644 --- a/testsuite/tests/rts/ipeEventLog.stderr +++ b/testsuite/tests/rts/ipe/ipeEventLog.stderr diff --git a/testsuite/tests/rts/ipe/ipeEventLog_fromMap.c b/testsuite/tests/rts/ipe/ipeEventLog_fromMap.c new file mode 100644 index 0000000000..631ba8298f --- /dev/null +++ b/testsuite/tests/rts/ipe/ipeEventLog_fromMap.c @@ -0,0 +1,29 @@ +#include "Rts.h" +#include "RtsAPI.h" +#include "rts/IPE.h" +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "ipe_lib.h" + +int main(int argc, char *argv[]) { + hs_init(&argc, &argv); + Capability *cap = rts_lock(); + + HaskellObj one = rts_mkInt(cap, 1); + + IpeBufferListNode *list1 = makeAnyProvEntries(cap, 0, 10); + IpeBufferListNode *list2 = makeAnyProvEntries(cap, 0, 10); + + registerInfoProvList(list1); + registerInfoProvList(list2); + + // Query an IPE to initialize the underlying hash map. + lookupIPE(list1->entries[0].info); + + // Trace all IPE events. + dumpIPEToEventLog(); + + rts_unlock(cap); + hs_exit(); +} diff --git a/testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr b/testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr new file mode 100644 index 0000000000..606de64766 --- /dev/null +++ b/testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr @@ -0,0 +1,20 @@ +7f8f9c139740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc srcloc_000 +7f8f9c139740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc srcloc_001 +7f8f9c139740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc srcloc_002 +7f8f9c139740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc srcloc_003 +7f8f9c139740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc srcloc_004 +7f8f9c139740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc srcloc_005 +7f8f9c139740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc srcloc_006 +7f8f9c139740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc srcloc_007 +7f8f9c139740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc srcloc_008 +7f8f9c139740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc srcloc_009 +7f8f9c139740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc srcloc_000 +7f8f9c139740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc srcloc_001 +7f8f9c139740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc srcloc_002 +7f8f9c139740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc srcloc_003 +7f8f9c139740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc srcloc_004 +7f8f9c139740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc srcloc_005 +7f8f9c139740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc srcloc_006 +7f8f9c139740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc srcloc_007 +7f8f9c139740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc srcloc_008 +7f8f9c139740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc srcloc_009 diff --git a/testsuite/tests/rts/ipe/ipeMap.c b/testsuite/tests/rts/ipe/ipeMap.c new file mode 100644 index 0000000000..f69ac75508 --- /dev/null +++ b/testsuite/tests/rts/ipe/ipeMap.c @@ -0,0 +1,159 @@ +#include <stdlib.h> +#include <string.h> + +#include "Rts.h" +#include "ipe_lib.h" + +void assertStringsEqual(const char *s1, const char *s2); +void shouldFindNothingInAnEmptyIPEMap(Capability *cap); +HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap); +void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo); +void shouldFindTwoFromTheSameList(Capability *cap); +void shouldDealWithAnEmptyList(Capability *cap, HaskellObj); + +// This is a unit test for IPE.c, the IPE map. +// Due to the nature of IPE having static state, the test cases are not +// independent of each other! +int main(int argc, char *argv[]) { + hs_init(&argc, &argv); + Capability *cap = rts_lock(); + + shouldFindNothingInAnEmptyIPEMap(cap); + HaskellObj fortyTwo = shouldFindOneIfItHasBeenRegistered(cap); + shouldFindTwoIfTwoHaveBeenRegistered(cap, fortyTwo); + shouldFindTwoFromTheSameList(cap); + shouldDealWithAnEmptyList(cap, fortyTwo); + + rts_unlock(cap); + hs_exit(); +} + +void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { + HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); + + InfoProvEnt *result = lookupIPE(get_itbl(fortyTwo)); + + if (result != NULL) { + errorBelch("Found entry in an empty IPE map!"); + exit(1); + } +} + +HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + StringTable st; + init_string_table(&st); + + HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); + node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); + node->count = 1; + node->next = NULL; + node->string_table = st.buffer; + + registerInfoProvList(node); + + InfoProvEnt *result = lookupIPE(get_itbl(fortyTwo)); + + if (result == NULL) { + errorBelch("shouldFindOneIfItHasBeenRegistered: Found no entry in IPE map!"); + exit(1); + } + + assertStringsEqual(result->prov.table_name, "table_name_042"); + assertStringsEqual(result->prov.closure_desc, "closure_desc_042"); + assertStringsEqual(result->prov.ty_desc, "ty_desc_042"); + assertStringsEqual(result->prov.label, "label_042"); + assertStringsEqual(result->prov.module, "module_042"); + assertStringsEqual(result->prov.srcloc, "srcloc_042"); + + return fortyTwo; +} + +void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, + HaskellObj fortyTwo) { + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); + StringTable st; + init_string_table(&st); + + HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); + node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); + node->count = 1; + node->next = NULL; + node->string_table = st.buffer; + + registerInfoProvList(node); + + InfoProvEnt *resultFortyTwo = + lookupIPE(get_itbl(fortyTwo)); + InfoProvEnt *resultTwentyThree = + lookupIPE(get_itbl(twentyThree)); + + if (resultFortyTwo == NULL) { + errorBelch("shouldFindTwoIfTwoHaveBeenRegistered(42): Found no entry in IPE map!"); + exit(1); + } + if (resultTwentyThree == NULL) { + errorBelch("shouldFindTwoIfTwoHaveBeenRegistered(23): Found no entry in IPE map!"); + exit(1); + } + + assertStringsEqual(resultFortyTwo->prov.table_name, "table_name_042"); + assertStringsEqual(resultTwentyThree->prov.table_name, "table_name_023"); +} + +void shouldFindTwoFromTheSameList(Capability *cap) { + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry)); + StringTable st; + init_string_table(&st); + + HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); + HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); + node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); + node->count = 2; + node->next = NULL; + node->string_table = st.buffer; + + registerInfoProvList(node); + + InfoProvEnt *resultOne = lookupIPE(get_itbl(one)); + InfoProvEnt *resultTwo = lookupIPE(get_itbl(two)); + + if (resultOne == NULL) { + errorBelch("shouldFindTwoFromTheSameList(1): Found no entry in IPE map!"); + exit(1); + } + if (resultTwo == NULL) { + errorBelch("shouldFindTwoFromTheSameList(2): Found no entry in IPE map!"); + exit(1); + } + + assertStringsEqual(resultOne->prov.table_name, "table_name_001"); + assertStringsEqual(resultTwo->prov.table_name, "table_name_002"); +} + +void shouldDealWithAnEmptyList(Capability *cap, HaskellObj fortyTwo) { + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); + node->count = 0; + node->next = NULL; + node->string_table = ""; + + registerInfoProvList(node); + + InfoProvEnt *resultFortyTwo = + lookupIPE(get_itbl(fortyTwo)); + + if (resultFortyTwo == NULL) { + errorBelch("shouldDealWithAnEmptyList: Found no entry in IPE map!"); + exit(1); + } + + assertStringsEqual(resultFortyTwo->prov.table_name, "table_name_042"); +} + +void assertStringsEqual(const char *s1, const char *s2) { + if (strcmp(s1, s2) != 0) { + errorBelch("%s != %s", s1, s2); + exit(1); + } +} diff --git a/testsuite/tests/rts/ipe/ipe_lib.c b/testsuite/tests/rts/ipe/ipe_lib.c new file mode 100644 index 0000000000..37bb20c738 --- /dev/null +++ b/testsuite/tests/rts/ipe/ipe_lib.c @@ -0,0 +1,78 @@ +#include "Rts.h" +#include "rts/IPE.h" +#include <string.h> +#include "ipe_lib.h" + +void init_string_table(StringTable *st) { + st->size = 128; + st->n = 0; + st->buffer = malloc(st->size); +} + +uint32_t add_string(StringTable *st, const char *s) { + const size_t len = strlen(s); + const uint32_t n = st->n; + if (st->n + len + 1 > st->size) { + const size_t new_size = 2*st->size + len; + st->buffer = realloc(st->buffer, new_size); + st->size = new_size; + } + + memcpy(&st->buffer[st->n], s, len); + st->n += len; + st->buffer[st->n] = '\0'; + st->n += 1; + return n; +} + +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i) { + IpeBufferEntry provEnt; + provEnt.info = get_itbl(closure); + + unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; + char *tableName = malloc(sizeof(char) * tableNameLength); + snprintf(tableName, tableNameLength, "table_name_%03i", i); + provEnt.table_name = add_string(st, tableName); + + unsigned int closureDescLength = strlen("closure_desc_") + 3 /* digits */ + 1 /* null character */; + char *closureDesc = malloc(sizeof(char) * closureDescLength); + snprintf(closureDesc, closureDescLength, "closure_desc_%03i", i); + provEnt.closure_desc = add_string(st, closureDesc); + + unsigned int tyDescLength = strlen("ty_desc_") + 3 /* digits */ + 1 /* null character */; + char *tyDesc = malloc(sizeof(char) * tyDescLength); + snprintf(tyDesc, tyDescLength, "ty_desc_%03i", i); + provEnt.ty_desc = add_string(st, tyDesc); + + unsigned int labelLength = strlen("label_") + 3 /* digits */ + 1 /* null character */; + char *label = malloc(sizeof(char) * labelLength); + snprintf(label, labelLength, "label_%03i", i); + provEnt.label = add_string(st, label); + + unsigned int moduleLength = strlen("module_") + 3 /* digits */ + 1 /* null character */; + char *module = malloc(sizeof(char) * moduleLength); + snprintf(module, moduleLength, "module_%03i", i); + provEnt.module_name = add_string(st, module); + + unsigned int srcLocLength = strlen("srcloc_") + 3 /* digits */ + 1 /* null character */; + char *srcLoc = malloc(sizeof(char) * srcLocLength); + snprintf(srcLoc, srcLocLength, "srcloc_%03i", i); + provEnt.srcloc = add_string(st, srcLoc); + + return provEnt; +} + +IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { + const int n = end - start; + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); + StringTable st; + init_string_table(&st); + for (int i=start; i < end; i++) { + HaskellObj closure = rts_mkInt(cap, 42); + node->entries[i] = makeAnyProvEntry(cap, &st, closure, i); + } + node->next = NULL; + node->count = n; + node->string_table = st.buffer; + return node; +} diff --git a/testsuite/tests/rts/ipe/ipe_lib.h b/testsuite/tests/rts/ipe/ipe_lib.h new file mode 100644 index 0000000000..8aaa1c361e --- /dev/null +++ b/testsuite/tests/rts/ipe/ipe_lib.h @@ -0,0 +1,17 @@ +#pragma once + +#include "Rts.h" + +typedef struct { + char *buffer; + size_t n; + size_t size; +} StringTable; + +void init_string_table(StringTable *st); +uint32_t add_string(StringTable *st, const char *s); + +IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); +void dumpIPEToEventLog(void); + diff --git a/testsuite/tests/rts/ipeEventLog.c b/testsuite/tests/rts/ipeEventLog.c deleted file mode 100644 index 9260269f5a..0000000000 --- a/testsuite/tests/rts/ipeEventLog.c +++ /dev/null @@ -1,60 +0,0 @@ -#include "Rts.h" -#include "RtsAPI.h" -#include "rts/IPE.h" -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -extern void dumpIPEToEventLog(void); -InfoProvEnt *makeAnyProvEntry(Capability *cap, int i); - -int main(int argc, char *argv[]) { - hs_init(&argc, &argv); - Capability *cap = rts_lock(); - - // Force the creation of 4 IpeBufferListNodes (381 IPEs) - for (int i = 0; i < 381; i++) { - - InfoProvEnt **ipeList_1 = malloc(sizeof(InfoProvEnt *) * 2); - ipeList_1[0] = makeAnyProvEntry(cap, i); - ipeList_1[1] = NULL; - - registerInfoProvList(ipeList_1); - } - - // Register an IPE list with two elements - HaskellObj one = rts_mkInt(cap, 1); - - InfoProvEnt *provEntA = malloc(sizeof(InfoProvEnt)); - provEntA->info = (StgInfoTable *)one->header.info; - provEntA->prov.table_name = "table_name_a"; - provEntA->prov.closure_desc = "closure_desc_a"; - provEntA->prov.ty_desc = "ty_desc_a"; - provEntA->prov.label = "label_a"; - provEntA->prov.module = "module_a"; - provEntA->prov.srcloc = "srcloc_a"; - - HaskellObj two = rts_mkInt(cap, 2); - - InfoProvEnt *provEntB = malloc(sizeof(InfoProvEnt)); - provEntB->info = (StgInfoTable *)two->header.info; - provEntB->prov.table_name = "table_name_b"; - provEntB->prov.closure_desc = "closure_desc_b"; - provEntB->prov.ty_desc = "ty_desc_b"; - provEntB->prov.label = "label_b"; - provEntB->prov.module = "module_b"; - provEntB->prov.srcloc = "srcloc_b"; - - InfoProvEnt **ipeList_2 = malloc(sizeof(InfoProvEnt *) * 3); - ipeList_2[0] = provEntA; - ipeList_2[1] = provEntB; - ipeList_2[2] = NULL; - - registerInfoProvList(ipeList_2); - - // Trace all IPE events. Expected count (see Makefile): 381 + 2 = 383 - dumpIPEToEventLog(); - - rts_unlock(cap); - hs_exit(); -} diff --git a/testsuite/tests/rts/ipeEventLog_fromMap.c b/testsuite/tests/rts/ipeEventLog_fromMap.c deleted file mode 100644 index 5bd9e4d034..0000000000 --- a/testsuite/tests/rts/ipeEventLog_fromMap.c +++ /dev/null @@ -1,35 +0,0 @@ -#include "Rts.h" -#include "RtsAPI.h" -#include "rts/IPE.h" -#include <stdio.h> -#include <stdlib.h> -#include <string.h> - -extern void dumpIPEToEventLog(void); -InfoProvEnt *makeAnyProvEntry(Capability *cap, int i); - -int main(int argc, char *argv[]) { - hs_init(&argc, &argv); - Capability *cap = rts_lock(); - - HaskellObj one = rts_mkInt(cap, 1); - - InfoProvEnt *provEnt_0 = makeAnyProvEntry(cap, 0); - InfoProvEnt *provEnt_1 = makeAnyProvEntry(cap, 1); - - InfoProvEnt **ipeList_1 = malloc(sizeof(InfoProvEnt *) * 3); - ipeList_1[0] = provEnt_0; - ipeList_1[1] = provEnt_1; - ipeList_1[2] = NULL; - - registerInfoProvList(ipeList_1); - - // Query an IPE to initialize the underlying hash map. - lookupIPE(ipeList_1[0]->info); - - // Trace all IPE events. - dumpIPEToEventLog(); - - rts_unlock(cap); - hs_exit(); -} diff --git a/testsuite/tests/rts/ipeEventLog_fromMap.stderr b/testsuite/tests/rts/ipeEventLog_fromMap.stderr deleted file mode 100644 index 7ad1fb998a..0000000000 --- a/testsuite/tests/rts/ipeEventLog_fromMap.stderr +++ /dev/null @@ -1,2 +0,0 @@ -IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc srcloc_001 -IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc srcloc_000 diff --git a/testsuite/tests/rts/ipeEventLog_lib.c b/testsuite/tests/rts/ipeEventLog_lib.c deleted file mode 100644 index df54231fa7..0000000000 --- a/testsuite/tests/rts/ipeEventLog_lib.c +++ /dev/null @@ -1,42 +0,0 @@ -#include "Rts.h" -#include "rts/IPE.h" -#include <string.h> - -InfoProvEnt *makeAnyProvEntry(Capability *cap, int i) { - HaskellObj fourtyTwo = rts_mkInt(cap, 42); - - InfoProvEnt *provEnt = malloc(sizeof(InfoProvEnt)); - provEnt->info = (StgInfoTable *)fourtyTwo->header.info; - - unsigned int tableNameLength = strlen("table_name_") + 3 /* digits */ + 1 /* null character */; - char *tableName = malloc(sizeof(char) * tableNameLength); - snprintf(tableName, tableNameLength, "table_name_%03i", i); - provEnt->prov.table_name = tableName; - - unsigned int closureDescLength = strlen("closure_desc_") + 3 /* digits */ + 1 /* null character */; - char *closureDesc = malloc(sizeof(char) * closureDescLength); - snprintf(closureDesc, closureDescLength, "closure_desc_%03i", i); - provEnt->prov.closure_desc = closureDesc; - - unsigned int tyDescLength = strlen("ty_desc_") + 3 /* digits */ + 1 /* null character */; - char *tyDesc = malloc(sizeof(char) * tyDescLength); - snprintf(tyDesc, tyDescLength, "ty_desc_%03i", i); - provEnt->prov.ty_desc = tyDesc; - - unsigned int labelLength = strlen("label_") + 3 /* digits */ + 1 /* null character */; - char *label = malloc(sizeof(char) * labelLength); - snprintf(label, labelLength, "label_%03i", i); - provEnt->prov.label = label; - - unsigned int moduleLength = strlen("module_") + 3 /* digits */ + 1 /* null character */; - char *module = malloc(sizeof(char) * labelLength); - snprintf(module, moduleLength, "module_%03i", i); - provEnt->prov.module = module; - - unsigned int srcLocLength = strlen("srcloc_") + 3 /* digits */ + 1 /* null character */; - char *srcLoc = malloc(sizeof(char) * srcLocLength); - snprintf(srcLoc, srcLocLength, "srcloc_%03i", i); - provEnt->prov.srcloc = srcLoc; - - return provEnt; -} diff --git a/testsuite/tests/rts/ipeMap.c b/testsuite/tests/rts/ipeMap.c deleted file mode 100644 index 41e7e9fb89..0000000000 --- a/testsuite/tests/rts/ipeMap.c +++ /dev/null @@ -1,209 +0,0 @@ -#include <stdlib.h> -#include <string.h> - -#include "Rts.h" - -void assertStringsEqual(char *s1, char *s2); -void shouldFindNothingInAnEmptyIPEMap(Capability *cap); -HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap); -void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo); -void shouldFindTwoFromTheSameList(Capability *cap); -void shouldFindTheLastEntryOfManyLists(Capability *cap); -void shouldDealWithAnEmptyList(Capability *cap, HaskellObj); - -// This is a unit test for IPE.c, the IPE map. -// Due to the nature of IPE having static state, the test cases are not -// independent of each other! -int main(int argc, char *argv[]) { - hs_init(&argc, &argv); - Capability *cap = rts_lock(); - - shouldFindNothingInAnEmptyIPEMap(cap); - HaskellObj fortyTwo = shouldFindOneIfItHasBeenRegistered(cap); - shouldFindTwoIfTwoHaveBeenRegistered(cap, fortyTwo); - shouldFindTwoFromTheSameList(cap); - shouldFindTheLastEntryOfManyLists(cap); - shouldDealWithAnEmptyList(cap, fortyTwo); - - rts_unlock(cap); - hs_exit(); -} - -void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { - HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - - InfoProvEnt *result = lookupIPE(get_itbl(fortyTwo)); - - if (result != NULL) { - errorBelch("Found entry in an empty IPE map!"); - exit(1); - } -} - -HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - - InfoProvEnt *provEnt = malloc(sizeof(InfoProvEnt)); - provEnt->info = get_itbl(fortyTwo); - provEnt->prov.table_name = "table_name_42"; - provEnt->prov.closure_desc = "closure_desc_42"; - provEnt->prov.ty_desc = "ty_desc_42"; - provEnt->prov.label = "label_42"; - provEnt->prov.module = "module_42"; - provEnt->prov.srcloc = "srcloc_42"; - - InfoProvEnt *ipeList[] = {provEnt, NULL}; - - registerInfoProvList(ipeList); - InfoProvEnt *result = lookupIPE(get_itbl(fortyTwo)); - - if (result == NULL) { - errorBelch("Found no entry in IPE map!"); - exit(1); - } - - assertStringsEqual(result->prov.table_name, "table_name_42"); - assertStringsEqual(result->prov.closure_desc, "closure_desc_42"); - assertStringsEqual(result->prov.ty_desc, "ty_desc_42"); - assertStringsEqual(result->prov.label, "label_42"); - assertStringsEqual(result->prov.module, "module_42"); - assertStringsEqual(result->prov.srcloc, "srcloc_42"); - - return fortyTwo; -} - -void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, - HaskellObj fortyTwo) { - HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - - InfoProvEnt *provEnt = malloc(sizeof(InfoProvEnt)); - provEnt->info = get_itbl(twentyThree); - provEnt->prov.table_name = "table_name_23"; - provEnt->prov.closure_desc = "closure_desc_23"; - provEnt->prov.ty_desc = "ty_desc_23"; - provEnt->prov.label = "label_23"; - provEnt->prov.module = "module_23"; - provEnt->prov.srcloc = "srcloc_23"; - - InfoProvEnt *ipeList[] = {provEnt, NULL}; - - registerInfoProvList(ipeList); - - InfoProvEnt *resultFortyTwo = - lookupIPE(get_itbl(fortyTwo)); - InfoProvEnt *resultTwentyThree = - lookupIPE(get_itbl(twentyThree)); - - if (resultFortyTwo == NULL || resultTwentyThree == NULL) { - errorBelch("Found no entry in IPE map!"); - exit(1); - } - - assertStringsEqual(resultFortyTwo->prov.table_name, "table_name_42"); - assertStringsEqual(resultTwentyThree->prov.table_name, "table_name_23"); -} - -void shouldFindTwoFromTheSameList(Capability *cap) { - HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); - - InfoProvEnt *provEntOne = malloc(sizeof(InfoProvEnt)); - provEntOne->info = get_itbl(one); - provEntOne->prov.table_name = "table_name_1"; - provEntOne->prov.closure_desc = "closure_desc_1"; - provEntOne->prov.ty_desc = "ty_desc_1"; - provEntOne->prov.label = "label_1"; - provEntOne->prov.module = "module_1"; - provEntOne->prov.srcloc = "srcloc_1"; - - HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - - InfoProvEnt *provEntTwo = malloc(sizeof(InfoProvEnt)); - provEntTwo->info = get_itbl(two); - provEntTwo->prov.table_name = "table_name_2"; - provEntTwo->prov.closure_desc = "closure_desc_2"; - provEntTwo->prov.ty_desc = "ty_desc_2"; - provEntTwo->prov.label = "label_2"; - provEntTwo->prov.module = "module_2"; - provEntTwo->prov.srcloc = "srcloc_2"; - - InfoProvEnt *ipeList[] = {provEntOne, provEntTwo, NULL}; - - registerInfoProvList(ipeList); - - InfoProvEnt *resultOne = lookupIPE(get_itbl(one)); - InfoProvEnt *resultTwo = lookupIPE(get_itbl(two)); - - if (resultOne == NULL || resultOne == NULL) { - errorBelch("Found no entry in IPE map!"); - exit(1); - } - - assertStringsEqual(resultOne->prov.table_name, "table_name_1"); - assertStringsEqual(resultTwo->prov.table_name, "table_name_2"); -} - -void shouldFindTheLastEntryOfManyLists(Capability *cap) { - HaskellObj three = UNTAG_CLOSURE(rts_mkInt64(cap, 3)); - - InfoProvEnt *provEntThree = malloc(sizeof(InfoProvEnt)); - provEntThree->info = get_itbl(three); - provEntThree->prov.table_name = "table_name_3"; - provEntThree->prov.closure_desc = "closure_desc_3"; - provEntThree->prov.ty_desc = "ty_desc_3"; - provEntThree->prov.label = "label_3"; - provEntThree->prov.module = "module_3"; - provEntThree->prov.srcloc = "srcloc_3"; - - HaskellObj four = UNTAG_CLOSURE(rts_mkWord8(cap, 4)); - - InfoProvEnt *provEntFour = malloc(sizeof(InfoProvEnt)); - provEntFour->info = get_itbl(four); - provEntFour->prov.table_name = "table_name_4"; - provEntFour->prov.closure_desc = "closure_desc_4"; - provEntFour->prov.ty_desc = "ty_desc_4"; - provEntFour->prov.label = "label_4"; - provEntFour->prov.module = "module_4"; - provEntFour->prov.srcloc = "srcloc_4"; - - InfoProvEnt *ipeListThree[] = {provEntThree, NULL}; - InfoProvEnt *ipeListFour[] = {provEntFour, NULL}; - - // Force the creation of 4 IpeBufferListNodes - for (int i = 0; i <= 126 * 3 + 1; i++) { - registerInfoProvList(ipeListThree); - } - - registerInfoProvList(ipeListFour); - - InfoProvEnt *resultFour = lookupIPE(get_itbl(four)); - - if (resultFour == NULL) { - errorBelch("Found no entry in IPE map!"); - exit(1); - } - - assertStringsEqual(resultFour->prov.table_name, "table_name_4"); -} - -void shouldDealWithAnEmptyList(Capability *cap, HaskellObj fortyTwo) { - InfoProvEnt *emptyIpeList[] = {NULL}; - - registerInfoProvList(emptyIpeList); - - InfoProvEnt *resultFortyTwo = - lookupIPE(get_itbl(fortyTwo)); - - if (resultFortyTwo == NULL) { - errorBelch("Found no entry in IPE map!"); - exit(1); - } - - assertStringsEqual(resultFortyTwo->prov.table_name, "table_name_42"); -} - -void assertStringsEqual(char *s1, char *s2) { - if (strcmp(s1, s2) != 0) { - errorBelch("%s != %s", s1, s2); - exit(1); - } -} |