[Git][ghc/ghc][wip/ghc-9.4.5-backports] 4 commits: Add regression test for #17574

Zubin (@wz1000) gitlab at gitlab.haskell.org
Fri Apr 14 07:42:19 UTC 2023



Zubin pushed to branch wip/ghc-9.4.5-backports at Glasgow Haskell Compiler / GHC


Commits:
0a6f2a0d by Teo Camarasu at 2023-04-14T13:08:15+05:30
Add regression test for #17574

This test currently fails in the nonmoving way

(cherry picked from commit a56141a69842a78d56ec11be85a775eb703219bf)

- - - - -
9a85b847 by Teo Camarasu at 2023-04-14T13:08:15+05:30
fix: account for large and compact object stats with nonmoving gc

Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap.
We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap.

Resolves #17574

(cherry picked from commit 20c6669fc46c567e00d3cdf22aa84479b6d8dc17)

- - - - -
2058c8ef by Teo Camarasu at 2023-04-14T13:08:15+05:30
Allow running memInventory when the concurrent nonmoving gc is enabled

If the nonmoving gc is enabled and we are using a threaded RTS,
we now try to grab the collector mutex to avoid memInventory and
the collection racing.

Before memInventory was disabled.

(cherry picked from commit 62c3f7ee4199305cde009ededeae6ece1bcde7f0)
(cherry picked from commit fabc5a1c9aa468e97429ca5f8e501ec4fbd1084f)

- - - - -
d52ea64e by Zubin Duggal at 2023-04-14T13:11:53+05:30
Prepare release 9.4.5

Metric Decrease:
  T13035
  T15164
  T1969
  T9961
  WWRec
  T12707
  T13379

- - - - -


13 changed files:

- configure.ac
- + docs/users_guide/9.4.5-notes.rst
- docs/users_guide/release-notes.rst
- libraries/base/changelog.md
- rts/sm/NonMoving.c
- rts/sm/NonMoving.h
- rts/sm/NonMovingMark.c
- rts/sm/NonMovingMark.h
- rts/sm/Sanity.c
- rts/sm/Storage.c
- + testsuite/tests/rts/T17574.hs
- + testsuite/tests/rts/T17574.stdout
- testsuite/tests/rts/all.T


Changes:

=====================================
configure.ac
=====================================
@@ -13,7 +13,7 @@ dnl
 # see what flags are available. (Better yet, read the documentation!)
 #
 
-AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.4.4], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
+AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.4.5], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION])
     # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable
     # to be useful (cf #19058). However, the version must have three components
     # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are
