Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7567f51e by Simon Peyton Jones at 2025-09-10T05:31:01-04:00 Fix a scoping error in Specialise This small patch fixes #26329, which triggered a scoping error. Test is in T21391, with -fpolymorphic-specialisation enabled - - - - - f531718e by sheaf at 2025-09-10T05:31:08-04:00 Make rationalTo{Float,Double} inline in phase 0 We hold off on inlining these until phase 0 to allow constant-folding rules to fire. However, once we get to phase 0, we should inline them, e.g. to expose unboxing opportunities. See CLC proposal #356. - - - - - 500aaa99 by Andreas Klebinger at 2025-09-10T05:31:10-04:00 Add regression test for #26056 - - - - - 2eb2b028 by sheaf at 2025-09-10T05:31:15-04:00 Deep subsumption: unify mults without tcEqMult As seen in #26332, we may well end up with a non-reflexive multiplicity coercion when doing deep subsumption. We should do the same thing that we do without deep subsumption: unify the multiplicities normally, without requiring that the coercion is reflexive (which is what 'tcEqMult' was doing). Fixes #26332 - - - - - 0a5813dc by sheaf at 2025-09-10T05:31:19-04:00 lint-codes: fixup MSYS drive letter on Windows This change ensures that System.Directory.listDirectory doesn't trip up on an MSYS-style path like '/c/Foo' when trying to list all testsuite stdout/stderr files as required for testing coverage of GHC diagnostic codes in the testsuite. Fixes #25178 - - - - - d055be16 by Ben Gamari at 2025-09-10T05:31:20-04:00 gitlab-ci: Disable split sections on FreeBSD Due to #26303. - - - - - b4af59b5 by Moritz Angermann at 2025-09-10T05:31:21-04:00 Improve mach-o relocation information This change adds more information about the symbol and addresses we try to relocate in the linker. This significantly helps when deubbging relocation issues reported by users. - - - - - b7f81cd7 by Moritz Angermann at 2025-09-10T05:31:22-04:00 test.mk expect GhcLeadingUnderscore, not LeadingUnderscore (in line with the other Ghc prefixed variables. - - - - - 88c3a7ad by Moritz Angermann at 2025-09-10T05:31:23-04:00 testsuite: Fix broken exec_signals_child.c There is no signal 0. The signal mask is 1-32. - - - - - 48485986 by Moritz Angermann at 2025-09-10T05:31:24-04:00 testsuite: clarify Windows/Darwin locale rationale for skipping T6037 T2507 T8959a - - - - - 68c5cd01 by Moritz Angermann at 2025-09-10T05:31:25-04:00 Skip broken tests on macOS (due to leading underscore not handled properly in the expected output.) - - - - - 96474e13 by Zubin Duggal at 2025-09-10T05:31:25-04:00 docs(sphinx): fix links to reverse flags when using the :ghc-flag:`-fno-<flag>` syntax This solution is rather hacky and I suspect there is a better way to do this but I don't know enough about Sphinx to do better. Fixes #26352 - - - - - 18 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Tc/Utils/Unify.hs - docs/users_guide/flags.py - hadrian/src/Oracles/TestSettings.hs - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Float.hs - linters/lint-codes/LintCodes/Coverage.hs - rts/linker/MachO.c - testsuite/ghc-config/ghc-config.hs - testsuite/tests/driver/all.T - + testsuite/tests/linear/should_compile/T26332.hs - testsuite/tests/linear/should_compile/all.T - + testsuite/tests/profiling/should_compile/T26056.hs - testsuite/tests/profiling/should_compile/all.T - testsuite/tests/rts/exec_signals_child.c - testsuite/tests/rts/linker/T11223/all.T Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -1235,7 +1235,7 @@ darwin = freebsd_jobs :: [JobGroup Job] freebsd_jobs = - [ addValidateRule FreeBSDLabel (standardBuilds Amd64 FreeBSD14) + [ addValidateRule FreeBSDLabel (standardBuildsWithConfig Amd64 FreeBSD14 (splitSectionsBroken vanilla)) ] alpine_x86 :: [JobGroup Job] ===================================== .gitlab/jobs.yaml ===================================== @@ -4296,7 +4296,7 @@ "ac_cv_func_utimensat": "no" } }, - "release-x86_64-freebsd14-release": { + "release-x86_64-freebsd14-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4307,7 +4307,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-freebsd14-release.tar.xz", + "ghc-x86_64-freebsd14-release+no_split_sections.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4349,8 +4349,8 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-freebsd14-release", - "BUILD_FLAVOUR": "release", + "BIN_DIST_NAME": "ghc-x86_64-freebsd14-release+no_split_sections", + "BUILD_FLAVOUR": "release+no_split_sections", "CABAL_INSTALL_VERSION": "3.10.3.0", "CC": "cc", "CONFIGURE_ARGS": "--with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --with-system-libffi --with-ffi-includes=/usr/local/include --with-ffi-libraries=/usr/local/lib --with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", @@ -4359,7 +4359,7 @@ "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-freebsd14-release", + "TEST_ENV": "x86_64-freebsd14-release+no_split_sections", "XZ_OPT": "-9" } }, ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1205,14 +1205,21 @@ specExpr env (Tick tickish body) ---------------- Applications might generate a call instance -------------------- specExpr env expr@(App {}) = do { let (fun_in, args_in) = collectArgs expr + ; (fun_out, uds_fun) <- specExpr env fun_in ; (args_out, uds_args) <- mapAndCombineSM (specExpr env) args_in - ; let env_args = env `bringFloatedDictsIntoScope` ud_binds uds_args - -- Some dicts may have floated out of args_in; - -- they should be in scope for fireRewriteRules (#21689) - (fun_in', args_out') = fireRewriteRules env_args fun_in args_out - ; (fun_out', uds_fun) <- specExpr env fun_in' + ; let uds_app = uds_fun `thenUDs` uds_args + env_args = zapSubst env `bringFloatedDictsIntoScope` ud_binds uds_app + -- zapSubst: we have now fully applied the substitution + -- bringFloatedDictsIntoScope: some dicts may have floated out of + -- args_in; they should be in scope for fireRewriteRules (#21689) + + -- Try firing rewrite rules + -- See Note [Fire rules in the specialiser] + ; let (fun_out', args_out') = fireRewriteRules env_args fun_out args_out + + -- Make a call record, and return ; let uds_call = mkCallUDs env fun_out' args_out' - ; return (fun_out' `mkApps` args_out', uds_fun `thenUDs` uds_call `thenUDs` uds_args) } + ; return (fun_out' `mkApps` args_out', uds_app `thenUDs` uds_call) } ---------------- Lambda/case require dumping of usage details -------------------- specExpr env e@(Lam {}) @@ -1246,17 +1253,18 @@ specExpr env (Let bind body) -- See Note [Specialisation modulo dictionary selectors] -- Note [ClassOp/DFun selection] -- Note [Fire rules in the specialiser] -fireRewriteRules :: SpecEnv -> InExpr -> [OutExpr] -> (InExpr, [OutExpr]) +fireRewriteRules :: SpecEnv -- Substitution is already zapped + -> OutExpr -> [OutExpr] -> (OutExpr, [OutExpr]) fireRewriteRules env (Var f) args | let rules = getRules (se_rules env) f , Just (rule, expr) <- specLookupRule env f args activeInInitialPhase rules , let rest_args = drop (ruleArity rule) args -- See Note [Extra args in the target] - zapped_subst = Core.zapSubst (se_subst env) - expr' = simpleOptExprWith defaultSimpleOpts zapped_subst expr + zapped_subst = se_subst env -- Just needed for the InScopeSet + expr' = simpleOptExprWith defaultSimpleOpts zapped_subst (mkApps expr rest_args) -- simplOptExpr needed because lookupRule returns -- (\x y. rhs) arg1 arg2 , (fun', args') <- collectArgs expr' - = fireRewriteRules env fun' (args'++rest_args) + = fireRewriteRules env fun' args' fireRewriteRules _ fun args = (fun, args) -------------- @@ -1669,10 +1677,19 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs ; let all_rule_bndrs = poly_qvars ++ rule_bndrs env' = env { se_subst = subst'' } -{- - ; pprTrace "spec_call" (vcat + -- Check for (a) usefulness and (b) not already covered + -- See (SC1) in Note [Specialisations already covered] + ; let all_rules = rules_acc ++ existing_rules + -- all_rules: we look both in the rules_acc (generated by this invocation + -- of specCalls), and in existing_rules (passed in to specCalls) + already_covered = alreadyCovered env' all_rule_bndrs fn + rule_lhs_args is_active all_rules + +{- ; pprTrace "spec_call" (vcat [ text "fun: " <+> ppr fn , text "call info: " <+> ppr _ci + , text "useful: " <+> ppr useful + , text "already_covered:" <+> ppr already_covered , text "poly_qvars: " <+> ppr poly_qvars , text "useful: " <+> ppr useful , text "all_rule_bndrs:" <+> ppr all_rule_bndrs @@ -1681,17 +1698,13 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , text "dx_binds:" <+> ppr dx_binds , text "spec_args: " <+> ppr spec_args , text "rhs_bndrs" <+> ppr rhs_bndrs - , text "rhs_body" <+> ppr rhs_body ]) $ + , text "rhs_body" <+> ppr rhs_body + , text "subst''" <+> ppr subst'' ]) $ return () -} - -- Check for (a) usefulness and (b) not already covered - -- See (SC1) in Note [Specialisations already covered] - ; let all_rules = rules_acc ++ existing_rules - -- all_rules: we look both in the rules_acc (generated by this invocation - -- of specCalls), and in existing_rules (passed in to specCalls) - ; if not useful -- No useful specialisation - || alreadyCovered env' all_rule_bndrs fn rule_lhs_args is_active all_rules + ; if not useful -- No useful specialisation + || already_covered -- Useful, but done already then return spec_acc else @@ -1702,6 +1715,12 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs -- Run the specialiser on the specialised RHS ; (rhs_body', rhs_uds) <- specExpr env'' rhs_body +{- ; pprTrace "spec_call2" (vcat + [ text "fun:" <+> ppr fn + , text "rhs_body':" <+> ppr rhs_body' ]) $ + return () +-} + -- Make the RHS of the specialised function ; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs' (rhs_uds1, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -1853,8 +1853,8 @@ where we eta-expanded that (:). But now foldr expects an argument with ->{Many} and gets an argument with ->{m1} or ->{m2}, and Lint complains. -The easiest solution was to use tcEqMult in tc_sub_type_deep, and -insist on equality. This is only in the DeepSubsumption code anyway. +The easiest solution was to unify the multiplicities in tc_sub_type_deep, +insisting on equality. This is only in the DeepSubsumption code anyway. Note [FunTy vs non-FunTy case in tc_sub_type_deep] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2047,10 +2047,7 @@ tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected -- GenSigCtxt: See Note [Setting the argument context] ; res_wrap <- tc_sub_type_deep (Result pos) unify inst_orig ctxt act_res exp_res - -- See Note [Multiplicity in deep subsumption] - ; tcEqMult inst_orig act_mult exp_mult - - ; mkWpFun_FRR pos + ; mkWpFun_FRR unify pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap @@ -2058,20 +2055,32 @@ tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected where given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg []) --- | Like 'mkWpFun', except that it performs representation-polymorphism --- checks on the argument type. +-- | Like 'mkWpFun', except that it performs the necessary +-- representation-polymorphism checks on the argument type in the case that +-- we introduce a lambda abstraction. mkWpFun_FRR - :: Position p + :: (TcType -> TcType -> TcM TcCoercionN) -- ^ how to unify + -> Position p -> FunTyFlag -> Type -> TcType -> Type -- actual FunTy -> FunTyFlag -> Type -> TcType -> Type -- expected FunTy -> HsWrapper -- ^ exp_arg ~> act_arg -> HsWrapper -- ^ act_res ~> exp_res -> TcM HsWrapper -- ^ act_funTy ~> exp_funTy -mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap - | needs_eta - -- See Wrinkle [Representation-polymorphism checking during subtyping] - = do { (exp_arg_co, exp_arg_frr) <- hasFixedRuntimeRep (FRRDeepSubsumption True pos) exp_arg - ; (act_arg_co, _act_arg_frr) <- hasFixedRuntimeRep (FRRDeepSubsumption False pos) act_arg +mkWpFun_FRR unify pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap + = do { ((exp_arg_co, exp_arg_frr), (act_arg_co, _act_arg_frr)) <- + if needs_frr_checks + -- See Wrinkle [Representation-polymorphism checking during subtyping] + then do { exp_frr_wrap <- hasFixedRuntimeRep (frr_ctxt True ) exp_arg + ; act_frr_wrap <- hasFixedRuntimeRep (frr_ctxt False) act_arg + ; return (exp_frr_wrap, act_frr_wrap) } + else return ((mkNomReflCo exp_arg, exp_arg), (mkNomReflCo act_arg, act_arg)) + + -- Enforce equality of multiplicities (not the more natural sub-multiplicity). + -- See Note [Multiplicity in deep subsumption] + ; act_arg_mult_co <- unify act_mult exp_mult + -- NB: don't use tcEqMult: that would require the evidence for + -- equality to be Refl, but it might well not be (#26332). + ; let exp_arg_fun_co = mkFunCo Nominal exp_af @@ -2080,7 +2089,7 @@ mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res (mkReflCo Nominal exp_res) act_arg_fun_co = mkFunCo Nominal act_af - (mkReflCo Nominal act_mult) + act_arg_mult_co act_arg_co (mkReflCo Nominal act_res) arg_wrap_frr = @@ -2090,24 +2099,16 @@ mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res -- arg_wrap :: exp_arg ~> act_arg -- arg_wrap_frr :: exp_arg_frr ~> act_arg_frr - -- NB: because of the needs_eta guard, we know that mkWpFun will - -- return (WpFun ...); so we might as well just use the WpFun constructor. ; return $ mkWpCastN exp_arg_fun_co <.> - WpFun arg_wrap_frr res_wrap (Scaled exp_mult exp_arg_frr) + mkWpFun arg_wrap_frr res_wrap (Scaled exp_mult exp_arg_frr) exp_res <.> - mkWpCastN act_arg_fun_co } - | otherwise - = return $ - mkWpFun arg_wrap res_wrap (Scaled exp_mult exp_arg) exp_res - -- NB: because of 'needs_eta', this will never actually be a WpFun. - -- mkWpFun will turn it into a WpHole or WpCast, which is why - -- we can skip the hasFixedRuntimeRep checks in this case. - -- See Wrinkle [Representation-polymorphism checking during subtyping] + mkWpCastN act_arg_fun_co + } where - needs_eta :: Bool - needs_eta = + needs_frr_checks :: Bool + needs_frr_checks = not (hole_or_cast arg_wrap) || not (hole_or_cast res_wrap) @@ -2115,6 +2116,12 @@ mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res hole_or_cast WpHole = True hole_or_cast (WpCast {}) = True hole_or_cast _ = False + frr_ctxt :: Bool -> FixedRuntimeRepContext + frr_ctxt is_exp_ty = + FRRDeepSubsumption + { frrDSExpected = is_exp_ty + , frrDSPosition = pos + } ----------------------- deeplySkolemise :: SkolemInfo -> TcSigmaType ===================================== docs/users_guide/flags.py ===================================== @@ -236,8 +236,10 @@ class Flag(GenericFlag): reverse = self.options.get('reverse') if reverse is not None and reverse != '': # Make this also addressable via the reverse flag + # Strip leading hyphen to avoid double hyphen in anchor ID + clean_name = name[1:] if name.startswith('-') else name self.env.domaindata['std']['objects']['ghc-flag', reverse] = \ - self.env.docname, 'ghc-flag-%s' % name + self.env.docname, 'ghc-flag-%s' % clean_name # This class inherits from Sphinx's internal GenericObject, which drives # the add_object_type() utility function. We want to keep that tooling, ===================================== hadrian/src/Oracles/TestSettings.hs ===================================== @@ -73,7 +73,7 @@ testSetting key = do TestLLC -> "LLC" TestTEST_CC -> "TEST_CC" TestTEST_CC_OPTS -> "TEST_CC_OPTS" - TestLeadingUnderscore -> "LeadingUnderscore" + TestLeadingUnderscore -> "GhcLeadingUnderscore" TestGhcPackageDb -> "GhcGlobalPackageDb" TestGhcLibDir -> "GhcLibdir" ===================================== libraries/base/changelog.md ===================================== @@ -4,6 +4,7 @@ * Remove deprecated, unstable heap representation details from `GHC.Exts` ([CLC proposal #212](https://github.com/haskell/core-libraries-committee/issues/212)) * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337)) * Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338)) + * Ensure that `rationalToFloat` and `rationalToDouble` always inline in the end. ([CLC proposal #356](https://github.com/haskell/core-libraries-committee/issues/356)) * Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332)) * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213)) * Add `thenA` and `thenM`. ([CLC proposal #351](https://github.com/haskell/core-libraries-committee/issues/351)) ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -466,8 +466,8 @@ instance Fractional Float where recip x = 1.0 / x rationalToFloat :: Integer -> Integer -> Float -{-# NOINLINE [0] rationalToFloat #-} --- Re NOINLINE pragma, see Note [realToFrac natural-to-float] +{-# INLINE [0] rationalToFloat #-} +-- Re INLINE pragma, see Note [realToFrac natural-to-float] rationalToFloat n 0 | n == 0 = 0/0 | n < 0 = (-1)/0 @@ -718,8 +718,8 @@ instance Fractional Double where recip x = 1.0 / x rationalToDouble :: Integer -> Integer -> Double -{-# NOINLINE [0] rationalToDouble #-} --- Re NOINLINE pragma, see Note [realToFrac natural-to-float] +{-# INLINE [0] rationalToDouble #-} +-- Re INLINE pragma, see Note [realToFrac natural-to-float] rationalToDouble n 0 | n == 0 = 0/0 | n < 0 = (-1)/0 @@ -1673,7 +1673,11 @@ Now we'd have a BUILTIN constant folding rule for rationalToFloat; but to allow that rule to fire reliably we should delay inlining rationalToFloat until stage 0. (It may get an inlining from CPR analysis.) -Hence the NOINLINE[0] rationalToFloat, and similarly rationalToDouble. +Hence the INLINE[0] rationalToFloat, and similarly for rationalToDouble. +This activation means: + + - we don't inline until phase 0 (solving the above) + - we do inline starting at phase 0 (because we do want it inlining in the end) -} -- Utils ===================================== linters/lint-codes/LintCodes/Coverage.hs ===================================== @@ -10,11 +10,13 @@ module LintCodes.Coverage -- base import Data.Char - ( isAlphaNum, isDigit, isSpace ) + ( isAlphaNum, isDigit, isSpace, toUpper ) import Data.Maybe ( mapMaybe ) import Data.List ( dropWhileEnd ) +import System.Info + ( os ) -- bytestring import qualified Data.ByteString as ByteString @@ -28,7 +30,7 @@ import qualified Data.Set as Set -- directory import System.Directory - ( doesDirectoryExist, listDirectory ) + ( doesDirectoryExist, listDirectory, makeAbsolute ) -- filepath import System.FilePath @@ -63,7 +65,12 @@ getCoveredCodes = do { top <- dropWhileEnd isSpace <$> readProcess "git" ["rev-parse", "--show-toplevel"] "" -- TODO: would be better to avoid using git entirely. - ; let testRoot = top "testsuite" "tests" + + -- When run inside an MSYS shell, git may return a Unix-style path + -- like /c/Blah. System.Directory doesn't like that, so we make sure + -- to turn that into C:/Blah. See #25178. + ; top' <- fixupMsysDrive top + ; let testRoot = top' "testsuite" "tests" ; traverseFilesFrom includeFile diagnosticCodesIn testRoot } @@ -158,3 +165,14 @@ traverseFilesFrom include_file parse_contents = go { Left _ -> mempty ; Right txt -> parse_contents txt } } } } + +-- | On Windows, change MSYS-style @/c/Blah@ to @C:/Blah@. See #25178. +fixupMsysDrive :: FilePath -> IO FilePath +fixupMsysDrive fp = do + fixedUp <- + if | os == "mingw32" || os == "win32" + , ('/':drv:'/':rest) <- fp + -> return $ toUpper drv : ':':'/':rest + | otherwise + -> return fp + makeAbsolute fixedUp ===================================== rts/linker/MachO.c ===================================== @@ -64,7 +64,7 @@ static bool fitsBits(size_t bits, int64_t value); static int64_t decodeAddend(ObjectCode * oc, Section * section, MachORelocationInfo * ri); static void encodeAddend(ObjectCode * oc, Section * section, - MachORelocationInfo * ri, int64_t addend); + MachORelocationInfo * ri, int64_t addend, MachOSymbol * symbol); /* Global Offset Table logic */ static bool isGotLoad(MachORelocationInfo * ri); @@ -361,15 +361,21 @@ fitsBits(size_t bits, int64_t value) { static void encodeAddend(ObjectCode * oc, Section * section, - MachORelocationInfo * ri, int64_t addend) { + MachORelocationInfo * ri, int64_t addend, MachOSymbol * symbol) { uint32_t * p = (uint32_t*)((uint8_t*)section->start + ri->r_address); checkProddableBlock(&oc->proddables, (void*)p, 1 << ri->r_length); + const char *symbol_name = symbol && symbol->name ? (char*)symbol->name : "<unknown>"; + const char *file_name = oc->fileName ? (char*)oc->fileName : "<unknown>"; + switch (ri->r_type) { case ARM64_RELOC_UNSIGNED: { - if(!fitsBits(8 << ri->r_length, addend)) - barf("Relocation out of range for UNSIGNED"); + if(!fitsBits(8 << ri->r_length, addend)) { + const char *library_info = OC_INFORMATIVE_FILENAME(oc); + barf("Relocation out of range for UNSIGNED in %s: symbol '%s', addend 0x%llx, address 0x%llx, library: %s", + file_name, symbol_name, (long long)addend, (long long)ri->r_address, library_info ? (char*)library_info : "<unknown>"); + } switch (ri->r_length) { case 0: *(uint8_t*)p = (uint8_t)addend; break; case 1: *(uint16_t*)p = (uint16_t)addend; break; @@ -382,8 +388,11 @@ encodeAddend(ObjectCode * oc, Section * section, return; } case ARM64_RELOC_SUBTRACTOR: { - if(!fitsBits(8 << ri->r_length, addend)) - barf("Relocation out of range for SUBTRACTOR"); + if(!fitsBits(8 << ri->r_length, addend)) { + const char *library_info = OC_INFORMATIVE_FILENAME(oc); + barf("Relocation out of range for SUBTRACTOR in %s: symbol '%s', addend 0x%llx, address 0x%llx, library: %s", + file_name, symbol_name, (long long)addend, (long long)ri->r_address, library_info ? (char*)library_info : "<unknown>"); + } switch (ri->r_length) { case 0: *(uint8_t*)p = (uint8_t)addend; break; case 1: *(uint16_t*)p = (uint16_t)addend; break; @@ -400,8 +409,11 @@ encodeAddend(ObjectCode * oc, Section * section, * do not need the last two bits of the value. If the value >> 2 * still exceeds 26bits, we won't be able to reach it. */ - if(!fitsBits(26, addend >> 2)) - barf("Relocation target for BRACH26 out of range."); + if(!fitsBits(26, addend >> 2)) { + const char *library_info = OC_INFORMATIVE_FILENAME(oc); + barf("Relocation target for BRANCH26 out of range in %s: symbol '%s', addend 0x%llx (0x%llx >> 2), address 0x%llx, library: %s", + file_name, symbol_name, (long long)addend, (long long)(addend >> 2), (long long)ri->r_address, library_info ? (char*)library_info : "<unknown>"); + } *p = (*p & 0xFC000000) | ((uint32_t)(addend >> 2) & 0x03FFFFFF); return; } @@ -412,8 +424,12 @@ encodeAddend(ObjectCode * oc, Section * section, * with the PAGEOFF12 relocation allows to address a relative range * of +-4GB. */ - if(!fitsBits(21, addend >> 12)) - barf("Relocation target for PAGE21 out of range."); + if(!fitsBits(21, addend >> 12)) { + const char *reloc_type = (ri->r_type == ARM64_RELOC_PAGE21) ? "PAGE21" : "GOT_LOAD_PAGE21"; + const char *library_info = OC_INFORMATIVE_FILENAME(oc); + barf("Relocation target for %s out of range in %s: symbol '%s', addend 0x%llx (0x%llx >> 12), address 0x%llx, library: %s", + reloc_type, file_name, symbol_name, (long long)addend, (long long)(addend >> 12), (long long)ri->r_address, library_info ? (char*)library_info : "<unknown>"); + } *p = (*p & 0x9F00001F) | (uint32_t)((addend << 17) & 0x60000000) | (uint32_t)((addend >> 9) & 0x00FFFFE0); return; @@ -423,8 +439,11 @@ encodeAddend(ObjectCode * oc, Section * section, /* Store an offset into a page (4k). Depending on the instruction * the bits are stored at slightly different positions. */ - if(!fitsBits(12, addend)) - barf("Relocation target for PAGEOFF12 out or range."); + if(!fitsBits(12, addend)) { + const char *library_info = OC_INFORMATIVE_FILENAME(oc); + barf("Relocation target for PAGEOFF12 out of range in %s: symbol '%s', addend 0x%llx, address 0x%llx, library: %s", + file_name, symbol_name, (long long)addend, (long long)ri->r_address, library_info ? (char*)library_info : "<unknown>"); + } int shift = 0; if(isLoadStore(p)) { @@ -589,7 +608,7 @@ relocateSectionAarch64(ObjectCode * oc, Section * section) MachOSymbol* symbol = &oc->info->macho_symbols[ri->r_symbolnum]; int64_t addend = decodeAddend(oc, section, ri); uint64_t value = symbol_value(oc, symbol); - encodeAddend(oc, section, ri, value + addend); + encodeAddend(oc, section, ri, value + addend, symbol); break; } case ARM64_RELOC_SUBTRACTOR: @@ -623,7 +642,7 @@ relocateSectionAarch64(ObjectCode * oc, Section * section) // combine with addend and store int64_t addend = decodeAddend(oc, section, ri); - encodeAddend(oc, section, ri, addend - sub_value + add_value); + encodeAddend(oc, section, ri, addend - sub_value + add_value, symbol1); // skip next relocation: we've already handled it i += 1; @@ -664,7 +683,7 @@ relocateSectionAarch64(ObjectCode * oc, Section * section) } } } - encodeAddend(oc, section, ri, value - pc + addend); + encodeAddend(oc, section, ri, value - pc + addend, symbol); break; } case ARM64_RELOC_PAGE21: @@ -676,7 +695,7 @@ relocateSectionAarch64(ObjectCode * oc, Section * section) uint64_t pc = (uint64_t)section->start + ri->r_address; uint64_t value = (uint64_t)(isGotLoad(ri) ? symbol->got_addr : symbol->addr); ASSERT(!isGotLoad(ri) || (symbol->got_addr != 0)); - encodeAddend(oc, section, ri, ((value + addend + explicit_addend) & (-4096)) - (pc & (-4096))); + encodeAddend(oc, section, ri, ((value + addend + explicit_addend) & (-4096)) - (pc & (-4096)), symbol); // reset, just in case. explicit_addend = 0; @@ -690,7 +709,7 @@ relocateSectionAarch64(ObjectCode * oc, Section * section) barf("explicit_addend and addend can't be set at the same time."); uint64_t value = (uint64_t)(isGotLoad(ri) ? symbol->got_addr : symbol->addr); ASSERT(!isGotLoad(ri) || (symbol->got_addr != 0)); - encodeAddend(oc, section, ri, 0xFFF & (value + addend + explicit_addend)); + encodeAddend(oc, section, ri, 0xFFF & (value + addend + explicit_addend), symbol); // reset, just in case. explicit_addend = 0; ===================================== testsuite/ghc-config/ghc-config.hs ===================================== @@ -43,7 +43,7 @@ main = do getGhcFieldOrDefault fields "TargetRTSLinkerOnlySupportsSharedLibs" "target RTS linker only supports shared libraries" "NO" getGhcFieldOrDefault fields "GhcDynamic" "GHC Dynamic" "NO" getGhcFieldOrDefault fields "GhcProfiled" "GHC Profiled" "NO" - getGhcFieldOrDefault fields "LeadingUnderscore" "Leading underscore" "NO" + getGhcFieldOrDefault fields "GhcLeadingUnderscore" "Leading underscore" "NO" getGhcFieldOrDefault fields "GhcTablesNextToCode" "Tables next to code" "NO" getGhcFieldProgWithDefault fields "AR" "ar command" "ar" getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc" ===================================== testsuite/tests/driver/all.T ===================================== @@ -179,24 +179,23 @@ test('T7060', [], makefile_test, []) test('T7130', normal, compile_fail, ['-fflul-laziness']) test('T7563', when(unregisterised(), skip), makefile_test, []) test('T6037', - # The testsuite doesn't know how to set a non-Unicode locale on Windows or MacOS < Sonoma. - # Because in previous version of MacOS the test is still broken, we mark it as fragile. + # Requires forcing a 7-bit/ASCII-only locale. + # - On Windows (mingw32) the testsuite can't reliably set a non-Unicode C locale -> expect_fail. + # - On modern Darwin there are no pure ASCII locales available -> skip. [when(opsys('mingw32'), expect_fail), - when(opsys('darwin'), fragile(24161)) + when(opsys('darwin'), skip) ], makefile_test, []) test('T2507', - # The testsuite doesn't know how to set a non-Unicode locale on Windows or MacOS < Sonoma - # Because in previous version of MacOS the test is still broken, we mark it as fragile. + # Same locale assumptions as T6037 (ASCII-only needed, unavailable on Darwin; untestable on Windows). [when(opsys('mingw32'), expect_fail), - when(opsys('darwin'), fragile(24161)) + when(opsys('darwin'), skip) ], makefile_test, []) test('T8959a', - # The testsuite doesn't know how to set a non-Unicode locale on Windows or MacOS < Sonoma - # Because in previous version of MacOS the test is still broken, we mark it as fragile. + # Same locale assumptions as T6037 (ASCII-only needed, unavailable on Darwin; untestable on Windows). [when(opsys('mingw32'), expect_fail), - when(opsys('darwin'), fragile(24161)) + when(opsys('darwin'), skip) ], makefile_test, []) ===================================== testsuite/tests/linear/should_compile/T26332.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE DeepSubsumption #-} +{-# LANGUAGE LinearTypes #-} + +module T26332 where + +import Unsafe.Coerce + +toLinear + :: forall a b p q. + (a %p-> b) %1-> (a %q-> b) +toLinear f = case unsafeEqualityProof @p @q of + UnsafeRefl -> f ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -41,6 +41,7 @@ test('T19400', unless(compiler_debugged(), skip), compile, ['']) test('T20023', normal, compile, ['']) test('T22546', normal, compile, ['']) test('T23025', normal, compile, ['-dlinear-core-lint']) +test('T26332', normal, compile, ['-O -dlinear-core-lint']) test('LinearRecUpd', normal, compile, ['']) test('T23814', normal, compile, ['']) test('LinearLet', normal, compile, ['']) ===================================== testsuite/tests/profiling/should_compile/T26056.hs ===================================== @@ -0,0 +1,21 @@ +module M where + +import GHC.Exts ( Any ) +import Unsafe.Coerce ( unsafeCoerce ) + +data Sigma = MkT Any + +testSubList :: Maybe Bool -> Sigma -> Sigma +testSubList (Just x) final = {-# SCC "y" #-} ( + let x' = seq x () + in case testSubList Nothing final of + MkT w -> {-# SCC "x" #-} + (unsafeCoerce MkT (konst x' myHead (unsafeCoerce w)))) +testSubList Nothing final = final + +myHead :: [a] -> a +myHead (x:_) = x + +konst :: () -> ([a] -> a) -> [a] -> a +konst _ x = x +{-# OPAQUE konst #-} ===================================== testsuite/tests/profiling/should_compile/all.T ===================================== @@ -20,3 +20,4 @@ test('T14931', [test_opts, unless(have_dynamic(), skip)], test('T15108', [test_opts], compile, ['-O -prof -fprof-auto']) test('T19894', [test_opts, extra_files(['T19894'])], multimod_compile, ['Main', '-v0 -O2 -prof -fprof-auto -iT19894']) test('T20938', [test_opts], compile, ['-O -prof']) +test('T26056', [test_opts], compile, ['-O -prof']) ===================================== testsuite/tests/rts/exec_signals_child.c ===================================== @@ -2,8 +2,11 @@ #include #include -// Prints the state of the signal handlers to stdout -int main() +// Prints the state of the signal handlers to stdout. +// NOTE: We intentionally start at signal 1 (not 0). Signal number 0 is not a +// real signal; passing 0 to sigismember/sigaction is undefined behaviour and +// on Darwin was observed to yield memory corruption / junk bytes in output. +int main(void) { int open = 0, i; sigset_t blockedsigs; @@ -11,7 +14,7 @@ int main() printf("ChildInfo { masked = ["); sigprocmask(SIG_BLOCK, NULL, &blockedsigs); - for(i = 0; i < NSIG; ++i) + for(i = 1; i < NSIG; ++i) { int ret = sigismember(&blockedsigs, i); if(ret >= 0) @@ -26,7 +29,7 @@ int main() printf("], handlers = ["); open = 0; - for(i = 0; i < NSIG; ++i) + for(i = 1; i < NSIG; ++i) { struct sigaction old; if(sigaction(i, NULL, &old) >= 0) ===================================== testsuite/tests/rts/linker/T11223/all.T ===================================== @@ -33,7 +33,12 @@ test('T11223_simple_duplicate', test('T11223_simple_duplicate_lib', [extra_files(['bar.c', 'foo.c', 'foo.hs']), - when(ghc_dynamic(), skip), normalise_errmsg_fun(normalise_duplicate_errmsg), + when(ghc_dynamic(), skip), + # Darwin/Mach-O reports external C symbols with a leading underscore (e.g. _a, _c) + # which our expected stderr (shared with ELF platforms) does not account for. + # Rather than broaden normalisation here, skip on darwin for now. + when(opsys('darwin'), skip), + normalise_errmsg_fun(normalise_duplicate_errmsg), req_c], makefile_test, ['t_11223_simple_duplicate_lib']) @@ -57,7 +62,10 @@ test('T11223_link_order_b_a_succeed', test('T11223_link_order_a_b_2_fail', [extra_files(['bar.c', 'foo.c', 'foo3.hs']), - when(ghc_dynamic(), skip), normalise_errmsg_fun(normalise_duplicate_errmsg), + when(ghc_dynamic(), skip), + # See note above about Mach-O leading underscores; skip on darwin. + when(opsys('darwin'), skip), + normalise_errmsg_fun(normalise_duplicate_errmsg), req_c], makefile_test, ['t_11223_link_order_a_b_2_fail']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0be4dca51133ca2f91841804e276720... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0be4dca51133ca2f91841804e276720... You're receiving this email because of your account on gitlab.haskell.org.