[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: EPA: Preserve comments for PrefixCon

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu May 2 08:19:07 UTC 2024



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
40026ac3 by Alan Zimmerman at 2024-05-01T22:45:07-04:00
EPA: Preserve comments for PrefixCon

Preserve comments in

    fun (Con {- c1 -} a b)
        = undefined

Closes #24736

- - - - -
92134789 by Hécate Moonlight at 2024-05-01T22:45:42-04:00
Correct `@since` metadata in HpcFlags

It was introduced in base-4.20, not 4.22.
Fix #24721

- - - - -
cf8f2dc9 by Cheng Shao at 2024-05-02T04:18:38-04:00
testsuite: fix req_target_smp predicate

- - - - -
517e12e7 by Andreas Klebinger at 2024-05-02T04:18:38-04:00
STM: Remove (unused)coarse grained locking.

The STM code had a coarse grained locking mode guarded by #defines that was unused.
This commit removes the code.

- - - - -
593141d6 by Andreas Klebinger at 2024-05-02T04:18:38-04:00
STM: Be more optimistic when validating in-flight transactions.

* Don't lock tvars when performing non-committal validation.
* If we encounter a locked tvar don't consider it a failure.

This means in-flight validation will only fail if committing at the
moment of validation is *guaranteed* to fail.

This prevents in-flight validation from failing spuriously if it happens in
parallel on multiple threads or parallel to thread comitting.

- - - - -
22eeb478 by Alan Zimmerman at 2024-05-02T04:18:39-04:00
EPA: fix span for empty \case(s)

In
    instance SDecide Nat where
      SZero %~ (SSucc _) = Disproved (\case)

Ensure the span for the HsLam covers the full construct.

Closes #24748

- - - - -


21 changed files:

- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- hadrian/src/Settings/Builders/RunTest.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- rts/Exception.cmm
- rts/STM.c
- rts/STM.h
- rts/Schedule.c
- rts/include/stg/SMP.h
- testsuite/config/ghc
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/mk/test.mk
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/PrefixConComment.hs
- + testsuite/tests/printer/Test24748.hs
- testsuite/tests/printer/all.T
- + testsuite/tests/rts/T24142.hs
- + testsuite/tests/rts/T24142.stdout
- testsuite/tests/rts/all.T


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -2900,10 +2900,10 @@ aexp    :: { ECP }
                             [mj AnnLam $1] }
         | '\\' 'lcase' altslist(pats1)
             {  ECP $ $3 >>= \ $3 ->
-                 mkHsLamPV (comb2 $1 $>) LamCase $3 [mj AnnLam $1,mj AnnCase $2] }
+                 mkHsLamPV (comb3 $1 $2 $>) LamCase $3 [mj AnnLam $1,mj AnnCase $2] }
         | '\\' 'lcases' altslist(argpats)
             {  ECP $ $3 >>= \ $3 ->
-                 mkHsLamPV (comb2 $1 $>) LamCases $3 [mj AnnLam $1,mj AnnCases $2] }
+                 mkHsLamPV (comb3 $1 $2 $>) LamCases $3 [mj AnnLam $1,mj AnnCases $2] }
         | 'if' exp optSemi 'then' exp optSemi 'else' exp
                          {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) ->
                             return $ ECP $


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1210,37 +1210,34 @@ checkPattern_details :: ParseContext -> PV (LocatedA (PatBuilder GhcPs)) -> P (L
 checkPattern_details extraDetails pp = runPV_details extraDetails (pp >>= checkLPat)
 
 checkLArgPat :: LocatedA (ArgPatBuilder GhcPs) -> PV (LPat GhcPs)
-checkLArgPat (L l (ArgPatBuilderVisPat p))
-  = checkPat l (L l p) [] []
+checkLArgPat (L l (ArgPatBuilderVisPat p)) = checkLPat (L l p)
 checkLArgPat (L l (ArgPatBuilderArgPat p)) = return (L l p)
 
 checkLPat :: LocatedA (PatBuilder GhcPs) -> PV (LPat GhcPs)
-checkLPat e@(L l _) = checkPat l e [] []
-
-checkPat :: SrcSpanAnnA -> LocatedA (PatBuilder GhcPs) -> [HsConPatTyArg GhcPs] -> [LPat GhcPs]
-         -> PV (LPat GhcPs)
-checkPat loc (L l e@(PatBuilderVar (L ln c))) tyargs args
-  | isRdrDataCon c = do
-      let (_l', loc') = transferCommentsOnlyA l loc
-      return . L loc' $ ConPat
-        { pat_con_ext = noAnn -- AZ: where should this come from?
-        , pat_con = L ln c
-        , pat_args = PrefixCon tyargs args
-        }
+checkLPat (L l@(EpAnn anc an _) p) = do
+  (L l' p', cs) <- checkPat (EpAnn anc an emptyComments) emptyComments (L l p) [] []
+  return (L (addCommentsToEpAnn l' cs) p')
+
+checkPat :: SrcSpanAnnA -> EpAnnComments -> LocatedA (PatBuilder GhcPs) -> [HsConPatTyArg GhcPs] -> [LPat GhcPs]
+         -> PV (LPat GhcPs, EpAnnComments)
+checkPat loc cs (L l e@(PatBuilderVar (L ln c))) tyargs args
+  | isRdrDataCon c = return (L loc $ ConPat
+      { pat_con_ext = noAnn -- AZ: where should this come from?
+      , pat_con = L ln c
+      , pat_args = PrefixCon tyargs args
+      }, comments l Semi.<> cs)
   | (not (null args) && patIsRec c) = do
       ctx <- askParseContext
       patFail (locA l) . PsErrInPat e $ PEIP_RecPattern args YesPatIsRecursive ctx
-checkPat loc (L _ (PatBuilderAppType (L lf f) at t)) tyargs args = do
-  let (loc', lf') = transferCommentsOnlyA loc lf
-  checkPat loc' (L lf' f) (HsConPatTyArg at t : tyargs) args
-checkPat loc (L _ (PatBuilderApp f (L le e))) [] args = do
-  let (loc', le') = transferCommentsOnlyA loc le
-  p <- checkLPat (L le' e)
-  checkPat loc' f [] (p : args)
-checkPat loc (L l e) [] [] = do
+checkPat loc cs (L la (PatBuilderAppType f at t)) tyargs args =
+  checkPat loc (cs Semi.<> comments la) f (HsConPatTyArg at t : tyargs) args
+checkPat loc cs (L la (PatBuilderApp f e)) [] args = do
+  p <- checkLPat e
+  checkPat loc (cs Semi.<> comments la) f [] (p : args)
+checkPat loc cs (L l e) [] [] = do
   p <- checkAPat loc e
-  return (L l p)
-checkPat loc e _ _ = do
+  return (L l p, cs)
+checkPat loc _ e _ _ = do
   details <- fromParseContext <$> askParseContext
   patFail (locA loc) (PsErrInPat (unLoc e) details)
 
@@ -1349,13 +1346,13 @@ checkFunBind :: SrcStrictness
              -> [LocatedA (ArgPatBuilder GhcPs)]
              -> Located (GRHSs GhcPs (LHsExpr GhcPs))
              -> P (HsBind GhcPs)
-checkFunBind strictness locF ann fun is_infix pats (L _ grhss)
+checkFunBind strictness locF ann (L lf fun) is_infix pats (L _ grhss)
   = do  ps <- runPV_details extraDetails (mapM checkLArgPat pats)
         let match_span = noAnnSrcSpan $ locF
-        return (makeFunBind fun (L (noAnnSrcSpan $ locA match_span)
+        return (makeFunBind (L (l2l lf) fun) (L (noAnnSrcSpan $ locA match_span)
                  [L match_span (Match { m_ext = ann
                                       , m_ctxt = FunRhs
-                                          { mc_fun    = fun
+                                          { mc_fun    = L lf fun
                                           , mc_fixity = is_infix
                                           , mc_strictness = strictness }
                                       , m_pats = ps
@@ -1364,7 +1361,7 @@ checkFunBind strictness locF ann fun is_infix pats (L _ grhss)
         -- That isn't quite right, but it'll do for now.
   where
     extraDetails
-      | Infix <- is_infix = ParseContext (Just $ unLoc fun) NoIncompleteDoBlock
+      | Infix <- is_infix = ParseContext (Just fun) NoIncompleteDoBlock
       | otherwise         = noParseContext
 
 makeFunBind :: LocatedN RdrName -> LocatedL [LMatch GhcPs (LHsExpr GhcPs)]


=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -282,7 +282,7 @@ runTestBuilderArgs = builder Testsuite ? do
             , arg "-e", arg $ asBool "ghc_with_dynamic_rts="  (hasDynamicRts)
             , arg "-e", arg $ asBool "config.ghc_with_threaded_rts=" (hasThreadedRts)
             , arg "-e", arg $ asBool "config.have_fast_bignum=" (bignumBackend /= "native" && not bignumCheck)
-            , arg "-e", arg $ asBool "target_with_smp=" targetWithSMP
+            , arg "-e", arg $ asBool "config.target_has_smp=" targetWithSMP
             , arg "-e", arg $ "config.ghc_dynamic=" ++ show hasDynamic
             , arg "-e", arg $ "config.leading_underscore=" ++ show leadingUnderscore
 


=====================================
libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
=====================================
@@ -380,14 +380,14 @@ data ParFlags = ParFlags
 
 -- | Parameters pertaining to Haskell program coverage (HPC)
 --
--- @since base-4.22.0.0
+-- @since base-4.20.0.0
 data HpcFlags = HpcFlags
     { writeTixFile :: Bool
       -- ^ Controls whether the @<program>.tix@ file should be
       -- written after the execution of the program.
     }
-    deriving (Show -- ^ @since base-4.22.0.0
-             , Generic -- ^ @since base-4.22.0.0
+    deriving (Show -- ^ @since base-4.20.0.0
+             , Generic -- ^ @since base-4.20.0.0
              )
 -- | Parameters of the runtime system
 --


=====================================
rts/Exception.cmm
=====================================
@@ -495,7 +495,7 @@ retry_pop_stack:
       W_ trec, outer;
       W_ r;
       trec = StgTSO_trec(CurrentTSO);
-      (r) = ccall stmValidateNestOfTransactions(MyCapability() "ptr", trec "ptr");
+      (r) = ccall stmValidateNestOfTransactions(MyCapability() "ptr", trec "ptr", 0);
       outer  = StgTRecHeader_enclosing_trec(trec);
       ccall stmAbortTransaction(MyCapability() "ptr", trec "ptr");
       ccall stmFreeAbortedTRec(MyCapability() "ptr", trec "ptr");


=====================================
rts/STM.c
=====================================
@@ -31,10 +31,8 @@
  * interface.  In the Haskell RTS this means it is suitable only for
  * non-THREADED_RTS builds.
  *
- * STM_CG_LOCK uses coarse-grained locking -- a single 'stm lock' is acquired
- * during an invocation on the STM interface.  Note that this does not mean that
- * transactions are simply serialized -- the lock is only held *within* the
- * implementation of stmCommitTransaction, stmWait etc.
+ * STM_CG_LOCK was a historic locking mode using coarse-grained locking
+ * It has been removed, look at the git history if you are interest in it.
  *
  * STM_FG_LOCKS uses fine-grained locking -- locking is done on a per-TVar basis
  * and, when committing a transaction, no locks are acquired for TVars that have
@@ -42,19 +40,14 @@
  *
  * Concurrency control is implemented in the functions:
  *
- *    lock_stm
- *    unlock_stm
  *    lock_tvar / cond_lock_tvar
  *    unlock_tvar
  *
- * The choice between STM_UNIPROC / STM_CG_LOCK / STM_FG_LOCKS affects the
+ * The choice between STM_UNIPROC / STM_FG_LOCKS affects the
  * implementation of these functions.
  *
- * lock_stm & unlock_stm are straightforward : they acquire a simple spin-lock
- * using STM_CG_LOCK, and otherwise they are no-ops.
- *
  * lock_tvar / cond_lock_tvar and unlock_tvar are more complex because they have
- * other effects (present in STM_UNIPROC and STM_CG_LOCK builds) as well as the
+ * other effects (present in STM_UNIPROC builds) as well as the
  * actual business of manipulating a lock (present only in STM_FG_LOCKS builds).
  * This is because locking a TVar is implemented by writing the lock holder's
  * TRec into the TVar's current_value field:
@@ -167,7 +160,6 @@ static int shake(void) {
 /*......................................................................*/
 
 #define IF_STM_UNIPROC(__X)  do { } while (0)
-#define IF_STM_CG_LOCK(__X)  do { } while (0)
 #define IF_STM_FG_LOCKS(__X) do { } while (0)
 
 #if defined(STM_UNIPROC)
@@ -175,14 +167,6 @@ static int shake(void) {
 #define IF_STM_UNIPROC(__X)  do { __X } while (0)
 static const StgBool config_use_read_phase = false;
 
-static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : lock_stm()", trec);
-}
-
-static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : unlock_stm()", trec);
-}
-
 static StgClosure *lock_tvar(Capability *cap STG_UNUSED,
                              StgTRecHeader *trec STG_UNUSED,
                              StgTVar *s STG_UNUSED) {
@@ -210,64 +194,9 @@ static StgBool cond_lock_tvar(Capability *cap STG_UNUSED,
                               StgTVar *s STG_UNUSED,
                               StgClosure *expected) {
   StgClosure *result;
-  TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
-  result = ACQUIRE_LOAD(&s->current_value);
-  TRACE("%p : %s", trec, (result == expected) ? "success" : "failure");
-  return (result == expected);
-}
-#endif
-
-#if defined(STM_CG_LOCK) /*........................................*/
-
-#undef IF_STM_CG_LOCK
-#define IF_STM_CG_LOCK(__X)  do { __X } while (0)
-static const StgBool config_use_read_phase = false;
-static volatile StgTRecHeader *smp_locked = NULL;
-
-static void lock_stm(StgTRecHeader *trec) {
-  while (cas(&smp_locked, NULL, trec) != NULL) { }
-  TRACE("%p : lock_stm()", trec);
-}
-
-static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : unlock_stm()", trec);
-  ASSERT(smp_locked == trec);
-  RELEASE_STORE(&smp_locked, 0);
-}
-
-static StgClosure *lock_tvar(Capability *cap STG_UNUSED,
-                             StgTRecHeader *trec STG_UNUSED,
-                             StgTVar *s STG_UNUSED) {
-  StgClosure *result;
-  TRACE("%p : lock_tvar(%p)", trec, s);
-  ASSERT(smp_locked == trec);
+  // TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
   result = ACQUIRE_LOAD(&s->current_value);
-  return result;
-}
-
-static void *unlock_tvar(Capability *cap,
-                         StgTRecHeader *trec STG_UNUSED,
-                         StgTVar *s,
-                         StgClosure *c,
-                         StgBool force_update) {
-  TRACE("%p : unlock_tvar(%p, %p)", trec, s, c);
-  ASSERT(smp_locked == trec);
-  if (force_update) {
-    StgClosure *old_value = ACQUIRE_LOAD(&s->current_value);
-    RELEASE_STORE(&s->current_value, c);
-    dirty_TVAR(cap, s, old_value);
-  }
-}
-
-static StgBool cond_lock_tvar(Capability *cap STG_UNUSED,
-                              StgTRecHeader *trec STG_UNUSED,
-                               StgTVar *s STG_UNUSED,
-                               StgClosure *expected) {
-  StgClosure *result;
-  TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
-  ASSERT(smp_locked == trec);
-  result = ACQUIRE_LOAD(&s->current_value);
-  TRACE("%p : %d", result ? "success" : "failure");
+  // TRACE("%p : %s", trec, (result == expected) ? "success" : "failure");
   return (result == expected);
 }
 #endif
@@ -278,19 +207,11 @@ static StgBool cond_lock_tvar(Capability *cap STG_UNUSED,
 #define IF_STM_FG_LOCKS(__X) do { __X } while (0)
 static const StgBool config_use_read_phase = true;
 
-static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : lock_stm()", trec);
-}
-
-static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : unlock_stm()", trec);
-}
-
 static StgClosure *lock_tvar(Capability *cap,
                              StgTRecHeader *trec,
                              StgTVar *s STG_UNUSED) {
   StgClosure *result;
-  TRACE("%p : lock_tvar(%p)", trec, s);
+  // TRACE("%p : lock_tvar(%p)", trec, s);
   do {
     const StgInfoTable *info;
     do {
@@ -313,7 +234,7 @@ static void unlock_tvar(Capability *cap,
                         StgTVar *s,
                         StgClosure *c,
                         StgBool force_update STG_UNUSED) {
-  TRACE("%p : unlock_tvar(%p, %p)", trec, s, c);
+  // TRACE("%p : unlock_tvar(%p, %p)", trec, s, c);
   ASSERT(ACQUIRE_LOAD(&s->current_value) == (StgClosure *)trec);
   RELEASE_STORE(&s->current_value, c);
   dirty_TVAR(cap, s, (StgClosure *) trec);
@@ -325,14 +246,14 @@ static StgBool cond_lock_tvar(Capability *cap,
                               StgClosure *expected) {
   StgClosure *result;
   StgWord w;
-  TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
+  // TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
   w = cas((void *)&(s -> current_value), (StgWord)expected, (StgWord)trec);
   result = (StgClosure *)w;
   IF_NONMOVING_WRITE_BARRIER_ENABLED {
       if (result)
           updateRemembSetPushClosure(cap, expected);
   }
-  TRACE("%p : %s", trec, result ? "success" : "failure");
+  // TRACE("%p : %s", trec, result ? "success" : "failure");
   return (result == expected);
 }
 #endif
@@ -438,6 +359,8 @@ static StgTRecHeader *new_stg_trec_header(Capability *cap,
 // Allocation / deallocation functions that retain per-capability lists
 // of closures that can be re-used
 
+//TODO: I think some of these lack write barriers required by the non-moving gc.
+
 static StgTVarWatchQueue *alloc_stg_tvar_watch_queue(Capability *cap,
                                                      StgClosure *closure) {
   StgTVarWatchQueue *result = NULL;
@@ -760,6 +683,44 @@ static void revert_ownership(Capability *cap STG_UNUSED,
 
 /*......................................................................*/
 
+// validate_optimistic()
+StgBool validate_trec_optimistic (Capability *cap, StgTRecHeader *trec);
+
+StgBool validate_trec_optimistic (Capability *cap, StgTRecHeader *trec) {
+  StgBool result;
+  TRACE("cap %d, trec %p : validate_trec_optimistic",
+         cap->no, trec);
+
+  if (shake()) {
+    TRACE("%p : shake, pretending trec is invalid when it may not be", trec);
+    return false;
+  }
+
+  ASSERT((trec -> state == TREC_ACTIVE) ||
+         (trec -> state == TREC_WAITING) ||
+         (trec -> state == TREC_CONDEMNED));
+  result = !((trec -> state) == TREC_CONDEMNED);
+  if (result) {
+    FOR_EACH_ENTRY(trec, e, {
+      StgTVar *s;
+      s = e -> tvar;
+      StgClosure *current = RELAXED_LOAD(&s->current_value);
+      if(current != e->expected_value &&
+          //If the trec is locked we optimistically assume our trec will still be valid after it's unlocked.
+         (GET_INFO(UNTAG_CLOSURE(current)) != &stg_TREC_HEADER_info))
+      {   TRACE("%p : failed optimistic validate %p", trec, s);
+          result = false;
+          BREAK_FOR_EACH;
+      }
+    });
+  }
+
+
+  TRACE("%p : validate_trec_optimistic, result: %d", trec, result);
+  return result;
+}
+
+
 // validate_and_acquire_ownership : this performs the twin functions
 // of checking that the TVars referred to by entries in trec hold the
 // expected values and:
@@ -778,6 +739,8 @@ static StgBool validate_and_acquire_ownership (Capability *cap,
                                                int acquire_all,
                                                int retain_ownership) {
   StgBool result;
+  TRACE("cap %d, trec %p : validate_and_acquire_ownership, all: %d, retrain: %d",
+         cap->no, trec, acquire_all, retain_ownership);
 
   if (shake()) {
     TRACE("%p : shake, pretending trec is invalid when it may not be", trec);
@@ -828,6 +791,7 @@ static StgBool validate_and_acquire_ownership (Capability *cap,
       revert_ownership(cap, trec, acquire_all);
   }
 
+  TRACE("%p : validate_and_acquire_ownership, result: %d", trec, result);
   return result;
 }
 
@@ -878,12 +842,10 @@ static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
 /************************************************************************/
 
 void stmPreGCHook (Capability *cap) {
-  lock_stm(NO_TREC);
   TRACE("stmPreGCHook");
   cap->free_tvar_watch_queues = END_STM_WATCH_QUEUE;
   cap->free_trec_chunks = END_STM_CHUNK_LIST;
   cap->free_trec_headers = NO_TREC;
-  unlock_stm(NO_TREC);
 }
 
 /************************************************************************/
@@ -959,8 +921,6 @@ void stmAbortTransaction(Capability *cap,
          (trec -> state == TREC_WAITING) ||
          (trec -> state == TREC_CONDEMNED));
 
-  lock_stm(trec);
-
   et = trec -> enclosing_trec;
   if (et == NO_TREC) {
     // We're a top-level transaction: remove any watch queue entries that
@@ -984,8 +944,6 @@ void stmAbortTransaction(Capability *cap,
   }
 
   trec -> state = TREC_ABORTED;
-  unlock_stm(trec);
-
   TRACE("%p : stmAbortTransaction done", trec);
 }
 
@@ -1013,35 +971,210 @@ void stmCondemnTransaction(Capability *cap,
          (trec -> state == TREC_WAITING) ||
          (trec -> state == TREC_CONDEMNED));
 
-  lock_stm(trec);
   if (trec -> state == TREC_WAITING) {
     ASSERT(trec -> enclosing_trec == NO_TREC);
     TRACE("%p : stmCondemnTransaction condemning waiting transaction", trec);
     remove_watch_queue_entries_for_trec(cap, trec);
   }
   trec -> state = TREC_CONDEMNED;
-  unlock_stm(trec);
 
   TRACE("%p : stmCondemnTransaction done", trec);
 }
 
-/*......................................................................*/
-
-StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec) {
+/*......................................................................
+
+Note [STM Validation]
+~~~~~~~~~~~~~~~~~~~~~
+To "validate" a transaction means to check that the transaction's log (Trec) is
+consistent with the current state of memory; specifically, that any variable
+observed (through reads AND writes) by the transaction has the same value in
+memory as it did when the transaction read it.
+
+In some situations we can give ourself some leeway by allowing:
+* False positives - The validation check claims the memory state is consistent when it isn't.
+* False negatives - The validation check claims memory state is inconsistent when it
+  is in fact consistent.
+
+We validate a STM transaction for two purposes:
+
+(A) Post-run validation runs /after/ the transaction has completed, either during
+    commit or after an exception has occurred.
+
+    This is done by validate_and_acquire_ownership.  The commit process
+    /absolutely must/ be transactional: that is, it must read a consistent
+    snapshot of memory, compare with the log, and then atomically commit all the
+    writes in the log.  We do this by locking the TVars.
+
+    For post-run validation we must *never* allow false-positives for correctness
+    reasons. But we allow for false-negatives, trading occasional spurious retries
+    for performance in the average case.
+
+    The implementation of performing this update atomically is mostly based on
+    the 2002 paper "A Practical Multi-Word Compare-and-Swap Operation"
+
+(B) In-flight validation runs /during/ the execution of the transaction. Suppose a transaction
+    is long-running, and memory has /already/ changed so that it is inconsistent with the
+    transaction's log. It is just conceivable that memory might change back again to be
+    consistent, but very unlikely. It is better to terminate and retry the transaction,
+    rather than let it run potentially forever as a zombie, and only retry when it attempts to commit.
+
+    This is done by validate_trec_optimistic. Since in-flight validation at most results in early
+    termination of a transaction we may accept both
+      * a "false negative" (causing the transaction to retry unnecessarily), and
+      * a "false positive" (allowing the transaction to continue as a zombie).
+
+    We want to run in-flight validation somewhat frequently to detect invalid
+    transactions early. We perform in-flight validation whenever a thread returns to
+    the scheduler, a convenient and regular opportunity.
+
+Note that in-flight validation is not merely a optimization. Consider transactions
+that are in an infinite loop as a result of seeing an inconsistent view of
+memory, e.g.
+
+      atomically $ do
+          [a,b] <- mapM readTVar [ta,tb]
+          -- a is never equal to b given a consistent view of memory.
+          when (a == b) loop
+
+As noted above, post-run validation and commit /must/ be transactional, involving expensive locking.
+But in-flight validation can accept false positives and false negatives. While we could lock TVars
+during in-flight validation to rule out false positives, we don't have to:
+it is much cheaper and very nearly as good simply to read them without locking allowing for
+false-postive results.
+
+Moreover, locking during in-flight validation can cause lack of progress, or livelock (#24446)
+through false-negative results. Suppose we have two long-running transactions, each doing successive
+in-flight validation using locking. If the validation discovers a locked TVar it aborts and retries.
+Now they can each abort the other, forever.
+This *can* also happen with post-run validation. But since post-run validation occurs less
+frequently it's incredibly unlikely to happen repeatedly compared to in-flight validation.
+
+Hence: locking during in-flight validation is
+ * Expensive
+ * Can lead to livelock-like conditions.
+
+Conclusion:
+  * don't use locking during in-flight validation.
+  * Use locking during post-run validation, where the risk of livelock is comparatively small
+    compared to the cost of ruling out live-lock completely.
+
+See below for other design alternatives.
+
+Design considerations about locking during in flight validation
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+All else being equal we would always want to get a precise result for validation.
+And indeed for the non-threaded runtime this is reasonably easy to achieve
+(see STM paper "Composable Memory Transactions").
+However for SMP things are more difficult, and ruling out false negatives/positives
+would come at significant cost in the average case.
+
+The easiest way to avoid false positives is to lock all relevant tvars during
+validation. And indeed that is what we use for post-run validation.
+The trade off being that it can lead to false negatives during validation when multiple
+threads perform validation in parallel. As long as the false-negative rate is
+is reasonably low this is not problematic.
+
+However in-flight validation can happen multiple times per transaction.
+So even a fairly low rate of spurious validation failures will result in a large
+performance hit. In the worst case preventing progress alltogether (See #24446).
+
+We don't want to reduce validation frequency too much to detect invalid
+transactions early. So we simply stick with the frequency "on return to scheduler"
+that's described in the stm paper.
+
+However we can improve in-flight validation perf by allowing false positives.
+This removes the need for tacking locks which means:
+
+Benefits
+* No lock contention between post-run and in-flight validations operating on the
+  same tvars. This reduces the false negative rate significantly for both.
+* Concurrent in-flight validations won't cause each other to fail spuriously
+  through lock contention.
+* No cas operations for in-flight validation reduces it's overhead significantly.
+
+Drawbacks:
+* We will sometimes fail to recognize invalid trecs as such by assuming locked
+  tvars contain valid values.
+
+Why can we simply not lock tvars for in-flight validations? Unlike with post-run
+validation if we miss part of an update which would invalidate the trec it will
+be either seen by a later validation (at the latest in the post-run validation
+which still locks). However there is one exception: Looping transactions.
+
+If a transaction loops it will *only* be validated optimistically.
+The only way for in-flight validation to constantly
+result in false-positives is for the conflicting tvar(s) to get constantly locked
+for updates by post-run validations. Which seems impossibly unlikely over a long
+period of time. So we accept this behaviour.
+
+Design alternatives to improve in-flight false-postive rate:
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+All of these primarily revolve around ways to ensure that we can recognize invalid
+looping transactions. However without proof this is a real problem implementing
+those seems not worthwhile.
+
+A1:
+Take locks for in-flight validation but don't fail if in-flight validation
+encounters already locked tvars.
+This would solve lock contention/false positives caused by concurrent in-flight validations.
+
+But it would still result in in-flight validation causing some false-negatives
+during post-run validation by holding locks post-run validation is trying to take.
+
+It also doesn't *guaranteed* that we recognize looping transaction as invalid.
+As the relevant tvars might be locked by other validations when we try to lock
+them. So while this would improve over using regular lock tacking for in-flight
+transactions it seems straight up worse than not taking locks to me in most
+situations.
+
+A2:
+Perform occasional locking in-flight validation for long running transactions.
+This would solve the theoretical looping transaction recognition issue at the
+cost of some performance and complexity. This could done by adding a counter to
+the trec, counting the number of validations it has endured.
+
+A2.1:
+Like A2, but instead of counting the number of validations count the number of
+locked tvars we encountered, as these are the only sources of false-positives.
+This would give a hard upper bound on the number of false-positives while keeping
+the impact on post-run validations lower.
+
+If the looping transaction issue turns out to be a real problem this might be worth
+doing.
+
+A3:
+When locking a tvar for a potential update keep the old value accessible. Then
+in-flight validations should never return false-positives. However compared to A2
+this seems like it would come with a non-trivial overhead relative to the likelyhood
+of these false-positives causing actual issues.
+
+
+*/
+
+// Check if a transaction is possibly invalid by this point.
+// Pessimistically - Currently we use this if an exception occured inside a transaction.
+//    To decide weither or not to abort by checking if the transaction was valid.
+// Optimistically - Currently we use this to eagerly abort invalid transactions from the scheduler.
+// See Note [STM Validation]
+StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec, StgBool optimistically) {
   StgTRecHeader *t;
 
-  TRACE("%p : stmValidateNestOfTransactions", trec);
+  TRACE("%p : stmValidateNestOfTransactions, %b", trec, optimistically);
   ASSERT(trec != NO_TREC);
   ASSERT((trec -> state == TREC_ACTIVE) ||
          (trec -> state == TREC_WAITING) ||
          (trec -> state == TREC_CONDEMNED));
 
-  lock_stm(trec);
-
   t = trec;
   StgBool result = true;
   while (t != NO_TREC) {
-    result &= validate_and_acquire_ownership(cap, t, true, false);
+    if(optimistically) {
+      result &= validate_trec_optimistic(cap, t);
+
+    } else {
+      // TODO: I don't think there is a need to lock all tvars here.
+      result &= validate_and_acquire_ownership(cap, t, true, false);
+    }
     t = t -> enclosing_trec;
   }
 
@@ -1049,12 +1182,9 @@ StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec) {
     trec -> state = TREC_CONDEMNED;
   }
 
-  unlock_stm(trec);
-
   TRACE("%p : stmValidateNestOfTransactions()=%d", trec, result);
   return result;
 }
-
 /*......................................................................*/
 
 static TRecEntry *get_entry_for(StgTRecHeader *trec, StgTVar *tvar, StgTRecHeader **in) {
@@ -1087,8 +1217,6 @@ StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
   TRACE("%p : stmCommitTransaction()", trec);
   ASSERT(trec != NO_TREC);
 
-  lock_stm(trec);
-
   ASSERT(trec -> enclosing_trec == NO_TREC);
   ASSERT((trec -> state == TREC_ACTIVE) ||
          (trec -> state == TREC_CONDEMNED));
@@ -1112,6 +1240,7 @@ StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
       max_concurrent_commits = ((max_commits_at_end - max_commits_at_start) +
                                 (getNumCapabilities() * TOKEN_BATCH_SIZE));
       if (((max_concurrent_commits >> 32) > 0) || shake()) {
+        TRACE("STM - Max commit number exceeded");
         result = false;
       }
     }
@@ -1145,8 +1274,6 @@ StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
     }
   }
 
-  unlock_stm(trec);
-
   free_stg_trec_header(cap, trec);
 
   TRACE("%p : stmCommitTransaction()=%d", trec, result);
@@ -1162,8 +1289,6 @@ StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) {
   TRACE("%p : stmCommitNestedTransaction() into %p", trec, trec -> enclosing_trec);
   ASSERT((trec -> state == TREC_ACTIVE) || (trec -> state == TREC_CONDEMNED));
 
-  lock_stm(trec);
-
   et = trec -> enclosing_trec;
   bool result = validate_and_acquire_ownership(cap, trec, (!config_use_read_phase), true);
   if (result) {
@@ -1196,8 +1321,6 @@ StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) {
     }
   }
 
-  unlock_stm(trec);
-
   free_stg_trec_header(cap, trec);
 
   TRACE("%p : stmCommitNestedTransaction()=%d", trec, result);
@@ -1214,7 +1337,6 @@ StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
   ASSERT((trec -> state == TREC_ACTIVE) ||
          (trec -> state == TREC_CONDEMNED));
 
-  lock_stm(trec);
   bool result = validate_and_acquire_ownership(cap, trec, true, true);
   if (result) {
     // The transaction is valid so far so we can actually start waiting.
@@ -1237,7 +1359,6 @@ StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
     // TRec.
 
   } else {
-    unlock_stm(trec);
     free_stg_trec_header(cap, trec);
   }
 
@@ -1249,7 +1370,6 @@ StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
 void
 stmWaitUnlock(Capability *cap, StgTRecHeader *trec) {
     revert_ownership(cap, trec, true);
-    unlock_stm(trec);
 }
 
 /*......................................................................*/
@@ -1263,7 +1383,6 @@ StgBool stmReWait(Capability *cap, StgTSO *tso) {
   ASSERT((trec -> state == TREC_WAITING) ||
          (trec -> state == TREC_CONDEMNED));
 
-  lock_stm(trec);
   bool result = validate_and_acquire_ownership(cap, trec, true, true);
   TRACE("%p : validation %s", trec, result ? "succeeded" : "failed");
   if (result) {
@@ -1280,7 +1399,6 @@ StgBool stmReWait(Capability *cap, StgTSO *tso) {
     }
     free_stg_trec_header(cap, trec);
   }
-  unlock_stm(trec);
 
   TRACE("%p : stmReWait()=%d", trec, result);
   return result;


=====================================
rts/STM.h
=====================================
@@ -6,24 +6,21 @@
  *
  *----------------------------------------------------------------------
 
-  STM.h defines the C-level interface to the STM.  
+  STM.h defines the C-level interface to the STM.
 
   The design follows that of the PPoPP 2005 paper "Composable memory
   transactions" extended to include fine-grained locking of TVars.
 
   Three different implementations can be built.  In overview:
-  
+
   STM_UNIPROC  -- no locking at all: not safe for concurrent invocations
- 
-  STM_CG_LOCK  -- coarse-grained locking : a single mutex protects all
-                  TVars
- 
+
   STM_FG_LOCKS -- per-TVar exclusion : each TVar can be owned by at
                   most one TRec at any time.  This allows dynamically
                   non-conflicting transactions to commit in parallel.
                   The implementation treats reads optimistically --
-                  extra versioning information is retained in the 
-                  saw_update_by field of the TVars so that they do not 
+                  extra versioning information is retained in the
+                  num_updates field of the TVars so that they do not
                   need to be locked for reading.
 
   STM.C contains more details about the locking schemes used.
@@ -72,7 +69,7 @@ void stmAbortTransaction(Capability *cap, StgTRecHeader *trec);
 void stmFreeAbortedTRec(Capability *cap, StgTRecHeader *trec);
 
 /*
- * Ensure that a subsequent commit / validation will fail.  We use this 
+ * Ensure that a subsequent commit / validation will fail.  We use this
  * in our current handling of transactions that may have become invalid
  * and started looping.  We strip their stack back to the ATOMICALLY_FRAME,
  * and, when the thread is next scheduled, discover it to be invalid and
@@ -87,16 +84,23 @@ void stmCondemnTransaction(Capability *cap, StgTRecHeader *trec);
    Validation
    ----------
 
-  Test whether the specified transaction record, and all those within which
-  it is nested, are still valid.
+   Test whether the specified transaction record, and all those within which
+   it is nested, are still valid.
+
+   stmValidateNestOfTransactions - optimistically
+      - Can return false positives when tvars are locked.
+      - Faster
+      - Does not take any locks
+
+   stmValidateNestOfTransactions - pessimistic
+      - Can return false negatives.
+      - Slower
+      - Takes locks, negatively affecting performance of other threads.
+      - Most importantly - no false positives!
 
-  Note: the caller can assume that once stmValidateTransaction has
-  returned false for a given trec then that transaction will never
-  again be valid -- we rely on this in Schedule.c when kicking invalid
-  threads at GC (in case they are stuck looping)
 */
 
-StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec);
+StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec, StgBool optimistically);
 
 /*----------------------------------------------------------------------
 
@@ -106,14 +110,14 @@ StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec);
    These four operations return boolean results which should be interpreted
    as follows:
 
-   true  => The transaction record was definitely valid 
+   true  => The transaction record was definitely valid
 
    false => The transaction record may not have been valid
 
    Note that, for nested operations, validity here is solely in terms
    of the specified trec: it does not say whether those that it may be
-   nested are themselves valid.  Callers can check this with 
-   stmValidateNestOfTransactions.
+   nested are themselves valid.  Callers can check this with
+   stmValidateNestOfTransactionsPessimistic.
 
    The user of the STM should ensure that it is always safe to assume that a
    transaction context is not valid when in fact it is (i.e. to return false in
@@ -151,7 +155,7 @@ StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec);
  * Test whether the current transaction context is valid and, if so,
  * start the thread waiting for updates to any of the tvars it has
  * ready from and mark it as blocked.  It is an error to call stmWait
- * if the thread is already waiting.  
+ * if the thread is already waiting.
  */
 
 StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec);
@@ -180,7 +184,7 @@ StgBool stmReWait(Capability *cap, StgTSO *tso);
  */
 
 StgClosure *stmReadTVar(Capability *cap,
-                        StgTRecHeader *trec, 
+                        StgTRecHeader *trec,
                         StgTVar *tvar);
 
 /* Update the logical contents of 'tvar' within the context of the
@@ -189,7 +193,7 @@ StgClosure *stmReadTVar(Capability *cap,
 
 void stmWriteTVar(Capability *cap,
                   StgTRecHeader *trec,
-                  StgTVar *tvar, 
+                  StgTVar *tvar,
                   StgClosure *new_value);
 
 /*----------------------------------------------------------------------*/


=====================================
rts/Schedule.c
=====================================
@@ -1106,7 +1106,7 @@ schedulePostRunThread (Capability *cap, StgTSO *t)
     // and a is never equal to b given a consistent view of memory.
     //
     if (t -> trec != NO_TREC && t -> why_blocked == NotBlocked) {
-        if (!stmValidateNestOfTransactions(cap, t -> trec)) {
+        if (!stmValidateNestOfTransactions(cap, t -> trec, true)) {
             debugTrace(DEBUG_sched | DEBUG_stm,
                        "trec %p found wasting its time", t);
 


=====================================
rts/include/stg/SMP.h
=====================================
@@ -201,14 +201,15 @@ EXTERN_INLINE void busy_wait_nop(void);
  *   - StgWeak: finalizer
  *   - StgMVar: head, tail, value
  *   - StgMVarTSOQueue: link
- *   - StgTVar: current_value, first_watch_queue_entry
- *   - StgTVarWatchQueue: {next,prev}_queue_entry
- *   - StgTRecChunk: TODO
  *   - StgMutArrPtrs: payload
  *   - StgSmallMutArrPtrs: payload
  *   - StgThunk although this is a somewhat special case; see below
  *   - StgInd: indirectee
  *   - StgTSO: block_info
+
+ *   - StgTVar: current_value, first_watch_queue_entry
+ *   - StgTVarWatchQueue: {next,prev}_queue_entry
+ *   - StgTRecChunk: TODO
  *
  * Finally, non-pointer fields can be safely mutated without barriers as
  * they do not refer to other memory locations. Technically, concurrent


=====================================
testsuite/config/ghc
=====================================
@@ -48,8 +48,7 @@ if config.have_interp:
 # whether the target supports smp
 if config.ghc_with_threaded_rts:
     config.run_ways.append('threaded1')
-    if target_with_smp:
-        config.target_has_smp = True
+    if config.target_has_smp:
         config.run_ways.append('threaded2')
         if config.speed == 0:
             config.run_ways.append('nonmoving_thr')


=====================================
testsuite/driver/testglobals.py
=====================================
@@ -154,7 +154,7 @@ class TestConfig:
         self.ghc_has_smp = True
 
         # Does the target have SMP support?
-        self.target_has_smp = True
+        self.target_has_smp = False
 
         # Is gdb available?
         self.have_gdb = False


=====================================
testsuite/driver/testlib.py
=====================================
@@ -328,11 +328,11 @@ def req_ghc_smp( name, opts ):
 def req_target_smp( name, opts ):
     """
     Mark a test as requiring smp when run on the target. If the target does
-    not support smp, then mark the test as an expected fail. Use this when the
+    not support smp, then skip the test. Use this when the
     test needs to run with smp support.
     """
     if not config.target_has_smp:
-        opts.expect = 'fail'
+        opts.skip = True
 
 def req_ghc_with_threaded_rts( name, opts ):
     if not config.ghc_with_threaded_rts:


=====================================
testsuite/mk/test.mk
=====================================
@@ -167,9 +167,9 @@ CABAL_PLUGIN_BUILD = --enable-library-vanilla --disable-shared
 endif
 
 ifeq "$(GhcWithSMP)" "YES"
-RUNTEST_OPTS += -e target_with_smp=True
+RUNTEST_OPTS += -e config.target_has_smp=True
 else
-RUNTEST_OPTS += -e target_with_smp=False
+RUNTEST_OPTS += -e config.target_has_smp=False
 endif
 
 ifeq "$(GhcWithRtsLinker)" "YES"


=====================================
testsuite/tests/parser/should_compile/T20846.stderr
=====================================
@@ -71,11 +71,7 @@
       (L
        (EpAnn
         (EpaSpan { T20846.hs:4:1-6 })
-        (NameAnn
-         (NameParens)
-         (EpaSpan { T20846.hs:4:1 })
-         (EpaSpan { T20846.hs:4:2-5 })
-         (EpaSpan { T20846.hs:4:6 })
+        (NameAnnTrailing
          [])
         (EpaComments
          []))


=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -837,6 +837,11 @@ MatchPatComments:
 	$(CHECK_PPR)   $(LIBDIR) MatchPatComments.hs
 	$(CHECK_EXACT) $(LIBDIR) MatchPatComments.hs
 
+.PHONY: Test24748
+Test24748:
+	$(CHECK_PPR)   $(LIBDIR) Test24748.hs
+	$(CHECK_EXACT) $(LIBDIR) Test24748.hs
+
 .PHONY: DataDeclShort
 DataDeclShort:
 	$(CHECK_PPR)   $(LIBDIR) DataDeclShort.hs


=====================================
testsuite/tests/printer/PrefixConComment.hs
=====================================
@@ -0,0 +1,4 @@
+module PrefixConComment where
+
+fun (Con {- c1 -} a {- c2 -} b {- c3 -})
+    = undefined


=====================================
testsuite/tests/printer/Test24748.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE LambdaCase #-}
+module Test24748 where
+
+instance SDecide Nat where
+  SZero %~ (SSucc _) = Disproved (\case)
+
+foo = (\case)
+bar = (\cases)


=====================================
testsuite/tests/printer/all.T
=====================================
@@ -200,4 +200,5 @@ test('Test24533', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24533'])
 test('PprLetIn', [ignore_stderr, req_ppr_deps], makefile_test, ['PprLetIn'])
 test('CaseAltComments', [ignore_stderr, req_ppr_deps], makefile_test, ['CaseAltComments'])
 test('MatchPatComments', [ignore_stderr, req_ppr_deps], makefile_test, ['MatchPatComments'])
+test('Test24748', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24748'])
 test('DataDeclShort', [ignore_stderr, req_ppr_deps], makefile_test, ['DataDeclShort'])


=====================================
testsuite/tests/rts/T24142.hs
=====================================
@@ -0,0 +1,63 @@
+{- This test constructs a program that used to trigger an excessive amount of STM retries. -}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE BangPatterns #-}
+module Main where
+
+import GHC.Conc
+import Control.Concurrent (newMVar, newEmptyMVar, takeMVar, putMVar)
+import Control.Monad
+import Control.Concurrent.STM.TArray
+import Data.Array.MArray
+import Data.IORef
+
+
+main :: IO ()
+main =
+    forM_ [2..40] $ \i -> do
+        -- Run the test with an increasing number of tvars
+        let tvar_count = i * 10
+        -- print $ "Tvars: " ++ show tvar_count
+        provokeLivelock tvar_count
+
+
+-- Forks two threads running a STM transactions, both accessing the same tvars but in opposite order.
+provokeLivelock :: Int -> IO ()
+provokeLivelock n = do
+    -- Use tvar array as a convenient way to bundle up n Tvars.
+    tvarArray <- atomically $ do
+        newListArray (0,n) [0.. fromIntegral n :: Integer] :: STM (TArray Int Integer)
+    m1 <- newEmptyMVar
+    m2 <- newEmptyMVar
+    updateCount <- newIORef (0 :: Int)
+
+    let useTvars :: [Int] -> Bool -> IO ()
+        useTvars tvar_order use_writes = atomically $ do
+            -- Walk the array once in the given order to add all tvars to the transaction log.
+            unsafeIOToSTM $ atomicModifyIORef' updateCount (\i -> (i+1,()))
+            mapM_ (\i -> readArray tvarArray i >>= \(!_n) -> return ()) tvar_order
+
+
+            -- Then we just enter the scheduler a lot
+            forM_ tvar_order $ \i -> do
+                -- when use_writes $
+                --     readArray tvarArray i >>= \(!n) -> writeArray tvarArray i (n+1 :: Integer)
+                unsafeIOToSTM yield
+
+    _ <- forkIO $ do
+                    useTvars [0..n] False
+                    -- print "Thread1 done."
+                    putMVar m1 True
+    _ <- forkIO $ do
+                    useTvars (reverse [0..n]) False
+                    -- print "Thread1 done."
+                    putMVar m2 True
+    -- Wait for forked threads.
+    _ <- takeMVar m1
+    _ <- takeMVar m2
+    updates <- readIORef updateCount
+    if updates > n
+        then putStrLn $ "TVars: " ++ show n ++ ", ERROR: more than " ++ show n ++ " transaction attempts. (" ++ show updates ++")\n"
+        else putStrLn $ "TVars: " ++ show n ++ ", OK: no more than " ++ show n ++ " transaction attempts."
+
+    return ()
+


=====================================
testsuite/tests/rts/T24142.stdout
=====================================
@@ -0,0 +1,39 @@
+TVars: 20, OK: no more than 20 transaction attempts.
+TVars: 30, OK: no more than 30 transaction attempts.
+TVars: 40, OK: no more than 40 transaction attempts.
+TVars: 50, OK: no more than 50 transaction attempts.
+TVars: 60, OK: no more than 60 transaction attempts.
+TVars: 70, OK: no more than 70 transaction attempts.
+TVars: 80, OK: no more than 80 transaction attempts.
+TVars: 90, OK: no more than 90 transaction attempts.
+TVars: 100, OK: no more than 100 transaction attempts.
+TVars: 110, OK: no more than 110 transaction attempts.
+TVars: 120, OK: no more than 120 transaction attempts.
+TVars: 130, OK: no more than 130 transaction attempts.
+TVars: 140, OK: no more than 140 transaction attempts.
+TVars: 150, OK: no more than 150 transaction attempts.
+TVars: 160, OK: no more than 160 transaction attempts.
+TVars: 170, OK: no more than 170 transaction attempts.
+TVars: 180, OK: no more than 180 transaction attempts.
+TVars: 190, OK: no more than 190 transaction attempts.
+TVars: 200, OK: no more than 200 transaction attempts.
+TVars: 210, OK: no more than 210 transaction attempts.
+TVars: 220, OK: no more than 220 transaction attempts.
+TVars: 230, OK: no more than 230 transaction attempts.
+TVars: 240, OK: no more than 240 transaction attempts.
+TVars: 250, OK: no more than 250 transaction attempts.
+TVars: 260, OK: no more than 260 transaction attempts.
+TVars: 270, OK: no more than 270 transaction attempts.
+TVars: 280, OK: no more than 280 transaction attempts.
+TVars: 290, OK: no more than 290 transaction attempts.
+TVars: 300, OK: no more than 300 transaction attempts.
+TVars: 310, OK: no more than 310 transaction attempts.
+TVars: 320, OK: no more than 320 transaction attempts.
+TVars: 330, OK: no more than 330 transaction attempts.
+TVars: 340, OK: no more than 340 transaction attempts.
+TVars: 350, OK: no more than 350 transaction attempts.
+TVars: 360, OK: no more than 360 transaction attempts.
+TVars: 370, OK: no more than 370 transaction attempts.
+TVars: 380, OK: no more than 380 transaction attempts.
+TVars: 390, OK: no more than 390 transaction attempts.
+TVars: 400, OK: no more than 400 transaction attempts.


=====================================
testsuite/tests/rts/all.T
=====================================
@@ -609,3 +609,5 @@ test('T23400', [], compile_and_run, ['-with-rtsopts -A8k'])
 test('IOManager', [js_skip, when(arch('wasm32'), skip), when(opsys('mingw32'), skip),
                    pre_cmd('$MAKE -s --no-print-directory IOManager.hs')],
                   compile_and_run, [''])
+
+test('T24142', [req_target_smp], compile_and_run, ['-threaded -with-rtsopts "-N2"'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfbf86cb853341168949af1f1056401bd4d21224...22eeb478fef276a0f6d7cb758f0463e26f9b1ee8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfbf86cb853341168949af1f1056401bd4d21224...22eeb478fef276a0f6d7cb758f0463e26f9b1ee8
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/20240502/95527732/attachment-0001.html>


More information about the ghc-commits mailing list