@@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.4.4], [glasgow-has
 AC_CONFIG_MACRO_DIRS([m4])
 
 # Set this to YES for a released version, otherwise NO
-: ${RELEASE=NO}
+: ${RELEASE=YES}
 
 # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line
 # above.  If this is not a released version, then we will append the


=====================================
docs/users_guide/9.4.5-notes.rst
=====================================
@@ -0,0 +1,220 @@
+.. _release-9-4-5:
+
+Version 9.4.5
+==============
+
+The significant changes to the various parts of the compiler are listed in the
+following sections.
+
+The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM
+10, 11, 12, 13, or 14.
+
+Significant Changes
+~~~~~~~~~~~~~~~~~~~~
+
+Issues fixed in this release include:
+
+Compiler
+--------
+
+- Fix a compiler bug where programs using Template Haskell involving Constant
+  Applicative forms could be garbage collected too early (:ghc-ticket:`22417`).
+
+- Fix a shadowing related bug in the occurence analysis phase of the simplifier
+  (:ghc-ticket:`22623`).
+
+- Fix a regression in the typechecker where certain typeclass instances
+  involving type and data familes would fail to resolve (:ghc-ticket:`22647`,
+  :ghc-ticket:`23134`).
+
+- Fix a regression in the constrain solver which resulted in a loop when trying
+  to expand superclasses (:ghc-ticket:`22516`).
+
+- Fix the linker warning about chained fixups on Darwin platforms for programs
+  compiled with GHC (:ghc-ticket:`22429`).
+
+- Fix a compiler panic in the demand analyser due to a bug involving shadowing
+  (:ghc-ticket:`22718`).
+
+- Fix a driver bug where certain non-fatal Safe Haskell related warnings were
+  being marked as fatal (:ghc-ticket:`22728`).
+
+- Fix a bug to do with missing parenthesis while printing splices with
+  ``-ddump-splices`` (:ghc-ticket:`22784`).
+
+- Fix a bug with the graph-colouring register allocater leading to compiler
+  panics when compiling with ``-fregs-graph`` (:ghc-ticket:`22798`, 
+ :ghc-ticket:`23002`).
+
+- Fix a bug to do with code emitted on Darwin platforms using
+  relocations not supported on the platform (:ghc-ticket:`21972`).
+
+- Improve performance for code generated by the native code generator on
+  x86 for programs involving atomic counters (:ghc-ticket:`22764`).
+
+- Fix core lint errors arising from incorrect scoping of type variables
+  within ``SPECIALISE`` pragmas occuring in ``instance`` definitions
+  (:ghc-ticket:`22913`).
+
+- Fix core lint errors arising from an incorrect type given to the
+  ``decodeDouble_Int64`` rule (:ghc-ticket:`23019`).
+
+- Improve code generation for bitmasks on AArch64 with the native code
+  generator (:ghc-ticket:`23030`).
+
+- Many improvements to recompilation checking with multiple home units
+  (:ghc-ticket:`22675`, :ghc-ticket:`22677`, :ghc-ticket:`22669`, :ghc-ticket:`22678`,
+   :ghc-ticket:`22679`, :ghc-ticket:`22680`).
+
+- Fix a spurious warning with ``-Wmissing-home-modules`` (:ghc-ticket:`22676`).
+
+- Fix a typechecker panic on certain programs involving representation polymorphism
+  (:ghc-ticket:`22743`). 
+
+- Fix bugs to do with GHCi and compiler loops pariticularly when using ``-dppr-debug``
+  (:ghc-ticket:`22695`).
+
+- Fix memory leak in the compiler and in GHCi, including a bug where old
+  environments would persist on reloading (:ghc-ticket:`22530`, :ghc-ticket:`22833`).
+
+- Fix a miscompilation due to a simplifier bug (:ghc-ticket:`23184`).
+
+- Fix a miscompilation to do with unlifted bindings due to a bug in the specialiser
+  (:ghc-ticket:`22998`).
+
+- Fix a compiler panic during the "Float In" optimsation pass due to improper
+  handling of shadowing (:ghc-ticket:`22662`).
+
+- Fix a compiler panic when compiling certain programs involving representation
+  polymoprhism with optimisation (:ghc-ticet:`22725`).
+
+Runtime system
+--------------
+
+- Fix a GC bug where a race condition in the parallel GC could cause it to
+  garbage collect live sparks (:ghc-ticket:`22528`).
+
+- Truncate eventlog events with a large payload (:ghc-ticket:`20221`).
+
+- Fix a bug with the alignment of RTS data structures that could result in
+  segfaults when compiled with high optimisation settings on certain platforms
+  (:ghc-ticket:`22975` , :ghc-ticket:`22965`).
+
+- Take section alignment into account in the RTS linker (:ghc-ticket:`23066`).
+
+- Fix a bug causing segfaults where certain sections of the RTS would assume
+  that the number of capabilites was equal to the number passed via the command
+  line, even though the number of capabilites can be dynamically changed
+  (:ghc-ticket:`23088`).
+
+- Fix a race with the nonmoving GC (:ghc-ticket:`23170`).
+
+- A bug in the nonmoving garbage collector regarding the treatment of
+  zero-length ``SmallArray#``\ s has been fixed (:ghc-ticket:`22264`).
+
+- A number of bugs regarding the non-moving garbage collector's treatment of
+  ``Weak#`` pointers have been fixed (:ghc-ticket:`22327`).
+
+- A few race conditions between the non-moving collector and
+  ``setNumCapabilities`` which could result in undefined behavior have been
+  fixed (:ghc-ticket:`22926`, :ghc-ticket:`22927`).
+
+- The non-moving collector is now able to better schedule marking work during
+  the post-mark synchronization phase of collection, significantly reducing
+  pause times in some workloads (:ghc-ticket:`22929`).
+
+- Various bugs in the non-moving collector's implementation of the selector
+  optimisation have been fixed (:ghc-ticket:`22930`).
+
+- Accounting for live bytes is now performed accurately when using the
+  non-moving GC (:ghc-ticket:`17574`).
+
+- Allow performing memory inventory with the non-moving GC (:ghc-ticket:`21840`).
+
+Build system and packaging
+--------------------------
+
+- Bump ``gmp-tarballs`` to a version which doesn't use the reserved ``x18``
+  register on AArch64/Darwin systems, and also has fixes for CVE-2021-43618
+  (:ghc-ticket:`22497`, :ghc-ticket:`22789`).
+
+- Remove quarantine attribute when installing binary distribution on MacOS
+  (:ghc-ticket:`21506`, :ghc-ticket:`23009`).
+
+- Fail in the binary distribution ``configure`` script if ``find`` is not
+  available (:ghc-ticket:`22691`).
+
+- Install manpages with the binary distribution (:ghc-ticket:`22371`).
+
+- Fix a bug to do with merging of archives causing GHC to fail to bootstrap
+  on Windows (:ghc-ticket:`21990`).
+
+- Hadrian bug fixes to do with building a Windows cross compiler
+  (:ghc-ticket:`20697`, :ghc-ticket:`22805`).
+
+- Fix escaping of ``$tooldir`` in the ``configure`` script (:ghc-ticket:`22561`).
+
+- Allow LLVM 14 and use it for the Windows toolchain (:ghc-ticket:`21964`).
+
+Core libraries
+--------------
+
+- Bump ``base`` to 4.17.1.0
+
+- base: Remove ``mingwex`` dependency on Windows (:ghc-ticket:`22166`).
+
+- base: Fix inconsistency with decoding terminal input on Windows (:ghc-ticket:`21488`).
+
+- Bump ``bytestring`` to 0.11.4.0
+
+- Bump``parsec`` to 3.1.16.1
+
+- Bump ``text`` to 2.0.2
+
+- Bump ``containers`` to 0.6.7
+
+Included libraries
+------------------
+
+The package database provided with this distribution also contains a number of
+packages other than GHC itself. See the changelogs provided with these packages
+for further change information.
+
+.. ghc-package-list::
+
+    libraries/array/array.cabal:             Dependency of ``ghc`` library
+    libraries/base/base.cabal:               Core library
+    libraries/binary/binary.cabal:           Dependency of ``ghc`` library
+    libraries/bytestring/bytestring.cabal:   Dependency of ``ghc`` library
+    libraries/Cabal/Cabal/Cabal.cabal:       Dependency of ``ghc-pkg`` utility
+    libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal:  Dependency of ``ghc-pkg`` utility
+    libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library
+    libraries/deepseq/deepseq.cabal:         Dependency of ``ghc`` library
+    libraries/directory/directory.cabal:     Dependency of ``ghc`` library
+    libraries/exceptions/exceptions.cabal:   Dependency of ``ghc`` and ``haskeline`` library
+    libraries/filepath/filepath.cabal:       Dependency of ``ghc`` library
+    compiler/ghc.cabal:                      The compiler itself
+    libraries/ghci/ghci.cabal:               The REPL interface
+    libraries/ghc-boot/ghc-boot.cabal:       Internal compiler library
+    libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library
+    libraries/ghc-compact/ghc-compact.cabal: Core library
+    libraries/ghc-heap/ghc-heap.cabal:       GHC heap-walking library
+    libraries/ghc-prim/ghc-prim.cabal:       Core library
+    libraries/haskeline/haskeline.cabal:     Dependency of ``ghci`` executable
+    libraries/hpc/hpc.cabal:                 Dependency of ``hpc`` executable
+    libraries/integer-gmp/integer-gmp.cabal: Core library
+    libraries/libiserv/libiserv.cabal:       Internal compiler library
+    libraries/mtl/mtl.cabal:                 Dependency of ``Cabal`` library
+    libraries/parsec/parsec.cabal:           Dependency of ``Cabal`` library
+    libraries/pretty/pretty.cabal:           Dependency of ``ghc`` library
+    libraries/process/process.cabal:         Dependency of ``ghc`` library
+    libraries/stm/stm.cabal:                 Dependency of ``haskeline`` library
+    libraries/template-haskell/template-haskell.cabal: Core library
+    libraries/terminfo/terminfo.cabal:       Dependency of ``haskeline`` library
+    libraries/text/text.cabal:               Dependency of ``Cabal`` library
+    libraries/time/time.cabal:               Dependency of ``ghc`` library
+    libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
+    libraries/unix/unix.cabal:               Dependency of ``ghc`` library
+    libraries/Win32/Win32.cabal:             Dependency of ``ghc`` library
+    libraries/xhtml/xhtml.cabal:             Dependency of ``haddock`` executable
+


=====================================
docs/users_guide/release-notes.rst
=====================================
@@ -4,6 +4,7 @@ Release notes
 .. toctree::
    :maxdepth: 1
 
+   9.4.5-notes
    9.4.4-notes
    9.4.3-notes
    9.4.2-notes


=====================================
libraries/base/changelog.md
=====================================
@@ -4,7 +4,7 @@
 
    * Remove `mingwex` dependency on Windows (#22166).
 
-   * Fix inconcistency with decoding terminal input on Windows (#21488).
+   * Fix inconsistency with decoding terminal input on Windows (#21488).
 
 ## 4.17.0.0 *August 2022*
 


=====================================
rts/sm/NonMoving.c
=====================================
@@ -396,7 +396,8 @@ Mutex concurrent_coll_finished_lock;
  * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  * The nonmoving collector uses an approximate heuristic for reporting live
  * data quantity. Specifically, during mark we record how much live data we
- * find in nonmoving_live_words. At the end of mark we declare this amount to
+ * find in nonmoving_segment_live_words. At the end of mark this is combined with nonmoving_large_words
+ * and nonmoving_compact_words, and we declare this amount to
  * be how much live data we have on in the nonmoving heap (by setting
  * oldest_gen->live_estimate).
  *
@@ -541,7 +542,7 @@ Mutex concurrent_coll_finished_lock;
  *
  */
 
-memcount nonmoving_live_words = 0;
+memcount nonmoving_segment_live_words = 0;
 
 // See Note [Sync phase marking budget].
 MarkBudget sync_phase_marking_budget = 200000;
@@ -683,10 +684,11 @@ static void nonmovingPrepareMark(void)
         dbl_link_onto(bd, &nonmoving_large_objects);
     }
     n_nonmoving_large_blocks += oldest_gen->n_large_blocks;
+    nonmoving_large_words += oldest_gen->n_large_words;
     oldest_gen->large_objects = NULL;
     oldest_gen->n_large_words = 0;
     oldest_gen->n_large_blocks = 0;
-    nonmoving_live_words = 0;
+    nonmoving_segment_live_words = 0;
 
     // Clear compact object mark bits
     for (bdescr *bd = nonmoving_compact_objects; bd; bd = bd->link) {
@@ -701,6 +703,7 @@ static void nonmovingPrepareMark(void)
         dbl_link_onto(bd, &nonmoving_compact_objects);
     }
     n_nonmoving_compact_blocks += oldest_gen->n_compact_blocks;
+    nonmoving_compact_words += oldest_gen->n_compact_blocks * BLOCK_SIZE_W;
     oldest_gen->n_compact_blocks = 0;
     oldest_gen->compact_objects = NULL;
     // TODO (osa): what about "in import" stuff??
@@ -1054,7 +1057,9 @@ concurrent_marking:
     freeMarkQueue(mark_queue);
     stgFree(mark_queue);
 
-    oldest_gen->live_estimate = nonmoving_live_words;
+    nonmoving_large_words = countOccupied(nonmoving_marked_large_objects);
+    nonmoving_compact_words = n_nonmoving_marked_compact_blocks * BLOCK_SIZE_W;
+    oldest_gen->live_estimate = nonmoving_segment_live_words + nonmoving_large_words + nonmoving_compact_words;
     oldest_gen->n_old_blocks = 0;
     resizeGenerations();
 


=====================================
rts/sm/NonMoving.h
=====================================
@@ -120,10 +120,11 @@ struct NonmovingHeap {
 
 extern struct NonmovingHeap nonmovingHeap;
 
-extern memcount nonmoving_live_words;
+extern memcount nonmoving_segment_live_words;
 
 #if defined(THREADED_RTS)
 extern bool concurrent_coll_running;
+extern Mutex nonmoving_collection_mutex;
 #endif
 
 void nonmovingInit(void);


=====================================
rts/sm/NonMovingMark.c
=====================================
@@ -76,6 +76,10 @@ static bool is_nonmoving_weak(StgWeak *weak);
  * consequently will trace the pointers of only one object per block. However,
  * this is okay since the only type of pinned object supported by GHC is the
  * pinned ByteArray#, which has no pointers.
+ *
+ * We need to take care that the stats department is made aware of the amount of
+ * live large (and compact) objects, since they no longer live on gen[i]->large_objects.
+ * Failing to do so caused #17574.
  */
 
 bdescr *nonmoving_large_objects = NULL;
@@ -83,6 +87,9 @@ bdescr *nonmoving_marked_large_objects = NULL;
 memcount n_nonmoving_large_blocks = 0;
 memcount n_nonmoving_marked_large_blocks = 0;
 
+memcount nonmoving_large_words = 0;
+memcount nonmoving_compact_words = 0;
+
 bdescr *nonmoving_compact_objects = NULL;
 bdescr *nonmoving_marked_compact_objects = NULL;
 memcount n_nonmoving_compact_blocks = 0;
@@ -1736,7 +1743,7 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin)
         struct NonmovingSegment *seg = nonmovingGetSegment((StgPtr) p);
         nonmoving_block_idx block_idx = nonmovingGetBlockIdx((StgPtr) p);
         nonmovingSetMark(seg, block_idx);
-        nonmoving_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_);
+        nonmoving_segment_live_words += nonmovingSegmentBlockSize(seg) / sizeof(W_);
     }
 
     // If we found a indirection to shortcut keep going.


=====================================
rts/sm/NonMovingMark.h
=====================================
@@ -127,6 +127,11 @@ extern bdescr *nonmoving_large_objects, *nonmoving_marked_large_objects,
 extern memcount n_nonmoving_large_blocks, n_nonmoving_marked_large_blocks,
                 n_nonmoving_compact_blocks, n_nonmoving_marked_compact_blocks;
 
+// The size of live large/compact objects in words.
+// Only updated at the end of nonmoving GC.
+extern memcount nonmoving_large_words,
+                nonmoving_compact_words;
+
 extern StgTSO *nonmoving_old_threads;
 extern StgWeak *nonmoving_old_weak_ptr_list;
 extern StgTSO *nonmoving_threads;


=====================================
rts/sm/Sanity.c
=====================================
@@ -1206,11 +1206,12 @@ memInventory (bool show)
   bool leak;
 
 #if defined(THREADED_RTS)
-  // Can't easily do a memory inventory: We might race with the nonmoving
-  // collector. In principle we could try to take nonmoving_collection_mutex
-  // and do an inventory if we have it but we don't currently implement this.
-  if (RtsFlags.GcFlags.useNonmoving)
-    return;
+  // We need to be careful not to race with the nonmoving collector.
+  // If a nonmoving collection is on-going we simply abort the inventory.
+  if (RtsFlags.GcFlags.useNonmoving){
+    if(TRY_ACQUIRE_LOCK(&nonmoving_collection_mutex))
+      return;
+  }
 #endif
 
   // count the blocks we current have
@@ -1314,6 +1315,13 @@ memInventory (bool show)
   }
   ASSERT(n_alloc_blocks == live_blocks);
   ASSERT(!leak);
