Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e2d57026 by Luite Stegeman at 2026-09-15T20:13:54-04:00 JS: fix selector thunk handling fix a bug where entering a selector thunk could lead to a crash if the selected field was still a thunk. fixes #27788 - - - - - 6 changed files: - + changelog.d/T27788-js-selector - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Symbols.hs - + testsuite/tests/javascript/T27788.hs - + testsuite/tests/javascript/T27788.stdout - testsuite/tests/javascript/all.T Changes: ===================================== changelog.d/T27788-js-selector ===================================== @@ -0,0 +1,4 @@ +section: js-backend +synopsis: Fix a bug in the JavaScript backend: Entering a selector thunk whose selected field was an unevaluated thunk could duplicate work or crash the program with a type error. +issues: #27788 +mrs: !16681 ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -1036,7 +1036,12 @@ updates s = do [ si' |= ss' .! i , sir' |= (closureField2 si') `ApplExpr` [r1] , ifS (app "typeof" [sir'] .===. jTyObject) - (copyClosure DontCopyCC si' sir') + (ifS (isThunk sir' .||. isBlackhole sir') + (mconcat [ closureInfo si' |= hdUpdThunkEntry + , closureField1 si' |= sir' + , closureField2 si' |= null_ + ]) + (copyClosure DontCopyCC si' sir')) (assignClosure si' $ unbox_closure sir') , postIncrS i ] @@ -1066,7 +1071,8 @@ updates s = do , -- update selectors jwhenS ((app typeof [closureMeta updatee] .===. jTyObject) .&&. (closureMeta updatee .^ "sel")) ((ss |= closureMeta updatee .^ "sel") - <> upd_loop) + <> upd_loop + <> (closureMeta updatee .^ "sel" |= null_)) , -- overwrite the object ifS (app typeof [r1] .===. jTyObject) (mconcat [ traceRts s (jString "$upd_frame: boxed: " + ((closureInfo r1) .^ "n")) ===================================== compiler/GHC/StgToJS/Symbols.hs ===================================== @@ -375,6 +375,9 @@ hdCAFsResetStr = name "h$CAFsReset" hdUpdThunkEntryStr :: Ident hdUpdThunkEntryStr = name "h$upd_thunk_e" +hdUpdThunkEntry :: JStgExpr +hdUpdThunkEntry = global (identFS hdUpdThunkEntryStr) + hdAp3EntryStr :: Ident hdAp3EntryStr = name "h$ap3_e" ===================================== testsuite/tests/javascript/T27788.hs ===================================== @@ -0,0 +1,25 @@ +module Main where + +import Control.Exception (evaluate) +import System.Environment (getArgs) + +{-# NOINLINE mkInner #-} +mkInner :: Int -> (Int, Int) +mkInner n = (n + 1, n + 2) + +{-# NOINLINE mkOuter #-} +mkOuter :: (Int, Int) -> Int -> ((Int, Int), Int) +mkOuter a n = (a, n) + +main :: IO () +main = do + n <- length <$> getArgs + let inner = mkInner n + outer = mkOuter inner n + (inner', _) = outer + (p, _) = inner + _ <- evaluate inner' + print (fst inner') + print (fst inner) + print p + print (snd outer) ===================================== testsuite/tests/javascript/T27788.stdout ===================================== @@ -0,0 +1,4 @@ +1 +1 +1 +0 ===================================== testsuite/tests/javascript/all.T ===================================== @@ -28,3 +28,5 @@ test('T24744', normal, makefile_test, ['T24744']) test('T25633', normal, compile_and_run, ['']) test('T24886', normal, compile, ['']) + +test('T27788', normal, compile_and_run, ['-O0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2d57026995cd8065004764f6ef3b187... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2d57026995cd8065004764f6ef3b187... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help