[Git][ghc/ghc][wip/windows-ci] 11 commits: rts/nonmoving: Add missing STM write barrier
Ben Gamari
gitlab at gitlab.haskell.org
Fri Sep 18 21:16:51 UTC 2020
Ben Gamari pushed to branch wip/windows-ci at Glasgow Haskell Compiler / GHC
Commits:
0799b3de by Ben Gamari at 2020-09-18T15:55:50-04:00
rts/nonmoving: Add missing STM write barrier
When updating a TRec for a TVar already part of a transaction we
previously neglected to add the old value to the update remembered set.
I suspect this was the cause of #18587.
- - - - -
c4921349 by Ben Gamari at 2020-09-18T15:56:25-04:00
rts: Refactor foreign export tracking
This avoids calling `libc` in the initializers which are responsible for
registering foreign exports. We believe this should avoid the corruption
observed in #18548.
See Note [Tracking foreign exports] in rts/ForeignExports.c for an
overview of the new scheme.
- - - - -
40dc9106 by Ben Gamari at 2020-09-18T15:56:25-04:00
rts: Refactor unloading of foreign export StablePtrs
Previously we would allocate a linked list cell for each foreign export.
Now we can avoid this by taking advantage of the fact that they are
already broken into groups.
- - - - -
9eee39a6 by Ben Gamari at 2020-09-18T17:16:06-04:00
testsuite: Unmark T12971 as broken on Windows
It's unclear why, but this no longer seems to fail.
Closes #17945.
- - - - -
863699ca by Ben Gamari at 2020-09-18T17:16:06-04:00
testsuite: Unmark T5975[ab] as broken on Windows
Sadly it's unclear *why* they have suddenly started working.
Closes #7305.
- - - - -
3a9c8bc3 by Ben Gamari at 2020-09-18T17:16:06-04:00
base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001
Only affected the Windows codepath.
- - - - -
72a650e0 by Ben Gamari at 2020-09-18T17:16:06-04:00
testsuite: Update expected output for outofmem on Windows
The error originates from osCommitMemory rather than getMBlocks.
- - - - -
12575510 by Ben Gamari at 2020-09-18T17:16:06-04:00
testsuite: Mark some GHCi/Makefile tests as broken on Windows
See #18718.
- - - - -
1ead0a27 by GHC GitLab CI at 2020-09-18T17:16:06-04:00
testsuite: Fix WinIO error message normalization
This wasn't being applied to stderr.
- - - - -
d4d61d2f by GHC GitLab CI at 2020-09-18T17:16:06-04:00
testsuite: Mark tempfiles as broken on Win32 without WinIO
The old POSIX emulation appears to ignore the user-requested prefix.
- - - - -
be124deb by GHC GitLab CI at 2020-09-18T17:16:06-04:00
testsuite: Mark TH_spliceE5_prof as broken on Windows
Due to #18721.
- - - - -
22 changed files:
- compiler/GHC/HsToCore/Foreign/Decl.hs
- includes/Rts.h
- + includes/rts/ForeignExports.h
- libraries/base/tests/Concurrent/ThreadDelay001.hs
- libraries/base/tests/all.T
- + rts/ForeignExports.c
- + rts/ForeignExports.h
- rts/Linker.c
- rts/LinkerInternals.h
- rts/RtsStartup.c
- rts/RtsSymbols.c
- rts/STM.c
- rts/rts.cabal.in
- testsuite/driver/testlib.py
- testsuite/tests/driver/all.T
- testsuite/tests/ghci/linking/dyn/all.T
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/rts/T12771/all.T
- testsuite/tests/rts/T13082/all.T
- testsuite/tests/rts/T14611/all.T
- testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32
- testsuite/tests/th/all.T
Changes:
=====================================
compiler/GHC/HsToCore/Foreign/Decl.hs
=====================================
@@ -91,15 +91,16 @@ dsForeigns' :: [LForeignDecl GhcTc]
dsForeigns' []
= return (NoStubs, nilOL)
dsForeigns' fos = do
+ mod <- getModule
fives <- mapM do_ldecl fos
let
(hs, cs, idss, bindss) = unzip4 fives
fe_ids = concat idss
- fe_init_code = map foreignExportInitialiser fe_ids
+ fe_init_code = foreignExportsInitialiser mod fe_ids
--
return (ForeignStubs
(vcat hs)
- (vcat cs $$ vcat fe_init_code),
+ (vcat cs $$ fe_init_code),
foldr (appOL . toOL) nilOL bindss)
where
do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl)
@@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
]
-foreignExportInitialiser :: Id -> SDoc
-foreignExportInitialiser hs_fn =
+foreignExportsInitialiser :: Module -> [Id] -> SDoc
+foreignExportsInitialiser mod hs_fns =
-- Initialise foreign exports by registering a stable pointer from an
-- __attribute__((constructor)) function.
-- The alternative is to do this from stginit functions generated in
@@ -710,14 +711,24 @@ foreignExportInitialiser hs_fn =
-- all modules that are imported directly or indirectly are actually used by
-- the program.
-- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL)
+ --
+ -- See Note [Tracking foreign exports] in rts/ForeignExports.c
vcat
- [ text "static void stginit_export_" <> ppr hs_fn
- <> text "() __attribute__((constructor));"
- , text "static void stginit_export_" <> ppr hs_fn <> text "()"
- , braces (text "foreignExportStablePtr"
- <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure")
- <> semi)
+ [ text "static struct ForeignExportsList" <+> list_symbol <+> equals
+ <+> braces (text ".exports = " <+> export_list) <> semi
+ , text "static void " <> ctor_symbol <> text "(void)"
+ <+> text " __attribute__((constructor));"
+ , text "static void " <> ctor_symbol <> text "()"
+ , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi)
]
+ where
+ mod_str = pprModuleName (moduleName mod)
+ ctor_symbol = text "stginit_export_" <> mod_str
+ list_symbol = text "stg_exports_" <> mod_str
+ export_list = braces $ pprWithCommas closure_ptr hs_fns
+
+ closure_ptr :: Id -> SDoc
+ closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure"
mkHObj :: Type -> SDoc
=====================================
includes/Rts.h
=====================================
@@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum)
#include "rts/storage/GC.h"
#include "rts/NonMoving.h"
+/* Foreign exports */
+#include "rts/ForeignExports.h"
+
/* Other RTS external APIs */
#include "rts/Parallel.h"
#include "rts/Signals.h"
=====================================
includes/rts/ForeignExports.h
=====================================
@@ -0,0 +1,38 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1995-2009
+ *
+ * Interface to the RTS's foreign export tracking code.
+ *
+ * Do not #include this file directly: #include "Rts.h" instead.
+ *
+ * To understand the structure of the RTS headers, see the wiki:
+ * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes
+ *
+ * ---------------------------------------------------------------------------*/
+
+#pragma once
+
+struct _ObjectCode;
+
+/* N.B. See Note [Tracking foreign exports] in
+ * rts/ForeignExports.c. */
+struct ForeignExportsList {
+ /* a link field for linking these together into lists.
+ */
+ struct ForeignExportsList *next;
+ /* the length of ->exports */
+ int n_entries;
+ /* if the RTS linker loaded the module,
+ * to which ObjectCode these exports belong. */
+ struct _ObjectCode *oc;
+ /* if the RTS linker loaded the module,
+ * this points to an array of length ->n_entries
+ * recording the StablePtr for each export. */
+ StgStablePtr **stable_ptrs;
+ /* the exported closures. of length ->exports. */
+ StgPtr exports[];
+};
+
+void registerForeignExports(struct ForeignExportsList *exports);
+
=====================================
libraries/base/tests/Concurrent/ThreadDelay001.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
-- Test that threadDelay actually sleeps for (at least) as long as we
-- ask it
=====================================
libraries/base/tests/all.T
=====================================
@@ -17,7 +17,10 @@ test('readFloat', exit_code(1), compile_and_run, [''])
test('enumDouble', normal, compile_and_run, [''])
test('enumRatio', normal, compile_and_run, [''])
test('enumNumeric', normal, compile_and_run, [''])
-test('tempfiles', normal, compile_and_run, [''])
+# N.B. the tempfile format is slightly different than this test expects on
+# Windows *except* if using WinIO. The `when` clause below can be removed
+# after WinIO becomes the default.
+test('tempfiles', when(opsys('mingw32'), only_ways(['winio'])), 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'])
=====================================
rts/ForeignExports.c
=====================================
@@ -0,0 +1,130 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team 2020
+ *
+ * Management of foreign exports.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#include "Rts.h"
+#include "RtsUtils.h"
+#include "ForeignExports.h"
+
+/* protected by linker_mutex after start-up */
+static struct ForeignExportsList *pending = NULL;
+static ObjectCode *loading_obj = NULL;
+
+/*
+ * Note [Tracking foreign exports]
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ *
+ * Foreign exports are garbage collection roots. That is, things (e.g. CAFs)
+ * depended upon by a module's `foreign export`s need to be kept alive for as
+ * long an module is loaded. To ensure this we create a stable pointer to each
+ * `foreign export`'d closure. This works as follows:
+ *
+ * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports)
+ * inserts a C-stub into each module containing a `foreign export`. This
+ * stub contains two things:
+ *
+ * - A `ForeignExportsList` listing all of the exported closures, and
+ *
+ * - An initializer which calls `registerForeignExports` with a reference to
+ * the `ForeignExportsList`.
+ *
+ * 2. When the module's object code is loaded, its initializer is called by the
+ * linker (this might be the system's dynamic linker or GHC's own static
+ * linker). `registerForeignExports` then places the module's
+ * `ForeignExportsList` on `pending` list.
+ *
+ * 3. When loading has finished (e.g. during RTS initialization or at the end
+ * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we
+ * traverse the `pending` list and create a `StablePtr` for each export
+ * therein.
+ *
+ * The reason for this two-step process is that we are very restricted in what
+ * we can do in an initializer function. For instance, we cannot necessarily
+ * call `malloc` since the `libc`'s own initializer may not have run yet.
+ * For instance, doing exactly this resulted in #18548.
+ *
+ * Another consideration here is that the linker needs to know which
+ * `StablePtr`s belong to each `ObjectCode` so it can free them when the module is
+ * unloaded. For this reason, the linker informs us when it is loading an
+ * object by calling `foreignExportsLoadingObject` and
+ * `foreignExportsFinishedLoadingObject`. We take note of the `ObjectCode*` we
+ * are loading in `loading_obj` such that we can associate the `ForeignExportsList` with
+ * the `ObjectCode` in `processForeignExports`. We then record each of the
+ * StablePtrs we create in the ->stable_ptrs array of ForeignExportsList so
+ * they can be enumerated during unloading.
+ *
+ */
+
+void registerForeignExports(struct ForeignExportsList *exports)
+{
+ ASSERT(exports->next == NULL);
+ ASSERT(exports->oc == NULL);
+ exports->next = pending;
+ exports->oc = loading_obj;
+ pending = exports;
+}
+
+/* -----------------------------------------------------------------------------
+ Create a StablePtr for a foreign export. This is normally called by
+ a C function with __attribute__((constructor)), which is generated
+ by GHC and linked into the module.
+
+ If the object code is being loaded dynamically, then we remember
+ which StablePtrs were allocated by the constructors and free them
+ again in unloadObj().
+ -------------------------------------------------------------------------- */
+
+void foreignExportsLoadingObject(ObjectCode *oc)
+{
+ ASSERT(loading_obj == NULL);
+ loading_obj = oc;
+}
+
+void foreignExportsFinishedLoadingObject()
+{
+ ASSERT(loading_obj != NULL);
+ loading_obj = NULL;
+ processForeignExports();
+}
+
+/* Caller must own linker_mutex so that we can safely modify
+ * oc->stable_ptrs. */
+void processForeignExports()
+{
+ while (pending) {
+ struct ForeignExportsList *cur = pending;
+ pending = cur->next;
+
+ /* sanity check */
+ ASSERT(cur->stable_ptrs == NULL);
+
+ /* N.B. We only need to populate the ->stable_ptrs
+ * array if the object might later be unloaded.
+ */
+ if (cur->oc != NULL) {
+ cur->stable_ptrs =
+ stgMallocBytes(sizeof(StgStablePtr*) * cur->n_entries,
+ "foreignExportStablePtr");
+
+ for (int i=0; i < cur->n_entries; i++) {
+ StgStablePtr *sptr = getStablePtr(cur->exports[i]);
+
+ if (cur->oc != NULL) {
+ cur->stable_ptrs[i] = sptr;
+ }
+ }
+ cur->next = cur->oc->foreign_exports;
+ cur->oc->foreign_exports = cur;
+ } else {
+ /* can't be unloaded, don't bother populating
+ * ->stable_ptrs array. */
+ for (int i=0; i < cur->n_entries; i++) {
+ getStablePtr(cur->exports[i]);
+ }
+ }
+ }
+}
=====================================
rts/ForeignExports.h
=====================================
@@ -0,0 +1,21 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team 2020
+ *
+ * Management of foreign exports.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#pragma once
+
+#include "Rts.h"
+#include "LinkerInternals.h"
+
+#include "BeginPrivate.h"
+
+void foreignExportsLoadingObject(ObjectCode *oc);
+void foreignExportsFinishedLoadingObject(void);
+void processForeignExports(void);
+
+#include "EndPrivate.h"
+
=====================================
rts/Linker.c
=====================================
@@ -26,6 +26,7 @@
#include "RtsSymbols.h"
#include "RtsSymbolInfo.h"
#include "Profiling.h"
+#include "ForeignExports.h"
#include "sm/OSMem.h"
#include "linker/M32Alloc.h"
#include "linker/CacheFlush.h"
@@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl )
return r;
}
-/* -----------------------------------------------------------------------------
- Create a StablePtr for a foreign export. This is normally called by
- a C function with __attribute__((constructor)), which is generated
- by GHC and linked into the module.
-
- If the object code is being loaded dynamically, then we remember
- which StablePtrs were allocated by the constructors and free them
- again in unloadObj().
- -------------------------------------------------------------------------- */
-
-static ObjectCode *loading_obj = NULL;
-
-StgStablePtr foreignExportStablePtr (StgPtr p)
-{
- ForeignExportStablePtr *fe_sptr;
- StgStablePtr *sptr;
-
- sptr = getStablePtr(p);
-
- if (loading_obj != NULL) {
- fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr),
- "foreignExportStablePtr");
- fe_sptr->stable_ptr = sptr;
- fe_sptr->next = loading_obj->stable_ptrs;
- loading_obj->stable_ptrs = fe_sptr;
- }
-
- return sptr;
-}
-
-
/* -----------------------------------------------------------------------------
* Debugging aid: look in GHCi's object symbol tables for symbols
* within DELTA bytes of the specified address, and show their names.
@@ -1269,14 +1239,18 @@ static void freeOcStablePtrs (ObjectCode *oc)
{
// Release any StablePtrs that were created when this
// object module was initialized.
- ForeignExportStablePtr *fe_ptr, *next;
+ struct ForeignExportsList *exports, *next;
- for (fe_ptr = oc->stable_ptrs; fe_ptr != NULL; fe_ptr = next) {
- next = fe_ptr->next;
- freeStablePtr(fe_ptr->stable_ptr);
- stgFree(fe_ptr);
+ for (exports = oc->foreign_exports; exports != NULL; exports = next) {
+ next = exports->next;
+ for (int i = 0; i < exports->n_entries; i++) {
+ freeStablePtr(exports->stable_ptrs[i]);
+ }
+ stgFree(exports->stable_ptrs);
+ exports->stable_ptrs = NULL;
+ exports->next = NULL;
}
- oc->stable_ptrs = NULL;
+ oc->foreign_exports = NULL;
}
static void
@@ -1434,7 +1408,7 @@ mkOc( pathchar *path, char *image, int imageSize,
oc->n_segments = 0;
oc->segments = NULL;
oc->proddables = NULL;
- oc->stable_ptrs = NULL;
+ oc->foreign_exports = NULL;
#if defined(NEED_SYMBOL_EXTRAS)
oc->symbol_extras = NULL;
#endif
@@ -1793,7 +1767,8 @@ int ocTryLoad (ObjectCode* oc) {
IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n"));
- loading_obj = oc; // tells foreignExportStablePtr what to do
+ // See Note [Tracking foreign exports] in ForeignExports.c
+ foreignExportsLoadingObject(oc);
#if defined(OBJFORMAT_ELF)
r = ocRunInit_ELF ( oc );
#elif defined(OBJFORMAT_PEi386)
@@ -1803,7 +1778,7 @@ int ocTryLoad (ObjectCode* oc) {
#else
barf("ocTryLoad: initializers not implemented on this platform");
#endif
- loading_obj = NULL;
+ foreignExportsFinishedLoadingObject();
if (!r) { return r; }
=====================================
rts/LinkerInternals.h
=====================================
@@ -135,17 +135,6 @@ typedef struct _Segment {
int n_sections;
} Segment;
-/*
- * We must keep track of the StablePtrs that are created for foreign
- * exports by constructor functions when the module is loaded, so that
- * we can free them again when the module is unloaded. If we don't do
- * this, then the StablePtr will keep the module alive indefinitely.
- */
-typedef struct ForeignExportStablePtr_ {
- StgStablePtr stable_ptr;
- struct ForeignExportStablePtr_ *next;
-} ForeignExportStablePtr;
-
#if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
#define NEED_SYMBOL_EXTRAS 1
#endif
@@ -240,7 +229,8 @@ typedef struct _ObjectCode {
char* bssBegin;
char* bssEnd;
- ForeignExportStablePtr *stable_ptrs;
+ /* a list of all ForeignExportsLists owned by this object */
+ struct ForeignExportsList *foreign_exports;
/* Holds the list of symbols in the .o file which
require extra information.*/
=====================================
rts/RtsStartup.c
=====================================
@@ -20,6 +20,7 @@
#include "STM.h" /* initSTM */
#include "RtsSignals.h"
#include "Weak.h"
+#include "ForeignExports.h" /* processForeignExports */
#include "Ticky.h"
#include "StgRun.h"
#include "Prelude.h" /* fixupRTStoPreludeRefs */
@@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
getStablePtr((StgPtr)processRemoteCompletion_closure);
#endif
- // Initialize the top-level handler system
+ /*
+ * process any foreign exports which were registered while loading the
+ * image
+ * */
+ processForeignExports();
+
+ /* initialize the top-level handler system */
initTopHandler();
/* initialise the shared Typeable store */
=====================================
rts/RtsSymbols.c
=====================================
@@ -652,7 +652,7 @@
SymI_HasProto(freeFullProgArgv) \
SymI_HasProto(getProcessElapsedTime) \
SymI_HasProto(getStablePtr) \
- SymI_HasProto(foreignExportStablePtr) \
+ SymI_HasProto(registerForeignExports) \
SymI_HasProto(hs_init) \
SymI_HasProto(hs_init_with_rtsopts) \
SymI_HasProto(hs_init_ghc) \
=====================================
rts/STM.c
=====================================
@@ -1342,6 +1342,9 @@ void stmWriteTVar(Capability *cap,
if (entry != NULL) {
if (entry_in == trec) {
// Entry found in our trec
+ IF_NONMOVING_WRITE_BARRIER_ENABLED {
+ updateRemembSetPushClosure(cap, (StgClosure *) entry->new_value);
+ }
entry -> new_value = new_value;
} else {
// Entry found in another trec
=====================================
rts/rts.cabal.in
=====================================
@@ -140,6 +140,7 @@ library
rts/EventLogWriter.h
rts/FileLock.h
rts/Flags.h
+ rts/ForeignExports.h
rts/GetTime.h
rts/Globals.h
rts/Hpc.h
@@ -412,6 +413,7 @@ library
ClosureFlags.c
Disassembler.c
FileLock.c
+ ForeignExports.c
Globals.c
Hash.c
Heap.c
=====================================
testsuite/driver/testlib.py
=====================================
@@ -751,22 +751,24 @@ def normalise_win32_io_errors(name, opts):
slightly in the error messages that they provide. Normalise these
differences away, preferring the new WinIO errors.
- This can be dropped when the old IO manager is removed.
+ This normalization can be dropped when the old IO manager is removed.
"""
SUBS = [
- ('Bad file descriptor', 'The handle is invalid'),
+ ('Bad file descriptor', 'The handle is invalid.'),
('Permission denied', 'Access is denied.'),
('No such file or directory', 'The system cannot find the file specified.'),
]
- def f(s: str):
+ def normalizer(s: str) -> str:
for old,new in SUBS:
s = s.replace(old, new)
return s
- return when(opsys('mingw32'), normalise_fun(f))
+ if opsys('mingw32'):
+ _normalise_fun(name, opts, normalizer)
+ _normalise_errmsg_fun(name, opts, normalizer)
def normalise_version_( *pkgs ):
def normalise_version__( str ):
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -258,7 +258,7 @@ test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef'])
test('T12955', normal, makefile_test, [])
-test('T12971', [when(opsys('mingw32'), expect_broken(17945)), ignore_stdout], makefile_test, [])
+test('T12971', ignore_stdout, makefile_test, [])
test('json', normal, compile_fail, ['-ddump-json'])
test('json2', normalise_version('base','ghc-prim'), compile, ['-ddump-types -ddump-json'])
test('T16167', exit_code(1), run_command,
=====================================
testsuite/tests/ghci/linking/dyn/all.T
=====================================
@@ -30,10 +30,12 @@ test('T10458',
ghci_script, ['T10458.script'])
test('T11072gcc', [extra_files(['A.c', 'T11072.hs']),
+ expect_broken(18718),
unless(doing_ghci, skip), unless(opsys('mingw32'), skip)],
makefile_test, ['compile_libAS_impl_gcc'])
test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/']),
+ expect_broken(18718),
unless(doing_ghci, skip), unless(opsys('mingw32'), skip)],
makefile_test, ['compile_libAS_impl_msvc'])
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -142,10 +142,10 @@ test('T5979',
normalise_version("transformers")],
ghci_script, ['T5979.script'])
test('T5975a',
- [pre_cmd('touch föøbàr1.hs'), when(opsys('mingw32'), expect_broken(7305))],
+ pre_cmd('touch föøbàr1.hs'),
ghci_script, ['T5975a.script'])
test('T5975b',
- [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs'), when(opsys('mingw32'), expect_broken(7305))],
+ [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs')],
ghci_script, ['T5975b.script'])
test('T6027ghci', normal, ghci_script, ['T6027ghci.script'])
=====================================
testsuite/tests/rts/T12771/all.T
=====================================
@@ -1,4 +1,5 @@
test('T12771',
[extra_files(['foo.c', 'main.hs', 'foo_dll.c']),
+ expect_broken(18718),
unless(opsys('mingw32'), skip)],
makefile_test, ['T12771'])
=====================================
testsuite/tests/rts/T13082/all.T
=====================================
@@ -16,6 +16,7 @@ def normalise_search_dirs (str):
#--------------------------------------
test('T13082_good',
[extra_files(['foo.c', 'main.hs', 'foo_dll.c']),
+ expect_broken(18718),
unless(opsys('mingw32'), skip)],
makefile_test, ['T13082_good'])
=====================================
testsuite/tests/rts/T14611/all.T
=====================================
@@ -1,4 +1,5 @@
test('T14611',
[extra_files(['foo.c', 'main.hs', 'foo_dll.c']),
+ expect_broken(18718),
unless(opsys('mingw32'), skip)],
makefile_test, ['T14611'])
=====================================
testsuite/tests/rts/outofmem.stderr-x86_64-unknown-mingw32
=====================================
@@ -1 +1 @@
-outofmem.exe: getMBlocks: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete.
+outofmem.exe: osCommitMemory: VirtualAlloc MEM_COMMIT failed: The paging file is too small for this operation to complete.
=====================================
testsuite/tests/th/all.T
=====================================
@@ -51,7 +51,8 @@ test('TH_NestedSplices', [], multimod_compile,
# normal way first, which is why the work is done by a Makefile rule.
test('TH_spliceE5_prof',
[req_profiling, only_ways(['normal']),
- when(ghc_dynamic(), expect_broken(11495))],
+ when(ghc_dynamic(), expect_broken(11495)),
+ when(opsys('mingw32'), expect_broken(18271))],
makefile_test, ['TH_spliceE5_prof'])
test('TH_spliceE5_prof_ext', [req_profiling, only_ways(['normal'])],
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad20b09f7b6c477815e0a8bf2d2dd1eb7185c57a...be124deb9ee8104fba9c711d8b6e9a5158f00b00
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad20b09f7b6c477815e0a8bf2d2dd1eb7185c57a...be124deb9ee8104fba9c711d8b6e9a5158f00b00
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/20200918/6355e3d2/attachment-0001.html>
More information about the ghc-commits
mailing list