GitLab

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

Commits:

53682431

by Simon Jakobi at 2026-08-14T11:46:25-04:00

testsuite: Expect length001 failure in nonmoving_thr_sanity

length001 relies on an optimization rule to avoid excessive stack use.
The nonmoving_thr_sanity way does not enable optimization, so classify
its stack overflow as an expected failure, as is already done for the
other unoptimized nonmoving ways.

Assisted-by: gpt-5.6-sol via Codex CLI

c08a77ff

by Simon Jakobi at 2026-08-14T11:46:25-04:00

testsuite: Omit T22859 in nonmoving threaded ways

T22859 checks allocation-limit handlers with output that depends on
precise allocation behaviour. The nonmoving threaded ways change where
these limits are reached, just as the already-omitted LLVM ways do.

Omit these ways instead of treating their incidental output differences
as test failures.

Assisted-by: gpt-5.6-sol via Codex CLI

8c1a9eab

by Simon Jakobi at 2026-08-14T11:46:25-04:00

rts/js: Implement eq_thread, and test Eq/Ord ThreadId (#16761)

Since d1f3c63701, Eq ThreadId is implemented via the RTS function
eq_thread, but the JS RTS never provided it, so comparing ThreadIds
for equality on the JS backend crashed with

    ReferenceError: h$eq_thread is not defined

Like the C implementation, h$eq_thread uses pointer equality: The JS
RTS has exactly one thread object per thread.

Since previously no test exercised eq_thread directly, this commit
adds a test covering equality, its stability across GC, and agreement
with Ord.

Assisted-by: Claude Fable 5

1a2b95ef

by Simon Jakobi at 2026-08-14T11:46:25-04:00

testsuite: Make listThreads1 insensitive to the RTS's own threads

listThreads1 expected `listThreads` to return exactly [ThreadId 1]. That
holds only under a non-threaded RTS. Under a threaded RTS however there
are more threads present, so we change the test to simply check that
`myThreadId` is present in the list.

Assisted-by: Claude Opus 5

d22fd7ec

by Vladislav Zavialov at 2026-08-14T11:46:27-04:00

Fix tcLookupId panic with RequiredTypeArguments and PatternSynonyms (#27586)

The arguments declared on the left-hand side of a pattern synonym are looked up
as term variables bound by its right-hand side. Prior to this patch, that lookup
panicked with RequiredTypeArguments:

    data T a where
      MkT :: forall a -> T a

    pattern P :: Int -> T Int
    pattern P x = MkT x

On the RHS, `x` looks like a term argument, so the renamer binds it in the term
namespace. Only during type checking does it turn out to be a type variable, so
the lookup on the LHS finds an ATyVar rather than an ATcId. As the lookup was
done with tcLookupId, it resulted in a panic.

Now the arguments are looked up with tcLookupPatSynArg, which reports an illegal
term-level use of `x`, just as an ordinary function definition `f (MkT x) = x`
does.

Test cases: T27586a T27586b T27586c

Assisted-by: Claude Opus 5

17 changed files:

+ changelog.d/T27586
compiler/GHC/Tc/TyCl/PatSyn.hs
libraries/base/tests/all.T
libraries/base/tests/listThreads1.hs
libraries/base/tests/listThreads1.stdout
rts/js/thread.js
+ testsuite/tests/concurrent/should_run/T16761.hs
+ testsuite/tests/concurrent/should_run/T16761.stdout
testsuite/tests/concurrent/should_run/all.T
testsuite/tests/rts/all.T
+ testsuite/tests/vdq-rta/should_fail/T27586a.hs
+ testsuite/tests/vdq-rta/should_fail/T27586a.stderr
+ testsuite/tests/vdq-rta/should_fail/T27586b.hs
+ testsuite/tests/vdq-rta/should_fail/T27586b.stderr
+ testsuite/tests/vdq-rta/should_fail/T27586c.hs
+ testsuite/tests/vdq-rta/should_fail/T27586c.stderr
testsuite/tests/vdq-rta/should_fail/all.T

Changes:

changelog.d/T27586

 +section: compiler
 +issues: #27586
 +mrs: !16440
 +synopsis:
 +  Fix a panic on a required type argument in a pattern synonym RHS
 +description:
 +  An argument of a pattern synonym that is matched against a required type
 +  argument in the right-hand side no longer causes a panic; it is reported as
 +  an illegal term-level use of a type variable.

compiler/GHC/Tc/TyCl/PatSyn.hs

@@ -137,7 +137,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(L _ name), psb_args = details
         ; (tclvl, wanted, ((lpat', args), pat_ty))
              <- pushLevelAndCaptureConstraints      $
                 tcInferPat FRRPatSynArg PatSynCtx lpat $
 -               mapM tcLookupId arg_names
 +               mapM tcLookupPatSynArg arg_names
         ; let (ex_tvs, prov_dicts) = tcCollectEx lpat'
@@ -472,7 +472,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
             -- location to x's binding site in lpat, namely the 'x' in Just (x,True).
             -- Else the error message location is wherever tcCheckPat finished,
             -- namely the right-hand corner of the pattern
 -        do { arg_id <- tcLookupId arg_name
 +        do { arg_id <- tcLookupPatSynArg arg_name
             ; wrap <- tcSubTypeSigma (OccurrenceOf (idName arg_id))
                                      GenSigCtxt
                                      (idType arg_id)
@@ -645,6 +645,19 @@ collectPatSynArgInfo details =
      InfixCon _ name1 name2 -> (map unLoc [name1, name2], True)
      RecCon _ names         -> (map (unLoc . recordPatSynPatVar) names, False)
 +-- | Look up the 'Id' bound by the pattern for a declared argument of a pattern
 +-- synonym. With @RequiredTypeArguments@ the argument may turn out to be a type
 +-- variable, e.g. @pattern P x = MkT x@ where the argument of @MkT@ is a required
 +-- type argument; then we report an illegal term-level use of @x@ (#27586).
 +tcLookupPatSynArg :: Name -> TcM Id
 +tcLookupPatSynArg arg_name
 +  = do { thing <- tcLookup arg_name
 +       ; case thing of
 +           ATcId { tct_id = id } -> return id
 +           AGlobal (AnId id)     -> return id
 +           ATyVar {}             -> failIllegalTyVar (noUserRdr arg_name)
 +           _                     -> pprPanic "tcLookupPatSynArg" (ppr arg_name) }
++
  wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a
  wrongNumberOfParmsErr name decl_arity missing
    = failWithTc $ TcRnPatSynArityMismatch name decl_arity missing

libraries/base/tests/all.T

@@ -80,7 +80,7 @@ test('length001',
       # excessive amounts of stack space. So we specifically set a low
       # stack limit and mark it as failing under a few conditions.
       [extra_run_opts('+RTS -K8m -RTS'),
 -     expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'ext-interp']),
 +     expect_fail_for(['normal', 'threaded1', 'llvm', 'nonmoving', 'nonmoving_thr', 'nonmoving_thr_sanity', 'nonmoving_thr_ghc', 'ext-interp']),
       # JS doesn't support stack limit so the test sometimes passes just fine. Therefore the test is
       # marked as fragile.
       when(js_arch(), fragile(22921))],

libraries/base/tests/listThreads1.hs

@@ -2,5 +2,10 @@ module Main where
  import GHC.Conc.Sync
 +-- Regression test for the JS backend's ListThreadsOp, which used to omit the
 +-- running thread. Whatever other threads the RTS has is irrelevant here.
  main :: IO ()
 -main = listThreads >>= print
 +main = do
 +  tid <- myThreadId
 +  ts <- listThreads
 +  print (tid `elem` ts)

libraries/base/tests/listThreads1.stdout

1		-[ThreadId 1]
	1	+True

rts/js/thread.js

@@ -110,6 +110,10 @@ function h$rts_getThreadId(t) { // returns a CULLong
    RETURN_UBX_TUP2((t.tid / Math.pow(2,32))>>>0, (t.tid & 0xFFFFFFFF)>>>0);
+ }
 +function h$eq_thread(t1,t2) {
 +  return t1 === t2 ? 1 : 0;
 +}
++
  function h$cmp_thread(t1,t2) {
    if(t1.tid < t2.tid) return -1;
    if(t1.tid > t2.tid) return 1;

testsuite/tests/concurrent/should_run/T16761.hs

 +-- Test that Eq ThreadId is based on thread identity (eq_thread),
 +-- not on the numeric thread id, which may wrap around (#16761).
 +module Main (main) where
++
 +import Control.Concurrent
 +import System.Mem (performGC)
++
 +main :: IO ()
 +main = do
 +  t0 <- myThreadId
 +  print (t0 == t0)
++
 +  mv <- newEmptyMVar
 +  _ <- forkIO (myThreadId >>= putMVar mv)
 +  tChild <- takeMVar mv
 +  print (t0 == tChild)
 +  print (tChild == tChild)
++
 +  -- Equality must be stable even after the GC moves the TSOs.
 +  performGC
 +  print (t0 == t0)
++
 +  -- Ord must agree with Eq.
 +  print (compare t0 tChild /= EQ)
 +  print (compare t0 t0 == EQ)

testsuite/tests/concurrent/should_run/T16761.stdout

 +True
 +False
 +True
 +True
 +True
 +True

testsuite/tests/concurrent/should_run/all.T

@@ -310,6 +310,8 @@ test('hs_try_putmvar003',
  # Check forkIO exception determinism under optimization
  test('T13330', normal, compile_and_run, ['-O'])
 +test('T16761', normal, compile_and_run, [''])
++
  test('T26341', normal, compile_and_run, [''])
  # Test EINTR for async I/O interrupted by an exception (#26341)

testsuite/tests/rts/all.T

@@ -679,7 +679,7 @@ test('T22859',
       [js_skip,
        # This test is vulnerable to changes in allocation behaviour, so we disable it in some ways
        when(arch('wasm32'), skip),
 -      omit_ways(llvm_ways)],
 +      omit_ways(llvm_ways + ['nonmoving_thr', 'nonmoving_thr_sanity'])],
       compile_and_run, ['-with-rtsopts -A8K'])
  # These tests need access to the internal RTS headers.

testsuite/tests/vdq-rta/should_fail/T27586a.hs

 +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
++
 +module T27586a where
++
 +data T a where
 +  MkT :: forall a -> T a
++
 +pattern P :: Int -> T Int
 +pattern P x = MkT x

testsuite/tests/vdq-rta/should_fail/T27586a.stderr

 +T27586a.hs:9:19: error: [GHC-01928]
 +    • Illegal term-level use of the type variable ‘x’
 +    • bound at T27586a.hs:9:19
 +    • In the declaration for pattern synonym ‘P’
++

testsuite/tests/vdq-rta/should_fail/T27586b.hs

 +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
++
 +module T27586b where
++
 +data T a where
 +  MkT :: forall a -> T a
++
 +pattern P x = MkT x

testsuite/tests/vdq-rta/should_fail/T27586b.stderr

 +T27586b.hs:8:15: error: [GHC-01928]
 +    • Illegal term-level use of the type variable ‘x’
 +    • bound at T27586b.hs:8:19
 +    • In the declaration for pattern synonym ‘P’
++

testsuite/tests/vdq-rta/should_fail/T27586c.hs

 +{-# LANGUAGE GADTs, RequiredTypeArguments, PatternSynonyms #-}
++
 +module T27586c where
++
 +data T a where
 +  MkT :: forall a -> T a
++
 +pattern P :: Int -> T Int
 +pattern P x <- MkT x

testsuite/tests/vdq-rta/should_fail/T27586c.stderr

 +T27586c.hs:9:20: error: [GHC-01928]
 +    • Illegal term-level use of the type variable ‘x’
 +    • bound at T27586c.hs:9:20
 +    • In the declaration for pattern synonym ‘P’
++

testsuite/tests/vdq-rta/should_fail/all.T

@@ -35,3 +35,6 @@ test('T25127_fail_arity', normal, compile_fail, [''])
  test('T27440e', normal, compile_fail, [''])
  test('T27583f', normal, compile_fail, [''])
 +test('T27586a', normal, compile_fail, [''])
 +test('T27586b', normal, compile_fail, [''])
 +test('T27586c', normal, compile_fail, [''])