- ghc-commits - Haskell.org

[Git][ghc/ghc][master] foundation test: skip signed minBound `quot` (-1) (#27222)
by Marge Bot (＠marge-bot) 28 May '26

28 May '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4ce251e4 by Sylvain Henry at 2026-05-28T17:31:39-04:00 foundation test: skip signed minBound `quot` (-1) (#27222) `minBound `quot` (-1)` for fixed-width signed integers is platform dependent: the mathematical result -minBound is not representable in the type. On x86, IDIV traps; LLVM's sdiv is undefined behaviour in this case; on AArch64/RISC-V, SDIV wraps to minBound. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - 2 changed files: - testsuite/tests/MiniQuickCheck.hs - testsuite/tests/numeric/should_run/foundation.hs Changes: ===================================== testsuite/tests/MiniQuickCheck.hs ===================================== @@ -27,6 +27,7 @@ module MiniQuickCheck , (===) , propertyCompare , propertyAnd + , propertyTrue , getCheck -- * QuickCheck test tree @@ -144,6 +145,10 @@ infix 4 === propertyAnd :: PropertyCheck -> PropertyCheck -> PropertyCheck propertyAnd = PropertyAnd +-- | A property check that trivially holds. Useful to mark a case to skip. +propertyTrue :: PropertyCheck +propertyTrue = PropertyBinaryOp True "trivially" "" "" + -------------------------------------------------------------------------------- -- Test tree ===================================== testsuite/tests/numeric/should_run/foundation.hs ===================================== @@ -82,11 +82,10 @@ testMultiplicative _ = Group "Multiplicative" testDivisible :: forall a . (Show a, Eq a, Bounded a, Integral a, Num a, Arbitrary a, Typeable a) => Proxy a -> Test testDivisible _ = Group "Divisible" - [ Property "(x `div` y) * y + (x `mod` y) == x" $ \(a :: a) (NonZero b) -> - -- See Note [Skipping minBound `div` (-1)]. - if (minBound :: a) < 0 && a == minBound && b == (-1) - then True === True - else a === (a `div` b) * b + (a `mod` b) + [ Property "(x `div` y) * y + (x `mod` y) == x" $ + -- 'safeDivArgs' skips (minBound, -1) for signed types; see + -- Note [Skipping signed quot/rem on minBound `quot` (-1)]. + safeDivArgs (\(a :: a) b -> a === (a `div` b) * b + (a `mod` b)) ] -- | Divisibility test for unbounded Integral types (Integer). No overflow @@ -98,21 +97,6 @@ testDivisibleUnbounded _ = Group "Divisible" a === (a `div` b) * b + (a `mod` b) ] --- Note [Skipping minBound `div` (-1)] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- For a fixed-width *signed* Integral type, `minBound `div` (-1)` raises --- ArithException(Overflow) because `-minBound` is not representable in the --- type (e.g., for Int8, `-(-128)` would be 128, out of range). The div/mod --- identity property cannot hold there, so we skip exactly that one pair. --- --- We detect "signed Bounded" with `(minBound :: a) < 0`: True for Int{N}, --- False for Word{N}. This way unsigned Bounded types lose no coverage, --- and only the genuine overflow sample is skipped for signed types. --- --- For the unbounded `Integer`, no overflow can occur and we use a separate --- 'testDivisibleUnbounded' (without the Bounded constraint or the skip). --- See #27222. - testOperatorPrecedence :: forall a . (Show a, Eq a, Prelude.Num a, Integral a, Num a, Arbitrary a, Typeable a) => Proxy a -> Test testOperatorPrecedence _ = Group "Precedence" @@ -263,8 +247,29 @@ instance TestPrimop LowerBitsAreDefined where valR = wWord# (undefinedBehavior r x0) .&. mask in valL === valR -twoNonZero :: (a -> a -> b) -> a -> NonZero a -> b -twoNonZero f x (NonZero y) = f x y +-- | Discharge a property over a non-zero divisor. For signed types, also +-- skip the @(minBound, -1)@ pair, where signed quot/rem is platform +-- dependent. For unsigned types (where @minBound = 0@), no additional skip +-- happens. +-- See Note [Skipping signed quot/rem on minBound `quot` (-1)]. +safeDivArgs + :: (Bounded a, Ord a, Num a) + => (a -> a -> PropertyCheck) + -> a -> NonZero a -> PropertyCheck +safeDivArgs f x (NonZero y) + | x == minBound, x < 0, y == (-1) = propertyTrue + | otherwise = f x y + +-- Note [Skipping signed quot/rem on minBound `quot` (-1)] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- For a fixed-width signed integer type, `minBound `quot` (-1)` is platform +-- dependent: the mathematical result `-minBound` is not representable in the +-- type. On x86, IDIV traps; LLVM's sdiv is undefined behavior in this case; on +-- AArch64/RISC-V, SDIV wraps to minBound. +-- +-- Without the skip quickcheck eventually picks `(minBound, -1)` and the test +-- crashes on the affected primops on platforms where signed quot/rem traps. +-- See #27222. main :: IO () main = runTestsMain (Iterations 1000) (Group "ALL" [testNumberRefs, testPrimops]) @@ -535,7 +540,7 @@ instance TestPrimop (Char# -> Int#) where instance TestPrimop (Int# -> Int# -> Int#) where testPrimop s l r = Property s $ \ (uInt#-> x0) (uInt#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt#-> x0) (uInt#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt#-> x0) (uInt#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) testPrimopShift s l r = Property s $ \ (uInt#-> x0) (BoundedShiftAmount @Int shift) -> wInt# (l x0 (uInt# shift)) === wInt# (r x0 (uInt# shift)) -- | Compare two 'mulIntMayOflo#'-like primops only on whether their result @@ -565,11 +570,11 @@ testPrimopMayOflo s l r = instance TestPrimop (Int# -> Int# -> (# Int#,Int# #)) where testPrimop s l r = Property s $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP2(wInt#,wInt#, (l x0 x1)) === WTUP2(wInt#,wInt#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP2(wInt#,wInt#, (l x0 x1)) === WTUP2(wInt#,wInt#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP2(wInt#,wInt#, (l x0 x1)) === WTUP2(wInt#,wInt#, (r x0 x1)) instance TestPrimop (Int# -> Int# -> (# Int#,Int#,Int# #)) where testPrimop s l r = Property s $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP3(wInt#,wInt#,wInt#, (l x0 x1)) === WTUP3(wInt#,wInt#,wInt#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP3(wInt#,wInt#,wInt#, (l x0 x1)) === WTUP3(wInt#,wInt#,wInt#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt#-> x0) (uInt#-> x1) -> WTUP3(wInt#,wInt#,wInt#, (l x0 x1)) === WTUP3(wInt#,wInt#,wInt#, (r x0 x1)) instance TestPrimop (Int# -> Char#) where testPrimop s l r = Property s $ \ (uInt#-> x0) -> wChar# (l x0) === wChar# (r x0) @@ -598,15 +603,15 @@ instance TestPrimop (Int16# -> Int# -> Int16#) where instance TestPrimop (Int16# -> Int16# -> Int#) where testPrimop s l r = Property s $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) instance TestPrimop (Int16# -> Int16# -> Int16#) where testPrimop s l r = Property s $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt16# (l x0 x1) === wInt16# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt16# (l x0 x1) === wInt16# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt16#-> x0) (uInt16#-> x1) -> wInt16# (l x0 x1) === wInt16# (r x0 x1) instance TestPrimop (Int16# -> Int16# -> (# Int16#,Int16# #)) where testPrimop s l r = Property s $ \ (uInt16#-> x0) (uInt16#-> x1) -> WTUP2(wInt16#,wInt16#, (l x0 x1)) === WTUP2(wInt16#,wInt16#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt16#-> x0) (uInt16#-> x1) -> WTUP2(wInt16#,wInt16#, (l x0 x1)) === WTUP2(wInt16#,wInt16#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt16#-> x0) (uInt16#-> x1) -> WTUP2(wInt16#,wInt16#, (l x0 x1)) === WTUP2(wInt16#,wInt16#, (r x0 x1)) instance TestPrimop (Int16# -> Int#) where testPrimop s l r = Property s $ \ (uInt16#-> x0) -> wInt# (l x0) === wInt# (r x0) @@ -623,15 +628,15 @@ instance TestPrimop (Int32# -> Int# -> Int32#) where instance TestPrimop (Int32# -> Int32# -> Int#) where testPrimop s l r = Property s $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) instance TestPrimop (Int32# -> Int32# -> Int32#) where testPrimop s l r = Property s $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt32# (l x0 x1) === wInt32# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt32# (l x0 x1) === wInt32# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt32#-> x0) (uInt32#-> x1) -> wInt32# (l x0 x1) === wInt32# (r x0 x1) instance TestPrimop (Int32# -> Int32# -> (# Int32#,Int32# #)) where testPrimop s l r = Property s $ \ (uInt32#-> x0) (uInt32#-> x1) -> WTUP2(wInt32#,wInt32#, (l x0 x1)) === WTUP2(wInt32#,wInt32#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt32#-> x0) (uInt32#-> x1) -> WTUP2(wInt32#,wInt32#, (l x0 x1)) === WTUP2(wInt32#,wInt32#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt32#-> x0) (uInt32#-> x1) -> WTUP2(wInt32#,wInt32#, (l x0 x1)) === WTUP2(wInt32#,wInt32#, (r x0 x1)) instance TestPrimop (Int32# -> Int#) where testPrimop s l r = Property s $ \ (uInt32#-> x0) -> wInt# (l x0) === wInt# (r x0) @@ -648,11 +653,11 @@ instance TestPrimop (Int64# -> Int# -> Int64#) where instance TestPrimop (Int64# -> Int64# -> Int#) where testPrimop s l r = Property s $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) instance TestPrimop (Int64# -> Int64# -> Int64#) where testPrimop s l r = Property s $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt64# (l x0 x1) === wInt64# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt64# (l x0 x1) === wInt64# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt64#-> x0) (uInt64#-> x1) -> wInt64# (l x0 x1) === wInt64# (r x0 x1) instance TestPrimop (Int64# -> Int#) where testPrimop s l r = Property s $ \ (uInt64#-> x0) -> wInt# (l x0) === wInt# (r x0) @@ -669,15 +674,15 @@ instance TestPrimop (Int8# -> Int# -> Int8#) where instance TestPrimop (Int8# -> Int8# -> Int#) where testPrimop s l r = Property s $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) instance TestPrimop (Int8# -> Int8# -> Int8#) where testPrimop s l r = Property s $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt8# (l x0 x1) === wInt8# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt8# (l x0 x1) === wInt8# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt8#-> x0) (uInt8#-> x1) -> wInt8# (l x0 x1) === wInt8# (r x0 x1) instance TestPrimop (Int8# -> Int8# -> (# Int8#,Int8# #)) where testPrimop s l r = Property s $ \ (uInt8#-> x0) (uInt8#-> x1) -> WTUP2(wInt8#,wInt8#, (l x0 x1)) === WTUP2(wInt8#,wInt8#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uInt8#-> x0) (uInt8#-> x1) -> WTUP2(wInt8#,wInt8#, (l x0 x1)) === WTUP2(wInt8#,wInt8#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uInt8#-> x0) (uInt8#-> x1) -> WTUP2(wInt8#,wInt8#, (l x0 x1)) === WTUP2(wInt8#,wInt8#, (r x0 x1)) instance TestPrimop (Int8# -> Int#) where testPrimop s l r = Property s $ \ (uInt8#-> x0) -> wInt# (l x0) === wInt# (r x0) @@ -694,19 +699,19 @@ instance TestPrimop (Word# -> Int# -> Word#) where instance TestPrimop (Word# -> Word# -> Int#) where testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord#-> x0) (uWord#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord#-> x0) (uWord#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) instance TestPrimop (Word# -> Word# -> Word#) where testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) -> wWord# (l x0 x1) === wWord# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord#-> x0) (uWord#-> x1) -> wWord# (l x0 x1) === wWord# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord#-> x0) (uWord#-> x1) -> wWord# (l x0 x1) === wWord# (r x0 x1) instance TestPrimop (Word# -> Word# -> (# Word#,Int# #)) where testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wInt#, (l x0 x1)) === WTUP2(wWord#,wInt#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wInt#, (l x0 x1)) === WTUP2(wWord#,wInt#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wInt#, (l x0 x1)) === WTUP2(wWord#,wInt#, (r x0 x1)) instance TestPrimop (Word# -> Word# -> (# Word#,Word# #)) where testPrimop s l r = Property s $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wWord#, (l x0 x1)) === WTUP2(wWord#,wWord#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wWord#, (l x0 x1)) === WTUP2(wWord#,wWord#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord#-> x0) (uWord#-> x1) -> WTUP2(wWord#,wWord#, (l x0 x1)) === WTUP2(wWord#,wWord#, (r x0 x1)) instance TestPrimop (Word# -> Int#) where testPrimop s l r = Property s $ \ (uWord#-> x0) -> wInt# (l x0) === wInt# (r x0) @@ -732,15 +737,15 @@ instance TestPrimop (Word16# -> Int# -> Word16#) where instance TestPrimop (Word16# -> Word16# -> Int#) where testPrimop s l r = Property s $ \ (uWord16#-> x0) (uWord16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord16#-> x0) (uWord16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord16#-> x0) (uWord16#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) instance TestPrimop (Word16# -> Word16# -> Word16#) where testPrimop s l r = Property s $ \ (uWord16#-> x0) (uWord16#-> x1) -> wWord16# (l x0 x1) === wWord16# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord16#-> x0) (uWord16#-> x1) -> wWord16# (l x0 x1) === wWord16# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord16#-> x0) (uWord16#-> x1) -> wWord16# (l x0 x1) === wWord16# (r x0 x1) instance TestPrimop (Word16# -> Word16# -> (# Word16#,Word16# #)) where testPrimop s l r = Property s $ \ (uWord16#-> x0) (uWord16#-> x1) -> WTUP2(wWord16#,wWord16#, (l x0 x1)) === WTUP2(wWord16#,wWord16#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord16#-> x0) (uWord16#-> x1) -> WTUP2(wWord16#,wWord16#, (l x0 x1)) === WTUP2(wWord16#,wWord16#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord16#-> x0) (uWord16#-> x1) -> WTUP2(wWord16#,wWord16#, (l x0 x1)) === WTUP2(wWord16#,wWord16#, (r x0 x1)) instance TestPrimop (Word16# -> Int16#) where testPrimop s l r = Property s $ \ (uWord16#-> x0) -> wInt16# (l x0) === wInt16# (r x0) @@ -757,15 +762,15 @@ instance TestPrimop (Word32# -> Int# -> Word32#) where instance TestPrimop (Word32# -> Word32# -> Int#) where testPrimop s l r = Property s $ \ (uWord32#-> x0) (uWord32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord32#-> x0) (uWord32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord32#-> x0) (uWord32#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) instance TestPrimop (Word32# -> Word32# -> Word32#) where testPrimop s l r = Property s $ \ (uWord32#-> x0) (uWord32#-> x1) -> wWord32# (l x0 x1) === wWord32# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord32#-> x0) (uWord32#-> x1) -> wWord32# (l x0 x1) === wWord32# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord32#-> x0) (uWord32#-> x1) -> wWord32# (l x0 x1) === wWord32# (r x0 x1) instance TestPrimop (Word32# -> Word32# -> (# Word32#,Word32# #)) where testPrimop s l r = Property s $ \ (uWord32#-> x0) (uWord32#-> x1) -> WTUP2(wWord32#,wWord32#, (l x0 x1)) === WTUP2(wWord32#,wWord32#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord32#-> x0) (uWord32#-> x1) -> WTUP2(wWord32#,wWord32#, (l x0 x1)) === WTUP2(wWord32#,wWord32#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord32#-> x0) (uWord32#-> x1) -> WTUP2(wWord32#,wWord32#, (l x0 x1)) === WTUP2(wWord32#,wWord32#, (r x0 x1)) instance TestPrimop (Word32# -> Int32#) where testPrimop s l r = Property s $ \ (uWord32#-> x0) -> wInt32# (l x0) === wInt32# (r x0) @@ -782,11 +787,11 @@ instance TestPrimop (Word64# -> Int# -> Word64#) where instance TestPrimop (Word64# -> Word64# -> Int#) where testPrimop s l r = Property s $ \ (uWord64#-> x0) (uWord64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord64#-> x0) (uWord64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord64#-> x0) (uWord64#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) instance TestPrimop (Word64# -> Word64# -> Word64#) where testPrimop s l r = Property s $ \ (uWord64#-> x0) (uWord64#-> x1) -> wWord64# (l x0 x1) === wWord64# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord64#-> x0) (uWord64#-> x1) -> wWord64# (l x0 x1) === wWord64# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord64#-> x0) (uWord64#-> x1) -> wWord64# (l x0 x1) === wWord64# (r x0 x1) instance TestPrimop (Word64# -> Int64#) where testPrimop s l r = Property s $ \ (uWord64#-> x0) -> wInt64# (l x0) === wInt64# (r x0) @@ -803,15 +808,15 @@ instance TestPrimop (Word8# -> Int# -> Word8#) where instance TestPrimop (Word8# -> Word8# -> Int#) where testPrimop s l r = Property s $ \ (uWord8#-> x0) (uWord8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord8#-> x0) (uWord8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord8#-> x0) (uWord8#-> x1) -> wInt# (l x0 x1) === wInt# (r x0 x1) instance TestPrimop (Word8# -> Word8# -> Word8#) where testPrimop s l r = Property s $ \ (uWord8#-> x0) (uWord8#-> x1) -> wWord8# (l x0 x1) === wWord8# (r x0 x1) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord8#-> x0) (uWord8#-> x1) -> wWord8# (l x0 x1) === wWord8# (r x0 x1) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord8#-> x0) (uWord8#-> x1) -> wWord8# (l x0 x1) === wWord8# (r x0 x1) instance TestPrimop (Word8# -> Word8# -> (# Word8#,Word8# #)) where testPrimop s l r = Property s $ \ (uWord8#-> x0) (uWord8#-> x1) -> WTUP2(wWord8#,wWord8#, (l x0 x1)) === WTUP2(wWord8#,wWord8#, (r x0 x1)) - testPrimopDivLike s l r = Property s $ twoNonZero $ \ (uWord8#-> x0) (uWord8#-> x1) -> WTUP2(wWord8#,wWord8#, (l x0 x1)) === WTUP2(wWord8#,wWord8#, (r x0 x1)) + testPrimopDivLike s l r = Property s $ safeDivArgs $ \ (uWord8#-> x0) (uWord8#-> x1) -> WTUP2(wWord8#,wWord8#, (l x0 x1)) === WTUP2(wWord8#,wWord8#, (r x0 x1)) instance TestPrimop (Word8# -> Int8#) where testPrimop s l r = Property s $ \ (uWord8#-> x0) -> wInt8# (l x0) === wInt8# (r x0) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ce251e48cd03bb856437d2c8794fa6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ce251e48cd03bb856437d2c8794fa6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: Add optional config setting for LibDir (#19174)
by Marge Bot (＠marge-bot) 28 May '26

28 May '26

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ed29a5e6 by Sven Tennie at 2026-05-28T17:30:36-04:00 Add optional config setting for LibDir (#19174) Previously, the `libDir` was derived from `topDir`. This won't work for inplace stage2 cross-compilers where binaries and libraries are in different stage dirs (`_build/stage1/` for executables and `_build/stage2` for libraries). `LibDir` is set in the inplace `settings` files. For bindists, we generate a new `settings` file with no `LibDir` entry. GHC then defaults to use `topDir` as `libDir` again. This keeps the bindist relocatable. If `LibDir` is a relative path, it is interpreted relatively to `topDir`. The global package db is part of the `lib/` folder. If we want to point for inplace cross-compilers to the succeeding stage's folder, this is done by setting `LibDir`. Thus, the global package db must be found relative to `libDir`` (which may default to `topDir` or be set by `LibDir`). The complexity of settings becomes scary. So, add a test to ensure `LibDir` works as expected. - - - - - 8339cf8f by Sven Tennie at 2026-05-28T17:30:36-04:00 Add Haddock to FileSettings Helping to understand the fields' meanings without deeper analyses. - - - - - 12 changed files: - + changelog.d/libdir-setting - compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - libraries/ghc-boot/GHC/Settings/Utils.hs - + testsuite/tests/ghc-api/settings/LibDir.hs - + testsuite/tests/ghc-api/settings/LibDir.stdout - + testsuite/tests/ghc-api/settings/all.T Changes: ===================================== changelog.d/libdir-setting ===================================== @@ -0,0 +1,18 @@ +section: packaging +synopsis: Added a new optional configuration setting for `LibDir` to support inplace + stage2 cross-compilers where binaries and libraries are in different stage + directories. +issues: #19174 +mrs: !15716 + +description: { + Previously, `libDir` was always derived from `topDir`, which does not work + for inplace stage2 cross-compilers where executables live in `_build/stage1/` + but libraries live in `_build/stage2/`. A new optional `LibDir` setting in the + `settings` file allows overriding this. When absent (e.g. in bindists), + `libDir` defaults to `topDir`, preserving relocatability. + + The global package database path is now resolved relative to `libDir` + (which may differ from `topDir` when `LibDir` is set). This affects inplace + cross-compiler builds but is transparent to normal and bindist builds. +} ===================================== compiler/GHC/Driver/Config/Interpreter.hs ===================================== @@ -17,8 +17,8 @@ import System.Directory initInterpOpts :: DynFlags -> IO InterpOpts initInterpOpts dflags = do - wasm_dyld <- makeAbsolute $ topDir dflags </> "dyld.mjs" - js_interp <- makeAbsolute $ topDir dflags </> "ghc-interp.js" + wasm_dyld <- makeAbsolute $ libDir dflags </> "dyld.mjs" + js_interp <- makeAbsolute $ libDir dflags </> "ghc-interp.js" pure $ InterpOpts { interpExternal = gopt Opt_ExternalInterpreter dflags , interpProg = pgm_i dflags ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Driver.DynFlags ( -- ** System tool settings and locations programName, projectVersion, - ghcUsagePath, ghciUsagePath, topDir, toolDir, + ghcUsagePath, ghciUsagePath, topDir, libDir, toolDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, @@ -1516,6 +1516,8 @@ ghciUsagePath :: DynFlags -> FilePath ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags topDir :: DynFlags -> FilePath topDir dflags = fileSettings_topDir $ fileSettings dflags +libDir :: DynFlags -> FilePath +libDir dflags = fileSettings_libDir $ fileSettings dflags toolDir :: DynFlags -> Maybe FilePath toolDir dflags = fileSettings_toolDir $ fileSettings dflags extraGccViaCFlags :: DynFlags -> [String] ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3551,9 +3551,9 @@ compilerInfo dflags ("Project name", cProjectName) -- Next come the settings, so anything else can be overridden -- in the settings file (as "lookup" uses the first match for the - -- key) + -- key). We filter out LibDir from rawSettings to avoid duplication. : map (fmap expandDirectories) - (rawSettings dflags) + (filter ((/= "LibDir") . fst) (rawSettings dflags)) ++ [("C compiler command", queryCmd $ ccProgram . tgtCCompiler), ("C compiler flags", queryFlags $ ccProgram . tgtCCompiler), @@ -3656,7 +3656,7 @@ compilerInfo dflags -- Whether or not GHC was compiled using -prof ("GHC Profiled", showBool hostIsProfiled), ("Debug on", showBool debugIsOn), - ("LibDir", topDir dflags), + ("LibDir", libDir dflags), -- This is always an absolute path, unlike "Relative Global Package DB" which is -- in the settings file. ("Global Package DB", globalPackageDatabasePath dflags) ===================================== compiler/GHC/Settings.hs ===================================== @@ -179,11 +179,24 @@ data ToolSettings = ToolSettings -- | Paths to various files and directories used by GHC, including those that -- provide more settings. data FileSettings = FileSettings - { fileSettings_ghcUsagePath :: FilePath -- ditto - , fileSettings_ghciUsagePath :: FilePath -- ditto - , fileSettings_toolDir :: Maybe FilePath -- ditto - , fileSettings_topDir :: FilePath -- ditto + { fileSettings_ghcUsagePath :: FilePath + -- ^ Path to @ghc-usage.txt@, displayed by @ghc --help@ + , fileSettings_ghciUsagePath :: FilePath + -- ^ Path to @ghci-usage.txt@, displayed by @ghci --help@ + , fileSettings_toolDir :: Maybe FilePath + -- ^ Directory containing the mingw toolchain (Windows only); + -- see Note [tooldir: How GHC finds mingw on Windows] in `GHC.SysTools.BaseDir` + , fileSettings_topDir :: FilePath + -- ^ GHC's top directory: the root from which GHC locates its support files + -- (e.g. settings). + -- See Note [topdir: How GHC finds its files] in `GHC.SysTools.BaseDir` , fileSettings_globalPackageDatabase :: FilePath + -- ^ Path to the global package database, relative to `libDir` + , fileSettings_libDir :: FilePath + -- ^ Directory containing GHC's library packages and the global package + -- database. Defaults to 'fileSettings_topDir' but can differ in inplace + -- builds used for cross-compilation testing (the "stage2 cross-compiler" + -- scenario). } ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -28,6 +28,7 @@ import GHC.Toolchain.Program import GHC.Toolchain import GHC.Data.Maybe import Data.Bifunctor (Bifunctor(second)) +import Data.Either (fromRight) data SettingsError = SettingsError_MissingData String @@ -117,12 +118,6 @@ initSettings top_dir = do then ["-fwrapv", "-fno-builtin"] else [] - -- The package database is either a relative path to the location of the settings file - -- OR an absolute path. - -- In case the path is absolute then top_dir </> abs_path == abs_path - -- the path is relative then top_dir </> rel_path == top_dir </> rel_path - globalpkgdb_path <- installed <$> getSetting "Relative Global Package DB" - let ghc_usage_msg_path = installed "ghc-usage.txt" ghci_usage_msg_path = installed "ghci-usage.txt" @@ -148,6 +143,19 @@ initSettings top_dir = do baseUnitId <- getSetting_raw "base unit-id" + -- LibDir is optional. If not set, derive it from topDir. This allows + -- bindists to work without explicitly setting LibDir, but gives us the + -- option to override it for inplace test compilers (the "stage2 + -- cross-compiler" scenario). If LibDir is a relative path, it is + -- interpreted relative to topDir. + let lib_dir = installed $ fromRight "." $ + getRawFilePathSetting top_dir settingsFile mySettings "LibDir" + + -- The package database is either a relative path to lib_dir OR an absolute path. + -- In case the path is absolute then lib_dir </> abs_path == abs_path + -- the path is relative then lib_dir </> rel_path == lib_dir </> rel_path + globalpkgdb_path <- (lib_dir </>) <$> getSetting "Relative Global Package DB" + return $ Settings { sGhcNameVersion = GhcNameVersion { ghcNameVersion_programName = "ghc" @@ -159,6 +167,7 @@ initSettings top_dir = do , fileSettings_ghciUsagePath = ghci_usage_msg_path , fileSettings_toolDir = mtool_dir , fileSettings_topDir = top_dir + , fileSettings_libDir = lib_dir , fileSettings_globalPackageDatabase = globalpkgdb_path } ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -14,6 +14,7 @@ import qualified System.Directory.Extra as IO import Data.Either import qualified Data.Set as Set import Oracles.Flavour +import Rules.Generate (generateSettings) {- Note [Binary distributions] @@ -218,6 +219,17 @@ bindistRules = do IO.createFileLink version_prog versioned_runhaskell_path copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir + + -- Regenerate settings file without LibDir. For bindists, LibDir should + -- be derived from topdir at runtime such that the GHC binary is + -- relocatable. The package DB is always at "package.conf.d" relative to + -- the lib dir, matching the known bindist layout. + let bindistSettings = bindistFilesDir -/- "lib" -/- "settings" + bindistContext = vanillaContext Stage1 compiler + bindistSettingsContent <- interpretInContext bindistContext $ + generateSettings bindistSettings False "package.conf.d" + writeFile' bindistSettings bindistSettingsContent + copyDirectory (rtsIncludeDir) bindistFilesDir when windowsHost $ createGhcii (bindistFilesDir -/- "bin") ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -1,7 +1,7 @@ module Rules.Generate ( isGeneratedCmmFile, compilerDependencies, generatePackageCode, generateRules, copyRules, generatedDependencies, - templateRules + templateRules, generateSettings ) where import Development.Shake.FilePath @@ -256,8 +256,21 @@ generateRules = do forM_ allStages $ \stage -> do let prefix = root -/- stageString stage -/- "lib" - go gen file = generate file (semiEmptyTarget (succStage stage)) gen - (prefix -/- "settings") %> \out -> go (generateSettings out) out + -- Stage0 compiler builds Stage1, Stage1 -> Stage2, etc. + buildStage = succStage stage + go gen file = generate file (semiEmptyTarget buildStage) gen + (prefix -/- "settings") %> \out -> do + let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final) + pkgDb <- case buildStage of + Stage0 {} -> error "Unable to generate settings for stage0. This should never be reached." + Stage1 -> get_pkg_db Stage1 + Stage2 -> get_pkg_db Stage1 + Stage3 -> get_pkg_db Stage2 + -- addTrailingPathSeparator needed: makeRelativeNoSysLink uses + -- splitPath where "lib" and "lib/" are distinct components. + let lib_topDir = addTrailingPathSeparator prefix + relPkgDb = makeRelativeNoSysLink lib_topDir pkgDb + go (generateSettings out True relPkgDb) out (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr getTargetTarget) out where @@ -460,19 +473,17 @@ ghcWrapper stage = do return $ unwords $ map show $ [ ghcPath ] ++ [ "$@" ] -generateSettings :: FilePath -> Expr String -generateSettings settingsFile = do +-- | Generate settings file, optionally including @LibDir@. +-- +-- @rel_pkg_db@: package DB path relative to the lib dir (e.g. +-- "package.conf.d"). Callers supply the correct relative path. For bindists +-- the layout is known statically; for in-tree builds callers compute it. For +-- bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime. +generateSettings :: FilePath -> Bool -> FilePath -> Expr String +generateSettings settingsFile includeLibDir rel_pkg_db = do ctx <- getContext stage <- getStage - package_db_path <- expr $ do - let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final) - case stage of - Stage0 {} -> error "Unable to generate settings for stage0" - Stage1 -> get_pkg_db Stage1 - Stage2 -> get_pkg_db Stage1 - Stage3 -> get_pkg_db Stage2 - -- The unit-id of the base package which is always linked against (#25382) base_unit_id <- expr $ do case stage of @@ -481,15 +492,24 @@ generateSettings settingsFile = do Stage2 -> pkgUnitId Stage1 base Stage3 -> pkgUnitId Stage2 base - let rel_pkg_db = makeRelativeNoSysLink (dropFileName settingsFile) package_db_path + let -- E.g. the Stage2 compiler lives in _build/stage1 + -- So, we need to decrement the stage to get the correct directory + stage_dir_stage = predStage stage + + -- addTrailingPathSeparator is needed because makeRelativeNoSysLink uses + -- splitPath internally, where "lib" and "lib/" are distinct components. + lib_topDir :: FilePath <- expr $ addTrailingPathSeparator <$> stageLibPath stage_dir_stage + let rel_lib_topDir = makeRelativeNoSysLink (dropFileName settingsFile) lib_topDir settings <- traverse sequence $ - [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) - , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) - , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) - , ("Relative Global Package DB", pure rel_pkg_db) - , ("base unit-id", pure base_unit_id) - ] + [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) + , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) + , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) + , ("Relative Global Package DB", pure rel_pkg_db) + , ("base unit-id", pure base_unit_id) + ] + ++ ([("LibDir", pure rel_lib_topDir) | includeLibDir]) + let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" pure $ case settings of [] -> "[]" ===================================== libraries/ghc-boot/GHC/Settings/Utils.hs ===================================== @@ -3,6 +3,7 @@ module GHC.Settings.Utils where import Prelude -- See Note [Why do we import Prelude here?] import Data.Char (isSpace) +import Data.Either (fromRight) import Data.Map (Map) import qualified Data.Map as Map @@ -45,7 +46,10 @@ getTargetArchOS target = tgtArchOs target getGlobalPackageDb :: FilePath -> RawSettings -> Either String FilePath getGlobalPackageDb settingsFile settings = do rel_db <- getRawSetting settingsFile settings "Relative Global Package DB" - return (dropFileName settingsFile </> rel_db) + let top_dir = dropFileName settingsFile + lib_dir = (top_dir </>) $ fromRight "." $ + getRawFilePathSetting top_dir settingsFile settings "LibDir" + return (lib_dir </> rel_db) -------------------------------------------------------------------------------- -- lib/settings ===================================== testsuite/tests/ghc-api/settings/LibDir.hs ===================================== @@ -0,0 +1,130 @@ +module Main where + +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) +import Data.List (intercalate) +import GHC +import GHC.Driver.DynFlags +import GHC.Driver.Env (hsc_dflags) +import GHC.Settings +import System.Directory +import System.Environment +import System.Exit (ExitCode (ExitFailure), exitWith) +import System.FilePath +import System.IO (hPutStrLn, stderr) +import System.Process (readProcess) +import Unsafe.Coerce (unsafeCoerce) + +-- Verify that a LibDir setting in the settings file is respected: +-- 1. fileSettings_libDir and fileSettings_globalPackageDatabase reflect the +-- configured LibDir path (not topDir) +-- 2. GHC can still compile with a LibDir that differs from topDir +-- 3. --print-libdir and --print-global-package-db output the correct paths +-- +-- We create a symlink to the real lib dir so that the package DB remains +-- findable, but use a separate topDir so that topDir ≠ libDir, proving +-- the LibDir setting is actually used. +-- +-- Tested for both relative and absolute LibDir values. +main :: IO () +main = do + libdir : ghcBin : _ <- getArgs + + (rawSettingOpts, rawTargetOpts, realLibDir) <- runGhc (Just libdir) $ do + dflags <- hsc_dflags <$> getSession + pure (rawSettings dflags, rawTarget dflags, fileSettings_libDir (fileSettings dflags)) + + tmpDir <- getTemporaryDirectory + let topDir = tmpDir </> "T19174_top" + symlinkLib = tmpDir </> "T19174_lib" + -- Remove stale dirs from prior runs; createDirectoryLink fails if path exists. + removePathForcibly topDir + removePathForcibly symlinkLib + createDirectoryIfMissing True (topDir </> "targets") + createDirectoryLink realLibDir symlinkLib + + let testWithLibDir libDirValue = do + writeTopDirFiles topDir rawSettingOpts rawTargetOpts libDirValue + runGhc (Just topDir) $ do + assertSettings topDir symlinkLib + compileAndRunTestExpr + assertGhcFlags ghcBin topDir symlinkLib + + testWithLibDir (".." </> takeFileName symlinkLib) + testWithLibDir symlinkLib + + putStrLn "OK" + +writeTopDirFiles :: + (Show a) => + FilePath -> + [(String, String)] -> + a -> + String -> + IO () +writeTopDirFiles topDir rawSettingOpts rawTargetOpts libDirValue = do + let settings = filter ((/= "LibDir") . fst) rawSettingOpts ++ [("LibDir", libDirValue)] + writeFile (topDir </> "settings") $ + "[" ++ intercalate "\n," (map show settings) ++ "]" + writeFile (topDir </> "targets" </> "default.target") $ + show rawTargetOpts + +assertSettings :: FilePath -> FilePath -> Ghc () +assertSettings topDir expectedLib = do + dflags <- hsc_dflags <$> getSession + let fs = fileSettings dflags + actualLib = fileSettings_libDir fs + actualPkgDb = fileSettings_globalPackageDatabase fs + normActualLib <- liftIO $ canonicalizePath actualLib + normExpected <- liftIO $ canonicalizePath expectedLib + normTopDir <- liftIO $ canonicalizePath topDir + normActualPkgDb <- liftIO $ canonicalizePath actualPkgDb + normExpectedPkgDb <- liftIO $ canonicalizePath (expectedLib </> "package.conf.d") + liftIO $ do + when (normActualLib /= normExpected) $ + die + [ "FAIL: libDir should be " ++ normExpected, + " got " ++ normActualLib + ] + when (normActualLib == normTopDir) $ + die ["FAIL: libDir equals topDir — LibDir setting was ignored"] + when (normActualPkgDb /= normExpectedPkgDb) $ + die + [ "FAIL: globalPackageDB should be " ++ normExpectedPkgDb, + " got " ++ normActualPkgDb + ] + +assertGhcFlags :: FilePath -> FilePath -> FilePath -> IO () +assertGhcFlags ghcBin topDir expectedLib = do + normExpectedLib <- canonicalizePath expectedLib + normExpectedPkgDb <- canonicalizePath (expectedLib </> "package.conf.d") + + printedLibDir <- trim <$> readProcess ghcBin ["-B" ++ topDir, "--print-libdir"] "" + normPrintedLib <- canonicalizePath printedLibDir + when (normPrintedLib /= normExpectedLib) $ + die + [ "FAIL: --print-libdir should be " ++ normExpectedLib, + " got " ++ normPrintedLib + ] + + printedPkgDb <- trim <$> readProcess ghcBin ["-B" ++ topDir, "--print-global-package-db"] "" + normPrintedPkgDb <- canonicalizePath printedPkgDb + when (normPrintedPkgDb /= normExpectedPkgDb) $ + die + [ "FAIL: --print-global-package-db should be " ++ normExpectedPkgDb, + " got " ++ normPrintedPkgDb + ] + +compileAndRunTestExpr :: Ghc () +compileAndRunTestExpr = do + dflags <- getSessionDynFlags + _ <- setSessionDynFlags dflags + setContext [IIDecl (simpleImportDecl (mkModuleName "Prelude"))] + result <- compileExpr "length [1,2,3 :: Int]" + liftIO $ print (unsafeCoerce result :: Int) + +trim :: String -> String +trim = reverse . dropWhile (== '\n') . reverse + +die :: [String] -> IO () +die msgs = mapM_ (hPutStrLn stderr) msgs >> exitWith (ExitFailure 1) ===================================== testsuite/tests/ghc-api/settings/LibDir.stdout ===================================== @@ -0,0 +1,3 @@ +3 +3 +OK ===================================== testsuite/tests/ghc-api/settings/all.T ===================================== @@ -0,0 +1,12 @@ +test('LibDir', + [ extra_run_opts('"' + config.libdir + '" "' + config.compiler + '"') + , req_interp + # createDirectoryLink uses CreateSymbolicLink on Windows (requires developer + # mode or admin); also GHC searches for mingw relative to topDir, which our + # artificial topDir doesn't provide. + , when(opsys('mingw32'), skip) + # TODO: wasm CI image lacks permission to create symlinks in temp dir (`/tmp`). + , when(arch('wasm32'), skip) + ] + , compile_and_run + , ['-package ghc -package directory -package filepath']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f4fbb5832f210f7e1240f626880ad7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f4fbb5832f210f7e1240f626880ad7… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/int-index/visible-forall-gadts
by Vladislav Zavialov (＠int-index) 28 May '26

28 May '26

Vladislav Zavialov deleted branch wip/int-index/visible-forall-gadts at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/int-index/t25960
by Vladislav Zavialov (＠int-index) 28 May '26

28 May '26

Vladislav Zavialov deleted branch wip/int-index/t25960 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/int-index/retry-tyclds-tests
by Vladislav Zavialov (＠int-index) 28 May '26

28 May '26

Vladislav Zavialov deleted branch wip/int-index/retry-tyclds-tests at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/int-index/retry-tyclds
by Vladislav Zavialov (＠int-index) 28 May '26

28 May '26

Vladislav Zavialov deleted branch wip/int-index/retry-tyclds at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/int-index/list-tuple-cleanup
by Vladislav Zavialov (＠int-index) 28 May '26

28 May '26

Vladislav Zavialov deleted branch wip/int-index/list-tuple-cleanup at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/int-index/visargs-errmsg
by Vladislav Zavialov (＠int-index) 28 May '26

28 May '26

Vladislav Zavialov deleted branch wip/int-index/visargs-errmsg at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Deleted branch wip/jeltsch/module-graph-reuse-in-downsweep
by Wolfgang Jeltsch (＠jeltsch) 28 May '26

28 May '26

Wolfgang Jeltsch deleted branch wip/jeltsch/module-graph-reuse-in-downsweep at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Fixes for black holes
by Marge Bot (＠marge-bot) 28 May '26

28 May '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 63ce5770 by Luite Stegeman at 2026-05-28T12:23:35-04:00 Fixes for black holes - suspend duplicate work for eager black holes - detect eager black holes in checkBlockingQueues - don't overwrite existing black holes even if they're not in an eager blackhole frame - don't deadlock on self when thunk is already blackholed Fixes #26936 - - - - - 037a80dc by Tom McLaughlin at 2026-05-28T12:24:36-04:00 Event/Windows.hsc: rethrow exceptions in overlapped IO This prevents the WinIO manager from swallowing exceptions in overlapped IO. It was added to make WinIO support possible in the `network` library. See https://gitlab.haskell.org/ghc/ghc/-/issues/27283. We also bump __IO_MANAGER_WINIO__ to 2 so libraries can gate on this using CPP. - - - - - 2d53bcdb by Wolfgang Jeltsch at 2026-05-28T12:25:21-04:00 Allow `downsweep` to use nodes of an existing module graph To this end, `downsweep` has not been able to use the nodes of a module graph obtained from a previous downsweeping round. In some GHC API applications, downsweeping is performed somewhat incrementally and therefore could profit from reusing such existing results. This contribution makes this possible. Resolves #27054. Co-authored-by: Matthew Pickering <matthewtpickering(a)gmail.com> - - - - - f4fbb583 by Simon Jakobi at 2026-05-28T12:26:04-04:00 Add regression test for T11226 Closes #11226. - - - - - 77e3e730 by Sven Tennie at 2026-05-28T12:59:43-04:00 Add optional config setting for LibDir (#19174) Previously, the `libDir` was derived from `topDir`. This won't work for inplace stage2 cross-compilers where binaries and libraries are in different stage dirs (`_build/stage1/` for executables and `_build/stage2` for libraries). `LibDir` is set in the inplace `settings` files. For bindists, we generate a new `settings` file with no `LibDir` entry. GHC then defaults to use `topDir` as `libDir` again. This keeps the bindist relocatable. If `LibDir` is a relative path, it is interpreted relatively to `topDir`. The global package db is part of the `lib/` folder. If we want to point for inplace cross-compilers to the succeeding stage's folder, this is done by setting `LibDir`. Thus, the global package db must be found relative to `libDir`` (which may default to `topDir` or be set by `LibDir`). The complexity of settings becomes scary. So, add a test to ensure `LibDir` works as expected. - - - - - e9dd0c29 by Sven Tennie at 2026-05-28T12:59:43-04:00 Add Haddock to FileSettings Helping to understand the fields' meanings without deeper analyses. - - - - - 557fe08d by Sylvain Henry at 2026-05-28T13:00:06-04:00 foundation test: skip signed minBound `quot` (-1) (#27222) `minBound `quot` (-1)` for fixed-width signed integers is platform dependent: the mathematical result -minBound is not representable in the type. On x86, IDIV traps; LLVM's sdiv is undefined behaviour in this case; on AArch64/RISC-V, SDIV wraps to minBound. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com> - - - - - f6730aa3 by Simon Jakobi at 2026-05-28T13:00:07-04:00 Prevent dictionary-passing in checkTyEqRhs ...by pre-specializing it to TcM. Previously, wherever checkTyEqRhs was used in other modules, the Core showed dictionary passing ($fMonadIOEnv). The added SPECIALIZE pragma prevents this. - - - - - 43 changed files: - + changelog.d/fix-blackhole-handling - + changelog.d/libdir-setting - + changelog.d/module-graph-reuse-in-downsweep - + changelog.d/windows-rethrow-overlapped-exception - compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/Tc/Utils/Unify.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - libraries/ghc-boot/GHC/Settings/Utils.hs - libraries/ghc-internal/src/GHC/Internal/Event/Windows.hsc - rts/Messages.c - rts/ThreadPaused.c - rts/Threads.c - rts/Updates.h - rts/include/rts/storage/ClosureMacros.h - testsuite/tests/MiniQuickCheck.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/A.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/B.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/C.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/D.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/X.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Y.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.modules/Z.hs - + testsuite/tests/ghc-api/downsweep/IncrementalDownsweep.stdout - testsuite/tests/ghc-api/downsweep/OldModLocation.hs - testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs - testsuite/tests/ghc-api/downsweep/all.T - testsuite/tests/ghc-api/fixed-nodes/InterfaceModuleGraph.hs - + testsuite/tests/ghc-api/settings/LibDir.hs - + testsuite/tests/ghc-api/settings/LibDir.stdout - + testsuite/tests/ghc-api/settings/all.T - testsuite/tests/numeric/should_run/foundation.hs - + testsuite/tests/perf/should_run/T11226.hs - + testsuite/tests/perf/should_run/T11226.stdout - testsuite/tests/perf/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9aef29732fd529eb8d5278c1ebc3f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9aef29732fd529eb8d5278c1ebc3f… You're receiving this email because of your account on gitlab.haskell.org.

1 0