+
+#if defined(THREADED_RTS)
+  if (RtsFlags.GcFlags.useNonmoving){
+    RELEASE_LOCK(&nonmoving_collection_mutex);
+  }
+#endif
+
 }
 
 


=====================================
rts/sm/Storage.c
=====================================
@@ -42,6 +42,7 @@
 #include "GC.h"
 #include "Evac.h"
 #include "NonMovingAllocate.h"
+#include "sm/NonMovingMark.h"
 #if defined(ios_HOST_OS) || defined(darwin_HOST_OS)
 #include "Hash.h"
 #endif
@@ -1615,7 +1616,12 @@ W_ genLiveWords (generation *gen)
 
 W_ genLiveBlocks (generation *gen)
 {
-    return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks;
+  W_ nonmoving_blocks = 0;
+  // The nonmoving heap contains some blocks that live outside the regular generation structure.
+  if (gen == oldest_gen && RtsFlags.GcFlags.useNonmoving){
+    nonmoving_blocks = n_nonmoving_large_blocks + n_nonmoving_marked_large_blocks + n_nonmoving_compact_blocks + n_nonmoving_marked_compact_blocks;
+  }
+  return gen->n_blocks + gen->n_large_blocks + gen->n_compact_blocks + nonmoving_blocks;
 }
 
 W_ gcThreadLiveWords (uint32_t i, uint32_t g)
