diff options
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build-system/go.scm | 11 | ||||
-rw-r--r-- | guix/build-system/r.scm | 2 | ||||
-rw-r--r-- | guix/channels.scm | 3 | ||||
-rw-r--r-- | guix/grafts.scm | 43 | ||||
-rw-r--r-- | guix/import/cran.scm | 4 | ||||
-rw-r--r-- | guix/packages.scm | 7 | ||||
-rw-r--r-- | guix/profiles.scm | 49 | ||||
-rw-r--r-- | guix/scripts/environment.scm | 35 | ||||
-rw-r--r-- | guix/utils.scm | 7 |
9 files changed, 94 insertions, 67 deletions
diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm index 0a9761aac7..0934fded07 100644 --- a/guix/build-system/go.scm +++ b/guix/build-system/go.scm @@ -3,7 +3,7 @@ ;;; Copyright © 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> ;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2021 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2021, 2023 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; ;;; This file is part of GNU Guix. @@ -114,12 +114,19 @@ commit hash and its date rather than a proper release tag." (let ((go (resolve-interface '(gnu packages golang)))) (module-ref go 'go))) +(define (default-gccgo) + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((gcc (resolve-interface '(gnu packages gcc)))) + (module-ref gcc 'gccgo-12))) + (define (make-go-std) (module-ref (resolve-interface '(gnu packages golang)) 'make-go-std)) (define* (lower name #:key source inputs native-inputs outputs system target - (go (default-go)) + (go (if (supported-package? (default-go)) + (default-go) + (default-gccgo))) #:allow-other-keys #:rest arguments) "Return a bag for NAME." diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm index 657346bea3..7ab4db82b6 100644 --- a/guix/build-system/r.scm +++ b/guix/build-system/r.scm @@ -60,7 +60,7 @@ release corresponding to NAME and VERSION." "/src/contrib/" name "_" version ".tar.gz") ;; TODO: use %bioconductor-version from (guix import cran) - (string-append "https://bioconductor.org/packages/3.17" + (string-append "https://bioconductor.org/packages/3.18" type-url-part "/src/contrib/" name "_" version ".tar.gz")))) diff --git a/guix/channels.scm b/guix/channels.scm index 681adafc6c..f01903642d 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -926,7 +926,7 @@ specified." (entries -> (map instance->entry instances derivations))) (return (manifest entries)))) -(define (package-cache-file manifest) +(define* (package-cache-file manifest #:optional system) "Build a package cache file for the instance in MANIFEST. This is meant to be used as a profile hook." ;; Note: Emit a profile in format version 3, which was introduced in 2017 @@ -961,6 +961,7 @@ be used as a profile hook." (gexp->derivation-in-inferior "guix-package-cache" build profile + #:system system ;; If the Guix in PROFILE is too old and ;; lacks 'guix repl', don't build the cache diff --git a/guix/grafts.scm b/guix/grafts.scm index f93da32981..48f4c212f7 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -176,11 +176,8 @@ references." (append-map (cut references/cached store <>) items)))) (append-map (cut references/cached store <>) items))) - (let ((refs (references* (map (cut derivation->output-path drv <>) - outputs))) - (self (match (derivation->output-paths drv) - (((names . items) ...) - items)))) + (let* ((self (map (cut derivation->output-path drv <>) outputs)) + (refs (references* self))) (remove (cut member <> self) refs))) (define %graft-cache @@ -207,7 +204,7 @@ references." (return result))))))) (define (reference-origins drv items) - "Return the derivation/output pairs among the inputs of DRV, recursively, + "Return the derivation/output pairs among DRV and its inputs, recursively, that produce ITEMS. Elements of ITEMS not produced by a derivation (i.e., it's a content-addressed \"source\"), or not produced by a dependency of DRV, have no corresponding element in the resulting list." @@ -238,13 +235,10 @@ have no corresponding element in the resulting list." ((set-contains? visited drv) (loop rest items result visited)) (else - (let* ((inputs - (map derivation-input-derivation - (derivation-inputs drv))) - (result items - (fold2 lookup-derivers - result items inputs))) - (loop (append rest inputs) + (let ((result items (lookup-derivers drv result items))) + (loop (append rest + (map derivation-input-derivation + (derivation-inputs drv))) items result (set-insert drv visited))))))))) @@ -258,16 +252,17 @@ GRAFTS to the dependencies of DRV. Return the resulting list of grafts. This is a monadic procedure in %STATE-MONAD where the state is a vhash mapping derivations to the corresponding set of grafts." - (define (graft-origin? drv graft) - ;; Return true if DRV corresponds to the origin of GRAFT. + (define (graft-origin? drv output graft) + ;; Return true if DRV and OUTPUT correspond to the origin of GRAFT. (match graft - (($ <graft> (? derivation? origin) output) - (match (assoc-ref (derivation->output-paths drv) output) - ((? string? result) - (string=? result - (derivation->output-path origin output))) - (_ - #f))) + (($ <graft> (? derivation? origin) origin-output) + (and (string=? origin-output output) + (match (assoc-ref (derivation->output-paths drv) output) + ((? string? result) + (string=? result + (derivation->output-path origin output))) + (_ + #f)))) (_ #f))) @@ -278,7 +273,7 @@ derivations to the corresponding set of grafts." ((drv . output) ;; If GRAFTS already contains a graft from DRV, do not ;; override it. - (if (find (cut graft-origin? drv <>) grafts) + (if (find (cut graft-origin? drv output <>) grafts) (state-return grafts) (cumulative-grafts store drv grafts #:outputs (list output) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 59c65f9fa5..ca984cb49c 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -181,9 +181,9 @@ package definition." (define %cran-canonical-url "https://cran.r-project.org/package=") (define %bioconductor-url "https://bioconductor.org/packages/") -;; The latest Bioconductor release is 3.17. Bioconductor packages should be +;; The latest Bioconductor release is 3.18. Bioconductor packages should be ;; updated together. -(define %bioconductor-version "3.17") +(define %bioconductor-version "3.18") (define* (bioconductor-packages-list-url #:optional type) (string-append "https://bioconductor.org/packages/" diff --git a/guix/packages.scm b/guix/packages.scm index f70fad695e..e2e82692ad 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -2022,11 +2022,12 @@ symbolic output name, such as \"out\". Note that this procedure calls ;;; Monadic interface. ;;; -(define (set-guile-for-build guile) +(define* (set-guile-for-build guile #:optional system) "This monadic procedure changes the Guile currently used to run the build -code of derivations to GUILE, a package object." +code of derivations to GUILE, a package object, compiled for SYSTEM." (lambda (store) - (let ((guile (package-derivation store guile))) + (let ((guile (package-derivation store guile + (or system (%current-system))))) (values (%guile-for-build guile) store)))) (define* (package-file package diff --git a/guix/profiles.scm b/guix/profiles.scm index c88672c25a..031f1f59c6 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -993,7 +993,7 @@ if not found." (anym %store-monad entry-lookup-package (manifest-entries manifest))) -(define (info-dir-file manifest) +(define* (info-dir-file manifest #:optional system) "Return a derivation that builds the 'dir' file for all the entries of MANIFEST." (define texinfo ;lazy reference @@ -1051,13 +1051,14 @@ MANIFEST." '#$(manifest-inputs manifest))))))) (gexp->derivation "info-dir" build + #:system system #:local-build? #t #:substitutable? #f #:properties `((type . profile-hook) (hook . info-dir)))) -(define (ghc-package-cache-file manifest) +(define* (ghc-package-cache-file manifest #:optional system) "Return a derivation that builds the GHC 'package.cache' file for all the entries of MANIFEST, or #f if MANIFEST does not have any GHC packages." (define ghc ;lazy reference @@ -1108,6 +1109,7 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages." (if (any (cut string-prefix? "ghc" <>) (map manifest-entry-name (manifest-entries manifest))) (gexp->derivation "ghc-package-cache" build + #:system system #:local-build? #t #:substitutable? #f #:properties @@ -1115,7 +1117,7 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages." (hook . ghc-package-cache))) (return #f)))) -(define (ca-certificate-bundle manifest) +(define* (ca-certificate-bundle manifest #:optional system) "Return a derivation that builds a single-file bundle containing the CA certificates in the /etc/ssl/certs sub-directories of the packages in MANIFEST. Single-file bundles are required by programs such as Git and Lynx." @@ -1179,13 +1181,14 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx." #t)))))) (gexp->derivation "ca-certificate-bundle" build + #:system system #:local-build? #t #:substitutable? #f #:properties `((type . profile-hook) (hook . ca-certificate-bundle)))) -(define (emacs-subdirs manifest) +(define* (emacs-subdirs manifest #:optional system) (define build (with-imported-modules (source-module-closure '((guix build profiles) @@ -1219,13 +1222,14 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx." (newline port) #t))))))) (gexp->derivation "emacs-subdirs" build + #:system system #:local-build? #t #:substitutable? #f #:properties `((type . profile-hook) (hook . emacs-subdirs)))) -(define (gdk-pixbuf-loaders-cache-file manifest) +(define* (gdk-pixbuf-loaders-cache-file manifest #:optional system) "Return a derivation that produces a loaders cache file for every gdk-pixbuf loaders discovered in MANIFEST." (define gdk-pixbuf ;lazy reference @@ -1264,6 +1268,7 @@ loaders discovered in MANIFEST." (if gdk-pixbuf (gexp->derivation "gdk-pixbuf-loaders-cache-file" build + #:system system #:local-build? #t #:substitutable? #f #:properties @@ -1271,7 +1276,7 @@ loaders discovered in MANIFEST." (hook . gdk-pixbuf-loaders-cache-file))) (return #f)))) -(define (glib-schemas manifest) +(define* (glib-schemas manifest #:optional system) "Return a derivation that unions all schemas from manifest entries and creates the Glib 'gschemas.compiled' file." (define glib ; lazy reference @@ -1318,6 +1323,7 @@ creates the Glib 'gschemas.compiled' file." ;; Don't run the hook when there's nothing to do. (if %glib (gexp->derivation "glib-schemas" build + #:system system #:local-build? #t #:substitutable? #f #:properties @@ -1325,7 +1331,7 @@ creates the Glib 'gschemas.compiled' file." (hook . glib-schemas))) (return #f)))) -(define (gtk-icon-themes manifest) +(define* (gtk-icon-themes manifest #:optional system) "Return a derivation that unions all icon themes from manifest entries and creates the GTK+ 'icon-theme.cache' file for each theme." (define gtk+ ; lazy reference @@ -1377,6 +1383,7 @@ creates the GTK+ 'icon-theme.cache' file for each theme." ;; Don't run the hook when there's nothing to do. (if %gtk+ (gexp->derivation "gtk-icon-themes" build + #:system system #:local-build? #t #:substitutable? #f #:properties @@ -1384,7 +1391,7 @@ creates the GTK+ 'icon-theme.cache' file for each theme." (hook . gtk-icon-themes))) (return #f)))) -(define (gtk-im-modules manifest) +(define* (gtk-im-modules manifest #:optional system) "Return a derivation that builds the cache files for input method modules for both major versions of GTK+." @@ -1454,6 +1461,7 @@ for both major versions of GTK+." #t)))) (if (or gtk+ gtk+-2) (gexp->derivation "gtk-im-modules" gexp + #:system system #:local-build? #t #:substitutable? #f #:properties @@ -1461,7 +1469,7 @@ for both major versions of GTK+." (hook . gtk-im-modules))) (return #f))))) -(define (linux-module-database manifest) +(define* (linux-module-database manifest #:optional system) "Return a derivation that unites all the kernel modules of the manifest and creates the dependency graph of all these kernel modules. @@ -1511,13 +1519,14 @@ This is meant to be used as a profile hook." (_ (error "Specified Linux kernel and Linux kernel modules are not all of the same version")))))))) (gexp->derivation "linux-module-database" build + #:system system #:local-build? #t #:substitutable? #f #:properties `((type . profile-hook) (hook . linux-module-database)))) -(define (xdg-desktop-database manifest) +(define* (xdg-desktop-database manifest #:optional system) "Return a derivation that builds the @file{mimeinfo.cache} database from desktop files. It's used to query what applications can handle a given MIME type." @@ -1551,6 +1560,7 @@ MIME type." ;; Don't run the hook when 'glib' is not referenced. (if glib (gexp->derivation "xdg-desktop-database" build + #:system system #:local-build? #t #:substitutable? #f #:properties @@ -1558,7 +1568,7 @@ MIME type." (hook . xdg-desktop-database))) (return #f)))) -(define (xdg-mime-database manifest) +(define* (xdg-mime-database manifest #:optional system) "Return a derivation that builds the @file{mime.cache} database from manifest entries. It's used to query the MIME type of a given file." (define shared-mime-info ; lazy reference @@ -1605,6 +1615,7 @@ entries. It's used to query the MIME type of a given file." ;; Don't run the hook when there are no GLib based applications. (if glib (gexp->derivation "xdg-mime-database" build + #:system system #:local-build? #t #:substitutable? #f #:properties @@ -1615,7 +1626,7 @@ entries. It's used to query the MIME type of a given file." ;; Several font packages may install font files into same directory, so ;; fonts.dir and fonts.scale file should be generated here, instead of in ;; packages. -(define (fonts-dir-file manifest) +(define* (fonts-dir-file manifest #:optional system) "Return a derivation that builds the @file{fonts.dir} and @file{fonts.scale} files for the fonts of the @var{manifest} entries." (define mkfontscale @@ -1676,6 +1687,7 @@ files for the fonts of the @var{manifest} entries." directories))))))) (gexp->derivation "fonts-dir" build + #:system system #:modules '((guix build utils) (guix build union) (srfi srfi-26)) @@ -1685,7 +1697,7 @@ files for the fonts of the @var{manifest} entries." `((type . profile-hook) (hook . fonts-dir)))) -(define (manual-database manifest) +(define* (manual-database manifest #:optional system) "Return a derivation that builds the manual page database (\"mandb\") for the entries in MANIFEST." (define gdbm-ffi @@ -1761,23 +1773,24 @@ the entries in MANIFEST." (force-output)))))) (gexp->derivation "manual-database" build + #:system system #:substitutable? #f #:local-build? #t #:properties `((type . profile-hook) (hook . manual-database)))) -(define (manual-database/optional manifest) +(define* (manual-database/optional manifest #:optional system) "Return a derivation to build the manual database of MANIFEST, but only if MANIFEST contains the \"man-db\" package. Otherwise, return #f." ;; Building the man database (for "man -k") is expensive and rarely used. ;; Build it only if the profile also contains "man-db". (mlet %store-monad ((man-db (manifest-lookup-package manifest "man-db"))) (if man-db - (manual-database manifest) + (manual-database manifest system) (return #f)))) -(define (texlive-font-maps manifest) +(define* (texlive-font-maps manifest #:optional system) "Return a derivation that builds the TeX Live font maps for the entries in MANIFEST." (define entry->texlive-input @@ -1898,6 +1911,7 @@ MANIFEST." ;; incomplete modular TeX Live installations to generate errors. (if (any texlive-scripts-entry? (manifest-entries manifest)) (gexp->derivation "texlive-font-maps" build + #:system system #:substitutable? #f #:local-build? #t #:properties @@ -1977,7 +1991,8 @@ are cross-built for TARGET." (extras (if (null? (manifest-entries manifest)) (return '()) (mapm/accumulate-builds (lambda (hook) - (hook manifest)) + (hook manifest + system)) hooks)))) (define extra-inputs (filter-map (lambda (drv) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 9712389842..6ae3b11e39 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -1100,17 +1100,18 @@ command-line option processing with 'parse-command-line'." ;; Evaluate EXP... with STORE bound to a connection, unless ;; STORE-NEEDED? is false, in which case STORE is bound to #f. (let ((proc (lambda (store) exp ...))) - (if store-needed? - (with-store s - (set-build-options-from-command-line s opts) - (with-build-handler (build-notifier #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:verbosity - (assoc-ref opts 'verbosity) - #:dry-run? - (assoc-ref opts 'dry-run?)) - (proc s))) - (proc #f)))) + (parameterize ((%graft? (assoc-ref opts 'graft?))) + (if store-needed? + (with-store s + (set-build-options-from-command-line s opts) + (with-build-handler (build-notifier #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:verbosity + (assoc-ref opts 'verbosity) + #:dry-run? + (assoc-ref opts 'dry-run?)) + (proc s))) + (proc #f))))) (when container? (assert-container-features)) @@ -1122,11 +1123,11 @@ command-line option processing with 'parse-command-line'." (when no-cwd? (leave (G_ "--no-cwd cannot be used without '--container'~%"))) (when emulate-fhs? - (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'"))) + (leave (G_ "'--emulate-fhs' cannot be used without '--container'~%"))) (when nesting? - (leave (G_ "'--nesting' cannot be used without '--container~%'"))) + (leave (G_ "'--nesting' cannot be used without '--container'~%"))) (when (pair? symlinks) - (leave (G_ "'--symlink' cannot be used without '--container~%'")))) + (leave (G_ "'--symlink' cannot be used without '--container'~%")))) (with-store/maybe store (with-status-verbosity (assoc-ref opts 'verbosity) @@ -1146,14 +1147,14 @@ command-line option processing with 'parse-command-line'." (warning (G_ "no packages specified; creating an empty environment~%"))) ;; Use the bootstrap Guile when requested. - (parameterize ((%graft? (assoc-ref opts 'graft?)) - (%guile-for-build + (parameterize ((%guile-for-build (and store-needed? (package-derivation store (if bootstrap? %bootstrap-guile - (default-guile)))))) + (default-guile)) + system)))) (run-with-store store ;; Containers need a Bourne shell at /bin/sh. (mlet* %store-monad ((bash (environment-bash container? diff --git a/guix/utils.scm b/guix/utils.scm index e9af33bdeb..7a42b49df2 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -18,6 +18,7 @@ ;;; Copyright © 2022 Antero Mejr <antero@mailbox.org> ;;; Copyright © 2023 Philip McGrath <philip@philipmcgrath.com> ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2023 Zheng Junjie <873216071@qq.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -111,6 +112,7 @@ cxx-for-target ld-for-target pkg-config-for-target + strip-for-target version-compare version>? @@ -784,6 +786,11 @@ architecture (x86_64)?" (string-append target "-pkg-config") "pkg-config")) +(define* (strip-for-target #:optional (target (%current-target-system))) + (if target + (string-append target "-strip") + "strip")) + (define version-compare (let ((strverscmp (let ((sym (or (dynamic-func "strverscmp" (dynamic-link)) |