Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
67c03eb2
by Cheng Shao at 2026-07-08T16:54:09-04:00
6 changed files:
- + changelog.d/fix-peekitbl-no-tntc
- + libraries/ghc-heap/tests/T27465.hs
- + libraries/ghc-heap/tests/T27465.stdout
- libraries/ghc-heap/tests/all.T
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
Changes:
| 1 | +section: ghc-heap
|
|
| 2 | +synopsis: Fix invalid srtlen field returned by peekItbl when no tables-next-to-code
|
|
| 3 | +issues: #27465
|
|
| 4 | +mrs: !16289 |
| 1 | +{-# LANGUAGE MagicHash #-}
|
|
| 2 | + |
|
| 3 | +import GHC.Exts
|
|
| 4 | +import GHC.Exts.Heap
|
|
| 5 | + |
|
| 6 | +data T = A | B | C
|
|
| 7 | + |
|
| 8 | +main :: IO ()
|
|
| 9 | +main = do
|
|
| 10 | + clos <- getClosureData C
|
|
| 11 | + let expected = I# (dataToTag# C)
|
|
| 12 | + case clos of
|
|
| 13 | + ConstrClosure {info = itbl, name = con} -> do
|
|
| 14 | + putStrLn $ "constructor: " ++ con
|
|
| 15 | + putStrLn $ "expected tag: " ++ show expected
|
|
| 16 | + putStrLn $ "srtlen field: " ++ show (srtlen itbl)
|
|
| 17 | + if fromIntegral (srtlen itbl) == expected
|
|
| 18 | + then putStrLn "OK"
|
|
| 19 | + else fail "peekItbl returned wrong srtlen"
|
|
| 20 | + _ -> fail $ "unexpected closure: " ++ show clos |
| 1 | +constructor: C
|
|
| 2 | +expected tag: 2
|
|
| 3 | +srtlen field: 2
|
|
| 4 | +OK |
| ... | ... | @@ -105,3 +105,8 @@ test('stack_misc_closures', |
| 105 | 105 | ]
|
| 106 | 106 | , '-debug' # Debug RTS to use checkSTACK() (Sanity.c)
|
| 107 | 107 | ])
|
| 108 | + |
|
| 109 | +test('T27465',
|
|
| 110 | + [ when(have_profiling(), extra_ways(['prof']))
|
|
| 111 | + ],
|
|
| 112 | + compile_and_run, ['']) |
| ... | ... | @@ -49,7 +49,7 @@ peekItbl a0 = do |
| 49 | 49 | ptrs' <- (#peek struct StgInfoTable_, layout.payload.ptrs) ptr
|
| 50 | 50 | nptrs' <- (#peek struct StgInfoTable_, layout.payload.nptrs) ptr
|
| 51 | 51 | tipe' <- (#peek struct StgInfoTable_, type) ptr
|
| 52 | - srtlen' <- (#peek struct StgInfoTable_, srt) a0
|
|
| 52 | + srtlen' <- (#peek struct StgInfoTable_, srt) ptr
|
|
| 53 | 53 | return StgInfoTable
|
| 54 | 54 | { entry = entry'
|
| 55 | 55 | , ptrs = ptrs'
|
| ... | ... | @@ -46,7 +46,7 @@ peekItbl a0 = do |
| 46 | 46 | ptrs' <- (#peek struct StgInfoTable_, layout.payload.ptrs) ptr
|
| 47 | 47 | nptrs' <- (#peek struct StgInfoTable_, layout.payload.nptrs) ptr
|
| 48 | 48 | tipe' <- (#peek struct StgInfoTable_, type) ptr
|
| 49 | - srtlen' <- (#peek struct StgInfoTable_, srt) a0
|
|
| 49 | + srtlen' <- (#peek struct StgInfoTable_, srt) ptr
|
|
| 50 | 50 | return StgInfoTable
|
| 51 | 51 | { entry = entry'
|
| 52 | 52 | , ptrs = ptrs'
|