diff --git a/libraries/base/tests/IO/T12010/test.T b/libraries/base/tests/IO/T12010/test.T index e33e69036a8c..bb926dc72dd8 100644 --- a/libraries/base/tests/IO/T12010/test.T +++ b/libraries/base/tests/IO/T12010/test.T @@ -4,5 +4,6 @@ test('T12010', extra_ways(['threaded1']), when(wordsize(32), fragile(16572)), js_broken(22374), + req_target_debug_rts, cmd_prefix('WAY_FLAGS="' + ' '.join(config.way_flags['threaded1']) + '"')], makefile_test, []) diff --git a/libraries/base/tests/IO/all.T b/libraries/base/tests/IO/all.T index 5b28156c96bf..992b5dfbac42 100644 --- a/libraries/base/tests/IO/all.T +++ b/libraries/base/tests/IO/all.T @@ -114,7 +114,7 @@ test('countReaders001', js_broken(22261), compile_and_run, ['']) test('concio001', [normal, multi_cpu_race], makefile_test, ['test.concio001']) -test('concio001.thr', [extra_files(['concio001.hs']), multi_cpu_race], +test('concio001.thr', [extra_files(['concio001.hs']), multi_cpu_race, req_target_threaded_rts], makefile_test, ['test.concio001.thr']) test('T2122', [], compile_and_run, ['']) diff --git a/libraries/ghc-compact/tests/all.T b/libraries/ghc-compact/tests/all.T index 9a666161ff99..2bb90c4dbf1f 100644 --- a/libraries/ghc-compact/tests/all.T +++ b/libraries/ghc-compact/tests/all.T @@ -1,5 +1,5 @@ setTestOpts( - [extra_ways(['sanity', 'compacting_gc']), + [extra_ways(['compacting_gc'] + (['sanity'] if debug_rts() else [])), js_skip # compact API not supported by the JS backend ]) diff --git a/libraries/ghc-heap/tests/all.T b/libraries/ghc-heap/tests/all.T index 5722182d5f65..5b8b755ae812 100644 --- a/libraries/ghc-heap/tests/all.T +++ b/libraries/ghc-heap/tests/all.T @@ -94,7 +94,8 @@ test('stack_misc_closures', [ extra_files(['stack_misc_closures_c.c', 'stack_misc_closures_prim.cmm', 'TestUtils.hs']), ignore_stdout, - ignore_stderr + ignore_stderr, + req_target_debug_rts # Debug RTS to use checkSTACK() ], multi_compile_and_run, ['stack_misc_closures', diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 697941920d23..80a3e4f33598 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -362,6 +362,20 @@ def req_ghc_smp( name, opts ): if not config.ghc_has_smp: opts.skip = True +def req_target_debug_rts( name, opts ): + """ + Mark a test as requiring the debug rts (e.g. compile with -debug or -ticky) + """ + if not config.debug_rts: + opts.skip = True + +def req_target_threaded_rts( name, opts ): + # FIXME: this is probably wrong: we should have a different flag for the + # compiler's rts and the target rts... + if not config.ghc_with_threaded_rts: + opts.skip = True + + def req_target_smp( name, opts ): """ Mark a test as requiring smp when run on the target. If the target does @@ -1376,9 +1390,13 @@ def normalizer(s: str) -> str: def normalise_version_( *pkgs ): def normalise_version__( str ): + # First strip the ghc-version_ prefix if present at the start of package names + # Use word boundary to ensure we only match actual package name prefixes + str_no_ghc_prefix = re.sub(r'\bghc-[0-9.]+_([a-zA-Z])', r'\1', str) # (name)(-version)(-hash)(-components) - return re.sub('(' + '|'.join(map(re.escape,pkgs)) + r')-[0-9.]+(-[0-9a-zA-Z+]+)?(-[0-9a-zA-Z]+)?', - r'\1--', str) + ver_hash = re.sub('(' + '|'.join(map(re.escape,pkgs)) + r')-[0-9.]+(-[0-9a-zA-Z+]+)?(-[0-9a-zA-Z+]+)?', + r'\1--', str_no_ghc_prefix) + return re.sub(r'\bghc_([a-zA-Z-]+--)', r'\1', ver_hash) return normalise_version__ def normalise_version( *pkgs ): @@ -2896,6 +2914,11 @@ def normalise_callstacks(s: str) -> str: def repl(matches): location = matches.group(1) location = normalise_slashes_(location) + # backtrace paths contain the package path when building with Hadrian + location = re.sub(r'libraries/\w+(-\w+)*/', '', location) + location = re.sub(r'utils/\w+(-\w+)*/', '', location) + location = re.sub(r'compiler/', '', location) + location = re.sub(r'\./', '', location) return ', called at {0}:: in :'.format(location) # Ignore line number differences in call stacks (#10834). s = re.sub(callSite_re, repl, s) diff --git a/testsuite/tests/codeGen/should_run/T25374/all.T b/testsuite/tests/codeGen/should_run/T25374/all.T index 1e4c3e9860b0..0e02dc0d263d 100644 --- a/testsuite/tests/codeGen/should_run/T25374/all.T +++ b/testsuite/tests/codeGen/should_run/T25374/all.T @@ -1,3 +1,3 @@ # This shouldn't crash the disassembler -test('T25374', [extra_hc_opts('+RTS -Di -RTS'), ignore_stderr, unless(debug_rts(), skip)], ghci_script, ['']) +test('T25374', [extra_hc_opts('+RTS -Di -RTS'), ignore_stderr, req_target_debug_rts], ghci_script, ['']) diff --git a/testsuite/tests/driver/T20604/T20604.stdout b/testsuite/tests/driver/T20604/T20604.stdout index 45b3c357c37c..00a3b5a07731 100644 --- a/testsuite/tests/driver/T20604/T20604.stdout +++ b/testsuite/tests/driver/T20604/T20604.stdout @@ -1,3 +1,4 @@ A1 A -addDependentFile "/home/hsyl20/projects/ghc/merge-ghc-prim/_build/stage1/lib/../lib/x86_64-linux-ghc-9.13.20241220/libHSghc-internal-9.1300.0-inplace-ghc9.13.20241220.so" b035bf4e19d2537a0af5c8861760eaf1 +HSrts-fs- +HSghc-internal- diff --git a/testsuite/tests/driver/T21097b/Makefile b/testsuite/tests/driver/T21097b/Makefile index 6455817a300f..bba4b552848d 100644 --- a/testsuite/tests/driver/T21097b/Makefile +++ b/testsuite/tests/driver/T21097b/Makefile @@ -4,4 +4,4 @@ include $(TOP)/mk/test.mk T21097b: '$(GHC_PKG)' recache --package-db pkgdb - '$(TEST_HC)' -no-global-package-db -no-user-package-db -package-db pkgdb -v0 Test.hs -ddump-mod-map + '$(TEST_HC)' -no-global-package-db -no-user-package-db -package-db pkgdb -v0 Test.hs -no-rts -ddump-mod-map diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 611b2379770f..8a2bf53719b3 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -330,5 +330,5 @@ test('T23944', [unless(have_dynamic(), skip), extra_files(['T23944A.hs'])], mult test('T24286', [cxx_src, unless(have_profiling(), skip), extra_files(['T24286.cpp'])], compile, ['-prof -no-hs-main']) test('T24839', [unless(arch('x86_64') or arch('aarch64'), skip), extra_files(["t24839_sub.S"])], compile_and_run, ['t24839_sub.S']) test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -working-dir t25150/dir a.c']) -test('T25382', normal, makefile_test, []) +test('T25382', expect_broken(28), makefile_test, []) test('T26018', req_c, makefile_test, []) diff --git a/testsuite/tests/ghci/linking/all.T b/testsuite/tests/ghci/linking/all.T index a2b45e0e09f8..df46765d9afc 100644 --- a/testsuite/tests/ghci/linking/all.T +++ b/testsuite/tests/ghci/linking/all.T @@ -32,8 +32,7 @@ test('ghcilink005', when(unregisterised(), fragile(16085)), unless(doing_ghci, skip), req_dynamic_lib_support, - req_interp, - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + req_interp], makefile_test, ['ghcilink005']) test('ghcilink006', diff --git a/testsuite/tests/ghci/linking/dyn/all.T b/testsuite/tests/ghci/linking/dyn/all.T index b215f6b7202b..5d834099deb1 100644 --- a/testsuite/tests/ghci/linking/dyn/all.T +++ b/testsuite/tests/ghci/linking/dyn/all.T @@ -3,7 +3,6 @@ setTestOpts(req_dynamic_lib_support) test('load_short_name', [ extra_files(['A.c']) , unless(doing_ghci, skip) , req_c - , when(opsys('linux') and not ghc_dynamic(), expect_broken(20706)) ], makefile_test, ['load_short_name']) @@ -12,8 +11,7 @@ test('T1407', unless(doing_ghci, skip), pre_cmd('$MAKE -s --no-print-directory compile_libT1407'), extra_hc_opts('-L"$PWD/T1407dir"'), - js_broken(22359), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + js_broken(22359)], makefile_test, []) test('T3242', diff --git a/testsuite/tests/ghci/prog001/prog001.T b/testsuite/tests/ghci/prog001/prog001.T index f00b0b6a9865..519ee2e38211 100644 --- a/testsuite/tests/ghci/prog001/prog001.T +++ b/testsuite/tests/ghci/prog001/prog001.T @@ -3,6 +3,5 @@ test('prog001', when(arch('arm'), fragile(17555)), cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), req_interp, - unless(opsys('mingw32') or not config.have_RTS_linker, extra_ways(['ghci-ext'])), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + unless(opsys('mingw32') or not config.have_RTS_linker, extra_ways(['ghci-ext']))], ghci_script, ['prog001.script']) diff --git a/testsuite/tests/ghci/prog002/prog002.T b/testsuite/tests/ghci/prog002/prog002.T index 83f8d0d92e65..3e25bb455b00 100644 --- a/testsuite/tests/ghci/prog002/prog002.T +++ b/testsuite/tests/ghci/prog002/prog002.T @@ -1,4 +1,3 @@ test('prog002', [extra_files(['../shell.hs', 'A1.hs', 'A2.hs', 'B.hs', 'C.hs', 'D.hs']), - cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + cmd_prefix('ghciWayFlags=' + config.ghci_way_flags)], ghci_script, ['prog002.script']) diff --git a/testsuite/tests/ghci/prog010/all.T b/testsuite/tests/ghci/prog010/all.T index 103ff8338196..d30de29400ae 100644 --- a/testsuite/tests/ghci/prog010/all.T +++ b/testsuite/tests/ghci/prog010/all.T @@ -1,5 +1,4 @@ test('ghci.prog010', [cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), - extra_files(['../shell.hs', 'A.hs', 'B.hs']), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + extra_files(['../shell.hs', 'A.hs', 'B.hs'])], ghci_script, ['ghci.prog010.script']) diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 3a65b459e234..3910c0204cae 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -163,8 +163,7 @@ test('T6106', [extra_files(['../shell.hs']), test('T6105', normal, ghci_script, ['T6105.script']) test('T7117', normal, ghci_script, ['T7117.script']) test('ghci058', [extra_files(['../shell.hs']), - cmd_prefix('ghciWayFlags=' + config.ghci_way_flags), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + cmd_prefix('ghciWayFlags=' + config.ghci_way_flags)], ghci_script, ['ghci058.script']) test('T7587', normal, ghci_script, ['T7587.script']) test('T7688', normal, ghci_script, ['T7688.script']) diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 012bce59572a..2ab23061941a 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -131,7 +131,7 @@ test('T10294a', pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294a TOP={top}')], makefile_test, []) -test('frontend01', [extra_files(['FrontendPlugin.hs']), when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], +test('frontend01', [extra_files(['FrontendPlugin.hs'])], makefile_test, []) test('T11244', @@ -360,9 +360,7 @@ test('plugins-external', test('test-phase-hooks-plugin', [extra_files(['hooks-plugin/']), - pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-phase-hooks-plugin TOP={top}'), - - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + pre_cmd('$MAKE -s --no-print-directory -C hooks-plugin package.test-phase-hooks-plugin TOP={top}')], compile, ['-package-db hooks-plugin/pkg.test-phase-hooks-plugin/local.package.conf -fplugin Hooks.PhasePlugin -package hooks-plugin ' + config.plugin_way_flags]) diff --git a/testsuite/tests/plugins/plugins02.stderr b/testsuite/tests/plugins/plugins02.stderr index 2ea9331d3ec2..3d035ef35ee2 100644 --- a/testsuite/tests/plugins/plugins02.stderr +++ b/testsuite/tests/plugins/plugins02.stderr @@ -1 +1 @@ -: The value Simple.BadlyTypedPlugin.plugin with type GHC.Internal.Types.Int did not have the type GHC.Plugins.Plugin as required +: The value Simple.BadlyTypedPlugin.plugin with type GHC.Internal.Types.Int did not have the type GHC.Driver.Plugins.Plugin as required diff --git a/testsuite/tests/rts/T8308/all.T b/testsuite/tests/rts/T8308/all.T index 74eeec3ebcb1..080f09743f3c 100644 --- a/testsuite/tests/rts/T8308/all.T +++ b/testsuite/tests/rts/T8308/all.T @@ -1 +1 @@ -test('T8308', js_broken(22261), makefile_test, ['T8308']) +test('T8308', req_target_debug_rts, makefile_test, ['T8308']) diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index 717ee31f7b67..83c2a2ef2fc5 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -241,6 +241,7 @@ test('return_mem_to_os', normal, compile_and_run, ['']) test('T4850', [ when(opsys('mingw32'), expect_broken(4850)) , js_broken(22261) # FFI "dynamic" convention unsupported + , req_target_debug_rts ], makefile_test, ['T4850']) def config_T5250(name, opts): @@ -413,7 +414,7 @@ test('T10904', [ extra_run_opts('20000'), req_c ], test('T10728', [extra_run_opts('+RTS -maxN3 -RTS'), only_ways(['threaded2'])], compile_and_run, ['']) -test('T9405', [when(opsys('mingw32'), fragile(21361)), js_broken(22261)], makefile_test, ['T9405']) +test('T9405', [when(opsys('mingw32'), fragile(21361)), req_target_debug_rts], makefile_test, ['T9405']) test('T11788', [ when(ghc_dynamic(), skip) , req_interp @@ -467,6 +468,8 @@ test('T14900', test('InternalCounters', [ js_skip # JS backend doesn't support internal counters + # Require threaded RTS + , req_target_smp # The ways which build against the debug RTS are built with PROF_SPIN and # therefore differ in output , omit_ways(['nonmoving_thr_sanity', 'threaded2_sanity', 'sanity']) @@ -501,6 +504,7 @@ test('keep-cafs-fail', filter_stdout_lines('Evaluated a CAF|exit.*'), ignore_stderr, # on OS X the shell emits an "Abort trap" message to stderr req_rts_linker, + req_target_debug_rts ], makefile_test, ['KeepCafsFail']) @@ -510,7 +514,8 @@ test('keep-cafs', 'KeepCafs2.hs', 'KeepCafsMain.hs']), when(opsys('mingw32'), expect_broken (5987)), when(opsys('freebsd') or opsys('openbsd'), expect_broken(16035)), - req_rts_linker + req_rts_linker, + req_target_debug_rts ], makefile_test, ['KeepCafs']) @@ -520,12 +525,11 @@ test('T11829', [ req_c, check_errmsg("This is a test"), when(arch('wasm32'), fra ['T11829_c.cpp -package system-cxx-std-lib']) test('T16514', [req_c, omit_ghci], compile_and_run, ['T16514_c.c']) -test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug']) +test('test-zeroongc', [extra_run_opts('-DZ'), req_target_debug_rts], compile_and_run, ['-debug']) test('T13676', [when(opsys('mingw32'), expect_broken(17447)), - extra_files(['T13676.hs']), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + extra_files(['T13676.hs'])], ghci_script, ['T13676.script']) test('InitEventLogging', [ only_ways(['normal']) @@ -603,7 +607,7 @@ test('decodeMyStack_emptyListForMissingFlag', test('T20201a', [js_skip, exit_code(1)], compile_and_run, ['-with-rtsopts -AturtlesM']) test('T20201b', [js_skip, exit_code(1)], compile_and_run, ['-with-rtsopts -A64z']) -test('T22012', [js_skip, extra_ways(['ghci'])], compile_and_run, ['T22012_c.c']) +test('T22012', [js_skip, fragile(23043), extra_ways(['ghci'])], compile_and_run, ['T22012_c.c']) # Skip for JS platform as the JS RTS is always single threaded test('T22795a', [only_ways(['normal']), js_skip, req_ghc_with_threaded_rts], compile_and_run, ['-threaded']) @@ -623,7 +627,7 @@ test('T23221', compile_and_run, ['-O -with-rtsopts -T']) -test('T23142', [unless(debug_rts(), skip), req_interp], makefile_test, ['T23142']) +test('T23142', [req_target_debug_rts, req_interp], makefile_test, ['T23142']) test('T23400', [], compile_and_run, ['-with-rtsopts -A8k']) diff --git a/testsuite/tests/rts/linker/T20494-obj.c b/testsuite/tests/rts/linker/T20494-obj.c index ed073d6cfaf0..501238028ba3 100644 --- a/testsuite/tests/rts/linker/T20494-obj.c +++ b/testsuite/tests/rts/linker/T20494-obj.c @@ -1,8 +1,11 @@ #include +#include #define CONSTRUCTOR(prio) __attribute__((constructor(prio))) #define DESTRUCTOR(prio) __attribute__((destructor(prio))) -#define PRINT(str) printf(str); fflush(stdout) +// don't use "stdout" variable here as it is not properly defined when loading +// this object in a statically linked GHC. +#define PRINT(str) dprintf(1,str); fsync(1) CONSTRUCTOR(1000) void constr_a(void) { PRINT("constr a\n"); } CONSTRUCTOR(2000) void constr_b(void) { PRINT("constr b\n"); } diff --git a/testsuite/tests/rts/linker/all.T b/testsuite/tests/rts/linker/all.T index e88594b1025c..db593c1b0065 100644 --- a/testsuite/tests/rts/linker/all.T +++ b/testsuite/tests/rts/linker/all.T @@ -123,14 +123,17 @@ test('linker_unload_native', ###################################### test('linker_error1', [extra_files(['linker_error.c']), js_skip, # dynamic linking not supported by the JS backend + req_target_debug_rts, ignore_stderr], makefile_test, ['linker_error1']) test('linker_error2', [extra_files(['linker_error.c']), js_skip, # dynamic linking not supported by the JS backend + req_target_debug_rts, ignore_stderr], makefile_test, ['linker_error2']) test('linker_error3', [extra_files(['linker_error.c']), js_skip, # dynamic linking not supported by the JS backend + req_target_debug_rts, ignore_stderr], makefile_test, ['linker_error3']) ###################################### @@ -149,11 +152,12 @@ test('rdynamic', [ unless(opsys('linux') or opsys('mingw32'), skip) test('T7072', [extra_files(['load-object.c', 'T7072.c']), unless(opsys('linux'), skip), - req_rts_linker], + req_rts_linker, + req_target_debug_rts + ], makefile_test, ['T7072']) -test('T20494', [req_rts_linker, when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], - makefile_test, ['T20494']) +test('T20494', [req_rts_linker], makefile_test, ['T20494']) test('T20918', [extra_files(['T20918_v.cc']), diff --git a/testsuite/tests/th/T10279.hs b/testsuite/tests/th/T10279.hs index b8dbf9d9bcb6..bbcb42b0d3b8 100644 --- a/testsuite/tests/th/T10279.hs +++ b/testsuite/tests/th/T10279.hs @@ -1,10 +1,11 @@ module T10279 where import Language.Haskell.TH import Language.Haskell.TH.Syntax +import T10279h -- NB: rts-1.0.2 is used here because it doesn't change. -- You do need to pick the right version number, otherwise the -- error message doesn't recognize it as a source package ID, -- (This is OK, since it will look obviously wrong when they -- try to find the package in their package database.) -blah = $(conE (Name (mkOccName "Foo") (NameG VarName (mkPkgName "rts-1.0.3") (mkModName "A")))) +blah = $(conE (Name (mkOccName "Foo") (NameG VarName (mkPkgName ("ghc-internal-" <> pkg_version)) (mkModName "A")))) diff --git a/testsuite/tests/th/T10279.stderr b/testsuite/tests/th/T10279.stderr index 6ac34bc0951b..e6f4f8d3d05e 100644 --- a/testsuite/tests/th/T10279.stderr +++ b/testsuite/tests/th/T10279.stderr @@ -1,11 +1,13 @@ - -T10279.hs:10:9: error: [GHC-51294] +T10279.hs:11:9: error: [GHC-51294] • Failed to load interface for ‘A’. - no unit id matching ‘rts-1.0.3’ was found - (This unit ID looks like the source package ID; - the real unit ID is ‘rts’) + no unit id matching ‘ghc-internal-9.1300.0’ was found + (This unit-id looks like a source package name-version; candidates real unit-ids are: + ‘ghc-internal’) • In the untyped splice: $(conE (Name (mkOccName "Foo") - (NameG VarName (mkPkgName "rts-1.0.3") (mkModName "A")))) + (NameG + VarName (mkPkgName ("ghc-internal-" <> pkg_version)) + (mkModName "A")))) + diff --git a/testsuite/tests/th/T10279h.hs b/testsuite/tests/th/T10279h.hs new file mode 100644 index 000000000000..856a8052b20e --- /dev/null +++ b/testsuite/tests/th/T10279h.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE CPP #-} +module T10279h where + +pkg_version = VERSION_ghc_internal diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 205f8dc42500..6faee8ae8770 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -326,7 +326,7 @@ test('T10047', only_ways(['ghci']), ghci_script, ['T10047.script']) test('T10019', only_ways(['ghci']), ghci_script, ['T10019.script']) test('T10267', [], multimod_compile_fail, ['T10267', '-fno-max-valid-hole-fits -dsuppress-uniques -v0 ' + config.ghc_th_way_flags]) -test('T10279', normal, compile_fail, ['-v0']) +test('T10279', [normalise_version('ghc-internal'), extra_files(['T10279h.hs'])], multimod_compile_fail, ['T10279', '-v0']) test('T10306', normal, compile, ['-v0']) test('T10596', normal, compile, ['-v0']) test('T10598_TH', normal, compile, ['-v0 -dsuppress-uniques -ddump-splices'])