@@ -1711,6 +1717,9 @@ StgWord calcTotalLargeObjectsW (void)
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         totalW += generations[g].n_large_words;
     }
+
+    totalW += nonmoving_large_words;
+
     return totalW;
 }
 
@@ -1722,6 +1731,9 @@ StgWord calcTotalCompactW (void)
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         totalW += generations[g].n_compact_blocks * BLOCK_SIZE_W;
     }
+
+    totalW += nonmoving_compact_words;
+
     return totalW;
 }
 


=====================================
testsuite/tests/rts/T17574.hs
=====================================
@@ -0,0 +1,40 @@
+-- | Check that large objects are properly accounted for by GHC.Stats
+module Main (main) where
+
+import Control.Monad
+import Control.Exception
+import Control.Concurrent
+import System.Mem
+import System.Exit
+import GHC.Stats
+import GHC.Compact
+import Data.List (replicate)
+
+import qualified Data.ByteString.Char8 as BS
+
+doGC :: IO ()
+doGC = do
+  performMajorGC
+  threadDelay 1000 -- small delay to allow GC to run when using concurrent gc
+
+main :: IO ()
+main = do
+  let size = 4096*2
+  largeString <- evaluate $ BS.replicate size 'A'
+  compactString <- compact $ replicate size 'A'
+  doGC
+  doGC -- run GC twice to make sure the objects end up in the oldest gen
+  stats <- getRTSStats
+  let large_obj_bytes = gcdetails_large_objects_bytes $ gc stats
+  let compact_obj_bytes = gcdetails_compact_bytes $ gc stats
+  -- assert that large_obj_bytes is at least as big as size
+  -- this indicates that `largeString` is being accounted for by the stats department
+  when (large_obj_bytes < fromIntegral size) $ do
+    putStrLn $ "large_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size
+    exitFailure
+  when (compact_obj_bytes < fromIntegral size) $ do
+    putStrLn $ "compact_obj_bytes is: " <> show large_obj_bytes <> " but expected at least: " <> show size
+    exitFailure
+  -- keep them alive
+  print $ BS.length largeString
+  print $ length $ getCompact compactString


