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.
