diff --git a/.gitignore b/.gitignore index 6237e0b..acf3a31 100644 --- a/.gitignore +++ b/.gitignore @@ -36,3 +36,5 @@ testsuite-6.12.3.tar.bz2 /ghc-8.10.4-src.tar.xz.sig /ghc-8.10.7-src.tar.xz /ghc-8.10.7-src.tar.xz.sig +/ghc-9.0.2-src.tar.xz +/ghc-9.0.2-src.tar.xz.sig diff --git a/7689.patch b/7689.patch new file mode 100644 index 0000000..36d7d71 --- /dev/null +++ b/7689.patch @@ -0,0 +1,256 @@ +From 18d7007e0cd1140936b803df4816110cee0ed086 Mon Sep 17 00:00:00 2001 +From: Ben Gamari +Date: Tue, 1 Mar 2022 13:49:57 -0500 +Subject: [PATCH 1/2] rts: Factor out built-in GC roots + +--- + rts/RtsStartup.c | 76 ++++++++++++++++++++++++++---------------------- + 1 file changed, 41 insertions(+), 35 deletions(-) + +diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c +index 347434420b02..e412715cdf55 100644 +--- a/rts/RtsStartup.c ++++ b/rts/RtsStartup.c +@@ -174,6 +174,45 @@ hs_restoreConsoleCP (void) + Starting up the RTS + -------------------------------------------------------------------------- */ + ++static void initBuiltinGcRoots(void) ++{ ++ /* Add some GC roots for things in the base package that the RTS ++ * knows about. We don't know whether these turn out to be CAFs ++ * or refer to CAFs, but we have to assume that they might. ++ * ++ * Because these stable pointers will retain any CAF references in ++ * these closures `Id`s of these can be safely marked as non-CAFFY ++ * in the compiler. ++ */ ++ getStablePtr((StgPtr)runIO_closure); ++ getStablePtr((StgPtr)runNonIO_closure); ++ getStablePtr((StgPtr)flushStdHandles_closure); ++ ++ getStablePtr((StgPtr)runFinalizerBatch_closure); ++ ++ getStablePtr((StgPtr)stackOverflow_closure); ++ getStablePtr((StgPtr)heapOverflow_closure); ++ getStablePtr((StgPtr)unpackCString_closure); ++ getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure); ++ getStablePtr((StgPtr)nonTermination_closure); ++ getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure); ++ getStablePtr((StgPtr)allocationLimitExceeded_closure); ++ getStablePtr((StgPtr)cannotCompactFunction_closure); ++ getStablePtr((StgPtr)cannotCompactPinned_closure); ++ getStablePtr((StgPtr)cannotCompactMutable_closure); ++ getStablePtr((StgPtr)nestedAtomically_closure); ++ getStablePtr((StgPtr)runSparks_closure); ++ getStablePtr((StgPtr)ensureIOManagerIsRunning_closure); ++ getStablePtr((StgPtr)interruptIOManager_closure); ++ getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure); ++#if !defined(mingw32_HOST_OS) ++ getStablePtr((StgPtr)blockedOnBadFD_closure); ++ getStablePtr((StgPtr)runHandlersPtr_closure); ++#else ++ getStablePtr((StgPtr)processRemoteCompletion_closure); ++#endif ++} ++ + void + hs_init(int *argc, char **argv[]) + { +@@ -311,41 +350,8 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) + /* initialise the stable name table */ + initStableNameTable(); + +- /* Add some GC roots for things in the base package that the RTS +- * knows about. We don't know whether these turn out to be CAFs +- * or refer to CAFs, but we have to assume that they might. +- * +- * Because these stable pointers will retain any CAF references in +- * these closures `Id`s of these can be safely marked as non-CAFFY +- * in the compiler. +- */ +- getStablePtr((StgPtr)runIO_closure); +- getStablePtr((StgPtr)runNonIO_closure); +- getStablePtr((StgPtr)flushStdHandles_closure); +- +- getStablePtr((StgPtr)runFinalizerBatch_closure); +- +- getStablePtr((StgPtr)stackOverflow_closure); +- getStablePtr((StgPtr)heapOverflow_closure); +- getStablePtr((StgPtr)unpackCString_closure); +- getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure); +- getStablePtr((StgPtr)nonTermination_closure); +- getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure); +- getStablePtr((StgPtr)allocationLimitExceeded_closure); +- getStablePtr((StgPtr)cannotCompactFunction_closure); +- getStablePtr((StgPtr)cannotCompactPinned_closure); +- getStablePtr((StgPtr)cannotCompactMutable_closure); +- getStablePtr((StgPtr)nestedAtomically_closure); +- getStablePtr((StgPtr)runSparks_closure); +- getStablePtr((StgPtr)ensureIOManagerIsRunning_closure); +- getStablePtr((StgPtr)interruptIOManager_closure); +- getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure); +-#if !defined(mingw32_HOST_OS) +- getStablePtr((StgPtr)blockedOnBadFD_closure); +- getStablePtr((StgPtr)runHandlersPtr_closure); +-#else +- getStablePtr((StgPtr)processRemoteCompletion_closure); +-#endif ++ /* create StablePtrs for builtin GC roots*/ ++ initBuiltinGcRoots(); + + /* + * process any foreign exports which were registered while loading the +-- +GitLab + + +From 2ac45ba0ff0ab2911ecfe443e54df6f30eec5ff5 Mon Sep 17 00:00:00 2001 +From: Ben Gamari +Date: Tue, 1 Mar 2022 13:50:20 -0500 +Subject: [PATCH 2/2] Ensure that wired-in exception closures aren't GC'd + +As described in Note [Wired-in exceptions are not CAFfy], a small set of +built-in exception closures get special treatment in the code generator, +being declared as non-CAFfy despite potentially containing CAF +references. The original intent of this treatment for the RTS to then +add StablePtrs for each of the closures, ensuring that they are not +GC'd. However, this logic was not applied consistently and eventually +removed entirely in 951c1fb0. This lead to #21141. + +Here we fix this bug by reintroducing the StablePtrs and document the +status quo. + +Closes #21141. +--- + compiler/GHC/Core/Make.hs | 25 ++++++++++++++++++++++-- + libraries/ghc-prim/GHC/Prim/Exception.hs | 3 ++- + rts/Prelude.h | 10 ++++++++++ + rts/RtsStartup.c | 6 ++++++ + 4 files changed, 41 insertions(+), 3 deletions(-) + +diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs +index 619b7adaf403..ff824158c3de 100644 +--- a/compiler/GHC/Core/Make.hs ++++ b/compiler/GHC/Core/Make.hs +@@ -816,7 +816,9 @@ tYPE_ERROR_ID = mkRuntimeErrorId typeErrorName + -- argument would require allocating a thunk. + -- + -- 4. it can't be CAFFY because that would mean making some non-CAFFY +--- definitions that use unboxed sums CAFFY in unarise. ++-- definitions that use unboxed sums CAFFY in unarise. We work around ++-- this by declaring the absentSumFieldError as non-CAFfy, as described ++-- in Note [Wired-in exceptions are not CAFfy]. + -- + -- Getting this wrong causes hard-to-debug runtime issues, see #15038. + -- +@@ -850,6 +852,21 @@ tYPE_ERROR_ID = mkRuntimeErrorId typeErrorName + -- error. That's why it is OK for it to be un-catchable. + -- + ++-- Note [Wired-in exceptions are not CAFfy] ++-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++-- mkExceptionId claims that all exceptions are not CAFfy, despite the fact ++-- that their closures' code may in fact contain CAF references. We get away ++-- with this lie because the RTS ensures that all exception closures are ++-- considered live by the GC by creating StablePtrs during initialization. ++-- The lie is necessary to avoid unduly growing SRTs as these exceptions are ++-- sufficiently common to warrant special treatment. ++-- ++-- At some point we could consider removing this optimisation as it is quite ++-- fragile, but we do want to be careful to avoid adding undue cost. Unboxed ++-- sums in particular are intended to be used in performance-critical contexts. ++-- ++-- See #15038, #21141. ++ + absentSumFieldErrorName + = mkWiredInIdName + gHC_PRIM_PANIC +@@ -884,6 +901,9 @@ rAISE_UNDERFLOW_ID = mkExceptionId raiseUnderflowName + rAISE_DIVZERO_ID = mkExceptionId raiseDivZeroName + + -- | Exception with type \"forall a. a\" ++-- ++-- Any exceptions added via this function needs to be added to ++-- the RTS's initBuiltinGcRoots() function. + mkExceptionId :: Name -> Id + mkExceptionId name + = mkVanillaGlobalWithInfo name +@@ -891,7 +911,8 @@ mkExceptionId name + (vanillaIdInfo `setStrictnessInfo` mkClosedStrictSig [] botDiv + `setCprInfo` mkCprSig 0 botCpr + `setArityInfo` 0 +- `setCafInfo` NoCafRefs) -- #15038 ++ `setCafInfo` NoCafRefs) ++ -- See Note [Wired-in exceptions are not CAFfy] + + mkRuntimeErrorId :: Name -> Id + -- Error function +diff --git a/libraries/ghc-prim/GHC/Prim/Exception.hs b/libraries/ghc-prim/GHC/Prim/Exception.hs +index 36889dc1e325..0ab17946150e 100644 +--- a/libraries/ghc-prim/GHC/Prim/Exception.hs ++++ b/libraries/ghc-prim/GHC/Prim/Exception.hs +@@ -20,13 +20,14 @@ default () -- Double and Integer aren't available yet + + -- Note [Arithmetic exceptions] + -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +--- + -- ghc-prim provides several functions to raise arithmetic exceptions + -- (raiseDivZero, raiseUnderflow, raiseOverflow) that are wired-in the RTS. + -- These exceptions are meant to be used by the package implementing arbitrary + -- precision numbers (Natural,Integer). It can't depend on `base` package to + -- raise exceptions in a normal way because it would create a dependency + -- cycle (base <-> bignum package). See #14664 ++-- ++-- See also: Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. + + foreign import prim "stg_raiseOverflowzh" raiseOverflow# :: State# RealWorld -> (# State# RealWorld, Void# #) + foreign import prim "stg_raiseUnderflowzh" raiseUnderflow# :: State# RealWorld -> (# State# RealWorld, Void# #) +diff --git a/rts/Prelude.h b/rts/Prelude.h +index d2511b2fc3b6..5f1e070e331f 100644 +--- a/rts/Prelude.h ++++ b/rts/Prelude.h +@@ -19,6 +19,12 @@ + #define PRELUDE_CLOSURE(i) extern StgClosure DLL_IMPORT_DATA_VARNAME(i) + #endif + ++/* See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. */ ++PRELUDE_CLOSURE(ghczmprim_GHCziPrimziPanic_absentSumFieldError_closure); ++PRELUDE_CLOSURE(ghczmprim_GHCziPrimziException_raiseUnderflow_closure); ++PRELUDE_CLOSURE(ghczmprim_GHCziPrimziException_raiseOverflow_closure); ++PRELUDE_CLOSURE(ghczmprim_GHCziPrimziException_raiseDivZZero_closure); ++ + /* Define canonical names so we can abstract away from the actual + * modules these names are defined in. + */ +@@ -111,6 +117,10 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info); + #define nonTermination_closure DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nonTermination_closure) + #define nestedAtomically_closure DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nestedAtomically_closure) + #define doubleReadException DLL_IMPORT_DATA_REF(base_GHCziIOPort_doubleReadException_closure) ++#define absentSumFieldError_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziPrimziPanic_absentSumFieldError_closure) ++#define raiseUnderflowException_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziPrimziException_raiseUnderflow_closure) ++#define raiseOverflowException_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziPrimziException_raiseOverflow_closure) ++#define raiseDivZeroException_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziPrimziException_raiseDivZZero_closure) + + #define blockedOnBadFD_closure DLL_IMPORT_DATA_REF(base_GHCziEventziThread_blockedOnBadFD_closure) + +diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c +index e412715cdf55..79c6e3f6b88a 100644 +--- a/rts/RtsStartup.c ++++ b/rts/RtsStartup.c +@@ -211,6 +211,12 @@ static void initBuiltinGcRoots(void) + #else + getStablePtr((StgPtr)processRemoteCompletion_closure); + #endif ++ ++ /* See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make. */ ++ getStablePtr((StgPtr)absentSumFieldError_closure); ++ getStablePtr((StgPtr)raiseUnderflowException_closure); ++ getStablePtr((StgPtr)raiseOverflowException_closure); ++ getStablePtr((StgPtr)raiseDivZeroException_closure); + } + + void +-- +GitLab + diff --git a/buildpath-abi-stability-2.patch b/buildpath-abi-stability-2.patch new file mode 100644 index 0000000..a2e8fa7 --- /dev/null +++ b/buildpath-abi-stability-2.patch @@ -0,0 +1,87 @@ +Description: Don't include BufPos in interface files +Author: Matthew Pickering +Origin: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8972 +Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/22162 +Index: b/compiler/GHC/Iface/Ext/Types.hs +=================================================================== +--- a/compiler/GHC/Iface/Ext/Types.hs ++++ b/compiler/GHC/Iface/Ext/Types.hs +@@ -746,5 +746,5 @@ toHieName name + | isKnownKeyName name = KnownKeyName (nameUnique name) + | isExternalName name = ExternalName (nameModule name) + (nameOccName name) +- (nameSrcSpan name) +- | otherwise = LocalName (nameOccName name) (nameSrcSpan name) ++ (removeBufSpan $ nameSrcSpan name) ++ | otherwise = LocalName (nameOccName name) (removeBufSpan $ nameSrcSpan name) +Index: b/compiler/GHC/Types/SrcLoc.hs +=================================================================== +--- a/compiler/GHC/Types/SrcLoc.hs ++++ b/compiler/GHC/Types/SrcLoc.hs +@@ -72,6 +72,7 @@ module GHC.Types.SrcLoc ( + getBufPos, + BufSpan(..), + getBufSpan, ++ removeBufSpan, + + -- * Located + Located, +@@ -397,6 +398,10 @@ data UnhelpfulSpanReason + | UnhelpfulOther !FastString + deriving (Eq, Show) + ++removeBufSpan :: SrcSpan -> SrcSpan ++removeBufSpan (RealSrcSpan s _) = RealSrcSpan s Nothing ++removeBufSpan s = s ++ + {- Note [Why Maybe BufPos] + ~~~~~~~~~~~~~~~~~~~~~~~~~~ + In SrcLoc we store (Maybe BufPos); in SrcSpan we store (Maybe BufSpan). +Index: b/compiler/GHC/Utils/Binary.hs +=================================================================== +--- a/compiler/GHC/Utils/Binary.hs ++++ b/compiler/GHC/Utils/Binary.hs +@@ -1444,19 +1444,6 @@ instance Binary RealSrcSpan where + return (mkRealSrcSpan (mkRealSrcLoc f sl sc) + (mkRealSrcLoc f el ec)) + +-instance Binary BufPos where +- put_ bh (BufPos i) = put_ bh i +- get bh = BufPos <$> get bh +- +-instance Binary BufSpan where +- put_ bh (BufSpan start end) = do +- put_ bh start +- put_ bh end +- get bh = do +- start <- get bh +- end <- get bh +- return (BufSpan start end) +- + instance Binary UnhelpfulSpanReason where + put_ bh r = case r of + UnhelpfulNoLocationInfo -> putByte bh 0 +@@ -1475,10 +1462,11 @@ instance Binary UnhelpfulSpanReason wher + _ -> UnhelpfulOther <$> get bh + + instance Binary SrcSpan where +- put_ bh (RealSrcSpan ss sb) = do ++ put_ bh (RealSrcSpan ss _sb) = do + putByte bh 0 ++ -- BufSpan doesn't ever get serialised because the positions depend ++ -- on build location. + put_ bh ss +- put_ bh sb + + put_ bh (UnhelpfulSpan s) = do + putByte bh 1 +@@ -1488,8 +1476,7 @@ instance Binary SrcSpan where + h <- getByte bh + case h of + 0 -> do ss <- get bh +- sb <- get bh +- return (RealSrcSpan ss sb) ++ return (RealSrcSpan ss Nothing) + _ -> do s <- get bh + return (UnhelpfulSpan s) + diff --git a/buildpath-abi-stability.patch b/buildpath-abi-stability.patch index 7eeee00..07305e9 100644 --- a/buildpath-abi-stability.patch +++ b/buildpath-abi-stability.patch @@ -1,10 +1,10 @@ Forwarded to https://ghc.haskell.org/trac/ghc/ticket/10424 -Index: ghc-8.10.1/compiler/iface/MkIface.hs +Index: b/compiler/GHC/Iface/Recomp.hs =================================================================== ---- ghc-8.10.1.orig/compiler/iface/MkIface.hs -+++ ghc-8.10.1/compiler/iface/MkIface.hs -@@ -679,7 +679,7 @@ +--- a/compiler/GHC/Iface/Recomp.hs ++++ b/compiler/GHC/Iface/Recomp.hs +@@ -1071,7 +1071,7 @@ addFingerprints hsc_env iface0 iface_hash <- computeFingerprint putNameLiterally (mod_hash, ann_fn (mkVarOcc "module"), -- See mkIfaceAnnCache @@ -13,13 +13,12 @@ Index: ghc-8.10.1/compiler/iface/MkIface.hs sorted_deps, mi_hpc iface0) -@@ -714,6 +714,9 @@ +@@ -1106,6 +1106,8 @@ addFingerprints hsc_env iface0 (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0) (non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph (mi_fam_insts iface0) ann_fn = mkIfaceAnnCache (mi_anns iface0) + -- Do not allow filenames to affect the interface + usages = [ case u of UsageFile _ fp -> UsageFile "" fp; _ -> u | u <- mi_usages iface0 ] -+ -- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules -- (in particular, the orphan modules which are transitively imported by the diff --git a/ghc.spec b/ghc.spec index 624df70..4c8610c 100644 --- a/ghc.spec +++ b/ghc.spec @@ -1,46 +1,47 @@ -# disable prof, docs, perf build, debuginfo -# NB This must be disabled (bcond_with) for all koji production builds -%bcond_with quickbuild +# turn off for quick build to disable prof, docs, debuginfo +# This must be enabled 1 for all koji production builds +%bcond prodbuild 1 # make sure ghc libraries' ABI hashes unchanged -%bcond_without abicheck +%bcond abicheck 1 -%global ghc_major 8.10 +%global ghc_major 9.0 # to handle RCs %global ghc_release %{version} -%global base_ver 4.14.3.0 +%global base_ver 4.15.1.0 +%global ghc_compact_ver 0.1.0.0 +%global hpc_ver 0.6.1.0 -# build profiling libraries -# build haddock +# build profiling libraries and haddock documentation # perf production build (disable for quick build) -%if %{with quickbuild} +%if %{with prodbuild} +%bcond ghc_prof 1 +%bcond haddock 1 +%bcond perf_build 1 +%else %undefine with_ghc_prof %undefine with_haddock -%bcond_with perf_build +%bcond perf_build 0 %undefine _enable_debug_packages -%else -%bcond_without ghc_prof -%bcond_without haddock -%bcond_without perf_build %endif # to enable dwarf info (only on intel archs): overrides perf -# default is off: bcond_with +# disabled 0 by default %ifarch x86_64 i686 -%bcond_with dwarf +%bcond dwarf 0 %endif # locked together since disabling haddock causes no manuals built # and disabling haddock still created index.html -# https://ghc.haskell.org/trac/ghc/ticket/15190 -%{?with_haddock:%bcond_without manual} +# https://gitlab.haskell.org/ghc/ghc/-/issues/15190 +%{?with_haddock:%bcond manual 1} # no longer build testsuite (takes time and not really being used) -%bcond_with testsuite +%bcond testsuite 0 -# 8.10 can use llvm 9-12 +# 9.0.2 recommends llvm 9-12 %global llvm_major 12 %global ghc_llvm_archs armv7hl aarch64 @@ -52,7 +53,7 @@ Provides: ghc%{ghc_major}%{?1:-%1} = %{version}-%{release}\ %{nil} Name: ghc -Version: 8.10.7 +Version: 9.0.2 # Since library subpackages are versioned: # - release can only be reset if *all* library versions get bumped simultaneously # (sometimes after a major release) @@ -76,13 +77,15 @@ Patch2: ghc-Cabal-install-PATH-warning.patch Patch3: ghc-gen_contents_index-nodocs.patch # https://phabricator.haskell.org/rGHC4eebc8016f68719e1ccdf460754a97d1f4d6ef05 Patch6: ghc-8.6.3-sphinx-1.8.patch +# https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7689 (from ghc-9.0) +Patch7: 7689.patch # Arch dependent patches # arm Patch12: ghc-armv7-VFPv3D16--NEON.patch # for unregisterized -# https://ghc.haskell.org/trac/ghc/ticket/15689 +# https://gitlab.haskell.org/ghc/ghc/-/issues/15689 Patch15: ghc-warnings.mk-CC-Wall.patch # bigendian (s390x and ppc64) @@ -97,7 +100,9 @@ Patch18: Disable-unboxed-arrays.patch # Debian patches: Patch24: buildpath-abi-stability.patch +Patch25: buildpath-abi-stability-2.patch Patch26: no-missing-haddock-file-warning.patch +Patch27: haddock-remove-googleapis-fonts.patch Patch27: ghc-configure-c99.patch @@ -107,7 +112,7 @@ Patch27: ghc-configure-c99.patch # see also deprecated ghc_arches defined in ghc-srpm-macros # /usr/lib/rpm/macros.d/macros.ghc-srpm -BuildRequires: ghc-compiler > 8.6 +BuildRequires: ghc-compiler > 8.8 # for ABI hash checking %if %{with abicheck} BuildRequires: %{name} @@ -124,7 +129,6 @@ BuildRequires: ghc-template-haskell-devel BuildRequires: ghc-transformers-devel BuildRequires: alex BuildRequires: gmp-devel -BuildRequires: hscolour BuildRequires: libffi-devel BuildRequires: make # for terminfo @@ -146,12 +150,18 @@ BuildRequires: elfutils-devel # patch12 BuildRequires: autoconf, automake %endif -%if %{without quickbuild} +%if %{with prodbuild} #BuildRequires: gnupg2 %endif Requires: %{name}-compiler = %{version}-%{release} Requires: %{name}-devel = %{version}-%{release} Requires: %{name}-ghc-devel = %{version}-%{release} +Requires: %{name}-ghc-boot-devel = %{version}-%{release} +Requires: %{name}-ghc-compact-devel = %{ghc_compact_ver}-%{release} +Requires: %{name}-ghc-heap-devel = %{version}-%{release} +Requires: %{name}-ghci-devel = %{version}-%{release} +Requires: %{name}-hpc-devel = %{hpc_ver}-%{release} +Requires: %{name}-libiserv-devel = %{version}-%{release} %if %{with haddock} Suggests: %{name}-doc = %{version}-%{release} Suggests: %{name}-doc-index = %{version}-%{release} @@ -266,36 +276,37 @@ This package provides the User Guide and Haddock manual. # use "./libraries-versions.sh" to check versions %if %{defined ghclibdir} -%ghc_lib_subpackage -d -l BSD Cabal-3.2.1.0 +%ghc_lib_subpackage -d -l BSD Cabal-3.4.1.0 %ghc_lib_subpackage -d -l %BSDHaskellReport array-0.5.4.0 %ghc_lib_subpackage -d -l %BSDHaskellReport -c gmp-devel%{?_isa},libffi-devel%{?_isa} base-%{base_ver} %ghc_lib_subpackage -d -l BSD binary-0.8.8.0 -%ghc_lib_subpackage -d -l BSD bytestring-0.10.12.0 -%ghc_lib_subpackage -d -l %BSDHaskellReport containers-0.6.5.1 -%ghc_lib_subpackage -d -l %BSDHaskellReport deepseq-1.4.4.0 -%ghc_lib_subpackage -d -l %BSDHaskellReport directory-1.3.6.0 +%ghc_lib_subpackage -d -l BSD bytestring-0.10.12.1 +%ghc_lib_subpackage -d -l %BSDHaskellReport containers-0.6.4.1 +%ghc_lib_subpackage -d -l %BSDHaskellReport deepseq-1.4.5.0 +%ghc_lib_subpackage -d -l %BSDHaskellReport directory-1.3.6.2 %ghc_lib_subpackage -d -l %BSDHaskellReport exceptions-0.10.4 %ghc_lib_subpackage -d -l BSD filepath-1.4.2.1 # in ghc not ghc-libraries: %ghc_lib_subpackage -d -x ghc-%{ghc_version_override} +# see below for ghc-bignum %ghc_lib_subpackage -d -x -l BSD ghc-boot-%{ghc_version_override} %ghc_lib_subpackage -d -l BSD ghc-boot-th-%{ghc_version_override} -%ghc_lib_subpackage -d -l BSD ghc-compact-0.1.0.0 -%ghc_lib_subpackage -d -l BSD ghc-heap-%{ghc_version_override} +%ghc_lib_subpackage -d -x -l BSD ghc-compact-%{ghc_compact_ver} +%ghc_lib_subpackage -d -x -l BSD ghc-heap-%{ghc_version_override} # see below for ghc-prim -%ghc_lib_subpackage -d -l BSD -x ghci-%{ghc_version_override} +%ghc_lib_subpackage -d -x -l BSD ghci-%{ghc_version_override} %ghc_lib_subpackage -d -l BSD haskeline-0.8.2 -%ghc_lib_subpackage -d -l BSD hpc-0.6.1.0 +%ghc_lib_subpackage -d -x -l BSD hpc-%{hpc_ver} # see below for integer-gmp -%ghc_lib_subpackage -d -l %BSDHaskellReport libiserv-%{ghc_version_override} +%ghc_lib_subpackage -d -x -l %BSDHaskellReport libiserv-%{ghc_version_override} %ghc_lib_subpackage -d -l BSD mtl-2.2.2 %ghc_lib_subpackage -d -l BSD parsec-3.1.14.0 %ghc_lib_subpackage -d -l BSD pretty-1.1.3.6 %ghc_lib_subpackage -d -l %BSDHaskellReport process-1.6.13.2 -%ghc_lib_subpackage -d -l BSD stm-2.5.0.1 -%ghc_lib_subpackage -d -l BSD template-haskell-2.16.0.0 -%ghc_lib_subpackage -d -l BSD -c ncurses-devel%{?_isa} terminfo-0.4.1.4 -%ghc_lib_subpackage -d -l BSD text-1.2.4.1 +%ghc_lib_subpackage -d -l BSD stm-2.5.0.0 +%ghc_lib_subpackage -d -l BSD template-haskell-2.17.0.0 +%ghc_lib_subpackage -d -l BSD -c ncurses-devel%{?_isa} terminfo-0.4.1.5 +%ghc_lib_subpackage -d -l BSD text-1.2.5.0 %ghc_lib_subpackage -d -l BSD time-1.9.3 %ghc_lib_subpackage -d -l BSD transformers-0.5.6.2 %ghc_lib_subpackage -d -l BSD unix-2.7.2.2 @@ -334,16 +345,19 @@ Installing this package causes %{name}-*-prof packages corresponding to %prep -%if %{without quickbuild} +%if %{with prodbuild} #%%{gpgverify} --keyring='%{SOURCE3}' --signature='%{SOURCE2}' --data='%{SOURCE0}' %endif %setup -q -n ghc-%{version} %{?with_testsuite:-b1} +# ghc-9.0.2 release anomaly +rm -r libraries/containers/containers/dist-install %patch1 -p1 -b .orig %patch3 -p1 -b .orig %patch2 -p1 -b .orig %patch6 -p1 -b .orig +%patch7 -p1 -b .orig rm -r libffi-tarballs @@ -351,7 +365,7 @@ rm -r libffi-tarballs %patch12 -p1 -b .orig12 %endif -# remove s390x after switching to llvm +# remove s390x after complete switching to llvm %ifarch %{ghc_unregisterized_arches} s390x %patch15 -p1 -b .orig %endif @@ -363,7 +377,9 @@ rm -r libffi-tarballs # debian %patch24 -p1 -b .orig +%patch25 -p1 -b .orig %patch26 -p1 -b .orig +%patch27 -p1 -b .orig %patch27 -p1 @@ -456,52 +472,61 @@ sed -i -e 's!^library-dirs: %{ghclibdir}/rts!&\ndynamic-library-dirs: %{_ghcdynl # containers src moved to a subdir cp -p libraries/containers/containers/LICENSE libraries/containers/LICENSE -# libraries licenses -rm %{buildroot}%{ghc_html_libraries_dir}/{ghc-prim,integer-gmp}-*/LICENSE -mkdir -p %{buildroot}%{_ghclicensedir} -for i in $(cd %{buildroot}%{ghc_html_libraries_dir}; ls */LICENSE); do - pkg=$(dirname $i | sed -e "s/\\(.*\\)-.*/\\1/") - mkdir %{buildroot}%{_ghclicensedir}/ghc-$pkg - mv %{buildroot}%{ghc_html_libraries_dir}/$i %{buildroot}%{_ghclicensedir}/ghc-$pkg/ -done - +# FIXME replace with ghc_subpackages_list for i in %{ghc_packages_list}; do name=$(echo $i | sed -e "s/\(.*\)-.*/\1/") ver=$(echo $i | sed -e "s/.*-\(.*\)/\1/") %ghc_gen_filelists $name $ver +echo "%%license libraries/$name/LICENSE" >> %{name}-$name.files done -echo "%%dir %{ghclibdir}" >> ghc-base%{?_ghcdynlibdir:-devel}.files -echo "%{ghclibdir}/include" >> ghc-base-devel.files +echo "%%dir %{ghclibdir}" >> %{name}-base%{?_ghcdynlibdir:-devel}.files %ghc_gen_filelists ghc %{ghc_version_override} %ghc_gen_filelists ghc-boot %{ghc_version_override} +%ghc_gen_filelists ghc-compact %{ghc_compact_ver} +%ghc_gen_filelists ghc-heap %{ghc_version_override} %ghc_gen_filelists ghci %{ghc_version_override} +%ghc_gen_filelists hpc %{hpc_ver} +%ghc_gen_filelists libiserv %{ghc_version_override} -%ghc_gen_filelists ghc-prim 0.6.1 -%ghc_gen_filelists integer-gmp 1.0.3.0 +%ghc_gen_filelists ghc-bignum 1.1 +%ghc_gen_filelists ghc-prim 0.7.0 +%ghc_gen_filelists integer-gmp 1.1 %define merge_filelist()\ +cat %{name}-%1.files >> %{name}-%2.files\ +cat %{name}-%1-devel.files >> %{name}-%2-devel.files\ +%if %{defined ghc_devel_prof}\ +cat %{name}-%1-doc.files >> %{name}-%2-doc.files\ +cat %{name}-%1-prof.files >> %{name}-%2-prof.files\ +%endif\ cp -p libraries/%1/LICENSE libraries/LICENSE.%1\ -echo "%%license libraries/LICENSE.%1" >> ghc-%2.files\ -cat ghc-%1.files >> ghc-%2.files\ -for i in devel doc prof; do\ - cat ghc-%1-$i.files >> ghc-%2-$i.files\ -done +echo "%%license libraries/LICENSE.%1" >> %{name}-%2.files\ +%{nil} +%merge_filelist ghc-bignum base %merge_filelist ghc-prim base %merge_filelist integer-gmp base # add rts libs -rm -f rts.files -touch rts.files -ls %{buildroot}%{?_ghcdynlibdir}%{!?_ghcdynlibdir:%{ghclibdir}/rts}/libHSrts*-ghc%{ghc_version}.so >> rts.files -find %{buildroot}%{ghclibdir}/rts -type d -fprintf rts-devel.files '%%%%dir %p\n' -o -name 'libHSrts*_p.a' -fprint rts-prof.files -o -fprint rts-devel.files -echo "%{ghclibdir}/package.conf.d/rts.conf" >> rts-devel.files -sed -i -e "s!%{buildroot}!!g" rts.files rts-devel.files rts-prof.files -cat rts.files >> ghc-base.files -cat rts-devel.files >> ghc-base-devel.files -cat rts-prof.files >> ghc-base-prof.files +%if %{defined _ghcdynlibdir} +echo "%{ghclibdir}/rts" >> %{name}-base-devel.files +%else +echo "%%dir %{ghclibdir}/rts" >> %{name}-base.files +ls -d %{buildroot}%{ghclibdir}/rts/lib*.a >> %{name}-base-devel.files +%endif +ls %{buildroot}%{?_ghcdynlibdir}%{!?_ghcdynlibdir:%{ghclibdir}/rts}/libHSrts*.so >> %{name}-base.files +%if %{defined _ghcdynlibdir} +sed -i -e 's!^library-dirs: %{ghclibdir}/rts!&\ndynamic-library-dirs: %{_libdir}!' %{buildroot}%{ghclibdir}/package.conf.d/rts.conf +%endif +ls -d %{buildroot}%{ghclibdir}/package.conf.d/rts.conf %{buildroot}%{ghclibdir}/include >> %{name}-base-devel.files + +%if %{with ghc_prof} +ls %{buildroot}%{ghclibdir}/bin/ghc-iserv-prof* >> %{name}-base-prof.files +%endif + +sed -i -e "s|^%{buildroot}||g" %{name}-base*.files %if %{with haddock} # generate initial lib doc index @@ -510,6 +535,9 @@ sh %{gen_contents_index} --intree --verbose cd .. %endif +# we package the library license files separately +find %{buildroot}%{ghc_html_libraries_dir} -name LICENSE -exec rm '{}' ';' + mkdir -p %{buildroot}%{_mandir}/man1 install -p -m 0644 %{SOURCE5} %{buildroot}%{_mandir}/man1/ghc-pkg.1 install -p -m 0644 %{SOURCE6} %{buildroot}%{_mandir}/man1/haddock.1 @@ -616,14 +644,14 @@ env -C %{ghc_html_libraries_dir} ./gen_contents_index %{_bindir}/runhaskell %dir %{ghclibdir}/bin %{ghclibdir}/bin/ghc -%{ghclibdir}/bin/ghc-pkg -%{ghclibdir}/bin/hpc -%{ghclibdir}/bin/hsc2hs %{ghclibdir}/bin/ghc-iserv %{ghclibdir}/bin/ghc-iserv-dyn %if %{with ghc_prof} %{ghclibdir}/bin/ghc-iserv-prof %endif +%{ghclibdir}/bin/ghc-pkg +%{ghclibdir}/bin/hpc +%{ghclibdir}/bin/hsc2hs %{ghclibdir}/bin/runghc %{ghclibdir}/bin/hp2ps %{ghclibdir}/bin/unlit @@ -690,6 +718,13 @@ env -C %{ghc_html_libraries_dir} ./gen_contents_index %changelog +* Sun Jan 15 2023 Jens Petersen - 9.0.2-124 +- rebase to 9.0.2 from ghc9.0 +- https://downloads.haskell.org/~ghc/9.0.2/docs/html/users_guide/9.0.1-notes.html +- https://downloads.haskell.org/~ghc/9.0.2/docs/html/users_guide/9.0.2-notes.html +- add buildpath-abi-stability-2.patch and haddock-remove-googleapis-fonts.patch + from Debian + * Thu Jan 12 2023 Florian Weimer - 8.10.7-123 - Port configure script to C99 diff --git a/haddock-remove-googleapis-fonts.patch b/haddock-remove-googleapis-fonts.patch new file mode 100644 index 0000000..1429063 --- /dev/null +++ b/haddock-remove-googleapis-fonts.patch @@ -0,0 +1,26 @@ +Description: Remove hard-coded googleapis font URL +Bug: https://github.com/haskell/haddock/issues/1211 +Bug-Debian: https://bugs.debian.org/963690 + +Index: b/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs +=================================================================== +--- a/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs ++++ b/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs +@@ -137,7 +137,7 @@ headHtml docTitle themes mathjax_url bas + , thetype "text/css" + , href (withBaseURL base_url quickJumpCssFile) ] + << noHtml +- , thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml ++ -- , thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml + , script ! [ src (withBaseURL base_url haddockJsFile) + , emptyAttr "async" + , thetype "text/javascript" ] +@@ -146,7 +146,7 @@ headHtml docTitle themes mathjax_url bas + , script ! [src mjUrl, thetype "text/javascript"] << noHtml + ] + where +- fontUrl = "https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" ++ -- fontUrl = "https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" + mjUrl = fromMaybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" mathjax_url + mjConf = unwords [ "MathJax.Hub.Config({" + , "tex2jax: {" diff --git a/sources b/sources index 71768bc..620432a 100644 --- a/sources +++ b/sources @@ -1,2 +1,2 @@ -SHA512 (ghc-8.10.7-src.tar.xz) = eaf35de6da9b196f1e26bbbb681d60e4fe5f94a9e2af265a1ea5b5aef8ad2b10848ff946eb61d128095002624aced52c01c7f8cf1d72fd9120b8cc7762ddc3c3 -SHA512 (ghc-8.10.7-src.tar.xz.sig) = 13dcbb85d1b10c9dba0333fddb8475406bfb8c64661bac779ae3d967c93e18db43e1a7ae35422c10d6d00e76b6bbb23895011e2cda9d9a54706620266b2ba2b5 +SHA512 (ghc-9.0.2-src.tar.xz) = 32994c7d2b8f47bae604cd825bfcf9c788d79ce26d1d5f58bd73a7093e11ae6c3c17b31dc0c9e454dbf67ca169b942f92213c388d615768cae86055bf6094dee +SHA512 (ghc-9.0.2-src.tar.xz.sig) = 6da554bcd96bd3bf99c98a48f8eaade9155d7528097b58b844b5e9de8af8320a4402bce5b0549d12583a08033b77432cc429231437221bd412748b5833a6569c