Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 44b8cee2 by Cheng Shao at 2025-06-18T15:34:46-04:00 testsuite: add T26120 marked as broken - - - - - 894a04f3 by Cheng Shao at 2025-06-18T15:34:46-04:00 compiler: fix GHC.SysTools.Ar archive member size writing logic This patch fixes a long-standing bug in `GHC.SysTools.Ar` that emits the wrong archive member size in each archive header. It should encode the exact length of the member payload, excluding any padding byte, otherwise malformed archive that extracts a broken object with an extra trailing byte could be created. Apart from the in-tree `T26120` test, I've also created an out-of-tree testsuite at https://github.com/TerrorJack/ghc-ar-quickcheck that contains QuickCheck roundtrip tests for `GHC.SysTools.Ar`. With this fix, simple roundtrip tests and `writeGNUAr`/GNU `ar` roundtrip test passes. There might be more bugs lurking in here, but this patch is still a critical bugfix already. Fixes #26120 #22586. Co-authored-by: Codex - - - - - 4 changed files: - compiler/GHC/SysTools/Ar.hs - + testsuite/tests/ghc-api/T26120.hs - + testsuite/tests/ghc-api/T26120.stdout - testsuite/tests/ghc-api/all.T Changes: ===================================== compiler/GHC/SysTools/Ar.hs ===================================== @@ -168,7 +168,7 @@ putArchEntry (ArchiveEntry name time own grp mode st_size file) = do putPaddedInt 6 own putPaddedInt 6 grp putPaddedInt 8 mode - putPaddedInt 10 (st_size + pad) + putPaddedInt 10 st_size putByteString "\x60\x0a" putByteString file when (pad == 1) $ ===================================== testsuite/tests/ghc-api/T26120.hs ===================================== @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main + ( main, + ) +where + +import Data.Foldable +import GHC.SysTools.Ar + +main :: IO () +main = for_ [writeBSDAr, writeGNUAr] $ \writer -> do + writer "test.a" $ + Archive + [ ArchiveEntry + { filename = "1", + filetime = 0, + fileown = 0, + filegrp = 0, + filemode = 644, + filesize = 1, + filedata = "\NUL" + } + ] + print =<< loadAr "test.a" ===================================== testsuite/tests/ghc-api/T26120.stdout ===================================== @@ -0,0 +1,2 @@ +Archive [ArchiveEntry {filename = "1", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "\NUL"}] +Archive [ArchiveEntry {filename = "1", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "\NUL"}] ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -70,3 +70,5 @@ test('T25577', [ extra_run_opts(f'"{config.libdir}"') # support , when(arch('wasm32') or arch('javascript'), skip) ], compile_and_run, ['-package ghc']) + +test('T26120', [], compile_and_run, ['-package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e7c6b4d958f7beb292b503ce2cc25b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e7c6b4d958f7beb292b503ce2cc25b... You're receiving this email because of your account on gitlab.haskell.org.