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 <codex@openai.com>
  

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:

   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) $

+{-# 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"

+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"}]

                # support

                , when(arch('wasm32') or arch('javascript'), skip)

                ], compile_and_run, ['-package ghc'])

+

+test('T26120', [], compile_and_run, ['-package ghc'])