=====================================
testsuite/tests/rts/T17574.stdout
=====================================
@@ -0,0 +1,2 @@
+8192
+8192


=====================================
testsuite/tests/rts/all.T
=====================================
@@ -356,7 +356,7 @@ test('T10904', [ omit_ways(['ghci']), extra_run_opts('20000') ],
 test('T10728', [extra_run_opts('+RTS -maxN3 -RTS'), only_ways(['threaded2'])],
                compile_and_run, [''])
 
-test('T9405', [when(opsys('mingw32'), expect_broken(21361))], makefile_test, ['T9405'])
+test('T9405', normal, makefile_test, ['T9405'])
 
 test('T11788', when(ghc_dynamic(), skip),
               makefile_test, ['T11788'])
@@ -489,3 +489,5 @@ test('decodeMyStack', normal, compile_and_run, ['-finfo-table-map'])
 test('decodeMyStack_underflowFrames', [extra_run_opts('+RTS -kc8K -RTS')], compile_and_run, ['-finfo-table-map -rtsopts'])
 # -finfo-table-map intentionally missing
 test('decodeMyStack_emptyListForMissingFlag', [ignore_stdout, ignore_stderr], compile_and_run, [''])
+
+test('T17574', [], compile_and_run, ['-with-rtsopts -T'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ac1c43dd13a6b515ee8fd0158690949e862b75d...d52ea64e11e86577aecfc3b31dd3dc9aa8465192

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ac1c43dd13a6b515ee8fd0158690949e862b75d...d52ea64e11e86577aecfc3b31dd3dc9aa8465192
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/20230414/ccc533c0/attachment-0001.html>


More information about the ghc-commits mailing list