diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-12-05 17:57:35 +0100 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-12-05 17:57:35 +0100 |
commit | 9d5aa009062a49bd035ae33e37f6562526e7d38c (patch) | |
tree | 4ff2302863a5cf9f3cf604240ea793152156f532 /guix/build | |
parent | 60bd56c6d8368c23dcd97b26501771c82316fc8c (diff) | |
parent | 2c2fc24b899d3286774f60405888718d98211213 (diff) |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/build')
-rw-r--r-- | guix/build/ant-build-system.scm | 15 | ||||
-rw-r--r-- | guix/build/cargo-build-system.scm | 15 | ||||
-rw-r--r-- | guix/build/cargo-utils.scm | 16 | ||||
-rw-r--r-- | guix/build/compile.scm | 49 | ||||
-rw-r--r-- | guix/build/download.scm | 13 | ||||
-rw-r--r-- | guix/build/emacs-build-system.scm | 81 | ||||
-rw-r--r-- | guix/build/qt-build-system.scm | 109 | ||||
-rw-r--r-- | guix/build/qt-utils.scm | 4 | ||||
-rw-r--r-- | guix/build/syscalls.scm | 4 |
9 files changed, 202 insertions, 104 deletions
diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm index 49549c1b4b..fae1b47ec5 100644 --- a/guix/build/ant-build-system.scm +++ b/guix/build/ant-build-system.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2019 Björn Höfling <bjoern.hoefling@bjoernhoefling.de> ;;; ;;; This file is part of GNU Guix. ;;; @@ -171,6 +172,12 @@ to the default GNU unpack strategy." #:allow-other-keys) (apply invoke `("ant" ,build-target ,@make-flags))) +(define (regular-jar-file-predicate file stat) + "Predicate returning true if FILE is ending on '.jar' +and STAT indicates it is a regular file." + (and ((file-name-predicate "\\.jar$") file stat) + (eq? 'regular (stat:type stat)))) + (define* (generate-jar-indices #:key outputs #:allow-other-keys) "Generate file \"META-INF/INDEX.LIST\". This file does not use word wraps and is preferred over \"META-INF/MANIFEST.MF\", which does use word wraps, @@ -181,7 +188,10 @@ dependencies of this jar file." (invoke "jar" "-i" jar)) (for-each (match-lambda ((output . directory) - (for-each generate-index (find-files directory "\\.jar$")))) + (for-each generate-index + (find-files + directory + regular-jar-file-predicate)))) outputs) #t) @@ -222,7 +232,8 @@ repack them. This is necessary to ensure that archives are reproducible." (for-each (match-lambda ((output . directory) - (for-each repack-archive (find-files directory "\\.jar$")))) + (for-each repack-archive + (find-files directory regular-jar-file-predicate)))) outputs) #t) diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index 4be5443083..8a8d74ee1b 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -40,21 +40,6 @@ ;; ;; Code: -;; TODO: Move this to (guix build cargo-utils). Will cause a full rebuild -;; of all rust compilers. - -(define (generate-all-checksums dir-name) - (for-each - (lambda (filename) - (let* ((dir (dirname filename)) - (checksum-file (string-append dir "/.cargo-checksum.json"))) - (when (file-exists? checksum-file) (delete-file checksum-file)) - (display (string-append - "patch-cargo-checksums: generate-checksums for " - dir "\n")) - (generate-checksums dir))) - (find-files dir-name "Cargo.toml$"))) - (define (manifest-targets) "Extract all targets from the Cargo.toml manifest" (let* ((port (open-input-pipe "cargo read-manifest")) diff --git a/guix/build/cargo-utils.scm b/guix/build/cargo-utils.scm index 79e5440378..5ac429a62a 100644 --- a/guix/build/cargo-utils.scm +++ b/guix/build/cargo-utils.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2019 Ivan Petkov <ivanppetkov@gmail.com> +;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +23,8 @@ #:use-module (guix build utils) #:use-module (ice-9 popen) #:use-module (ice-9 rdelim) - #:export (generate-checksums)) + #:export (generate-checksums + generate-all-checksums)) ;; Commentary: ;; @@ -66,3 +68,15 @@ the same directory." (display "},\"package\":" port) (write (file-sha256 "/dev/null") port) (display "}" port))))) + +(define (generate-all-checksums dir-name) + (for-each + (lambda (filename) + (let* ((dir (dirname filename)) + (checksum-file (string-append dir "/.cargo-checksum.json"))) + (when (file-exists? checksum-file) (delete-file checksum-file)) + (display (string-append + "patch-cargo-checksums: generate-checksums for " + dir "\n")) + (generate-checksums dir))) + (find-files dir-name "Cargo.toml$"))) diff --git a/guix/build/compile.scm b/guix/build/compile.scm index 06ed57c9d7..3781e148ce 100644 --- a/guix/build/compile.scm +++ b/guix/build/compile.scm @@ -39,25 +39,32 @@ ;;; ;;; Code: -(define %default-optimizations - ;; Default optimization options (equivalent to -O2 on Guile 2.2). - (append (if (defined? 'tree-il-default-optimization-options) - (tree-il-default-optimization-options) ;Guile 2.2 - (tree-il-optimizations)) ;Guile 3 - (if (defined? 'cps-default-optimization-options) - (cps-default-optimization-options) ;Guile 2.2 - (cps-optimizations)))) ;Guile 3 - -(define %lightweight-optimizations - ;; Lightweight optimizations (like -O0, but with partial evaluation). - (let loop ((opts %default-optimizations) - (result '())) - (match opts - (() (reverse result)) - ((#:partial-eval? _ rest ...) - (loop rest `(#t #:partial-eval? ,@result))) - ((kw _ rest ...) - (loop rest `(#f ,kw ,@result)))))) +(define optimizations-for-level + (or (and=> (false-if-exception + (resolve-interface '(system base optimize))) + (lambda (iface) + (module-ref iface 'optimizations-for-level))) ;Guile 3.0 + (let () ;Guile 2.2 + (define %default-optimizations + ;; Default optimization options (equivalent to -O2 on Guile 2.2). + (append (tree-il-default-optimization-options) + (cps-default-optimization-options))) + + (define %lightweight-optimizations + ;; Lightweight optimizations (like -O0, but with partial evaluation). + (let loop ((opts %default-optimizations) + (result '())) + (match opts + (() (reverse result)) + ((#:partial-eval? _ rest ...) + (loop rest `(#t #:partial-eval? ,@result))) + ((kw _ rest ...) + (loop rest `(#f ,kw ,@result)))))) + + (lambda (level) + (if (<= level 1) + %lightweight-optimizations + %default-optimizations))))) (define (supported-warning-type? type) "Return true if TYPE, a symbol, denotes a supported warning type." @@ -80,8 +87,8 @@ (define (optimization-options file) "Return the default set of optimizations options for FILE." (if (string-contains file "gnu/packages/") - %lightweight-optimizations ;build faster - '())) + (optimizations-for-level 1) ;build faster + (optimizations-for-level 3))) (define (scm->go file) "Strip the \".scm\" suffix from FILE, and append \".go\"." diff --git a/guix/build/download.scm b/guix/build/download.scm index a4c91550a6..141ef409d6 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -187,10 +187,13 @@ name decoding bug described at DIRECTORY. Those authority certificates are checked when 'peer-certificate-status' is later called." (let ((cred (make-certificate-credentials)) - (files (or (scandir directory - (lambda (file) - (string-suffix? ".pem" file))) - '()))) + (files (match (scandir directory (cut string-suffix? ".pem" <>)) + ((or #f ()) + ;; Some distros provide nothing but bundles (*.crt) under + ;; /etc/ssl/certs, so look for them. + (or (scandir directory (cut string-suffix? ".crt" <>)) + '())) + (pem pem)))) (for-each (lambda (file) (let ((file (string-append directory "/" file))) ;; Protect against dangling symlinks. @@ -198,7 +201,7 @@ DIRECTORY. Those authority certificates are checked when (set-certificate-credentials-x509-trust-file!* cred file x509-certificate-format/pem)))) - (or files '())) + files) cred)) (define (peer-certificate session) diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm index 47a9eda9e6..e2b792d3dc 100644 --- a/guix/build/emacs-build-system.scm +++ b/guix/build/emacs-build-system.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2016 David Thompson <davet@gnu.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> -;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2018, 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,11 +40,10 @@ ;; ;; Code: -;; Directory suffix where we install ELPA packages. We avoid ".../elpa" as -;; Emacs expects to find the ELPA repository 'archive-contents' file and the -;; archive signature. -(define %legacy-install-suffix "/share/emacs/site-lisp") -(define %install-suffix (string-append %legacy-install-suffix "/guix.d")) +;;; All the packages are installed directly under site-lisp, which means that +;;; having that directory in the EMACSLOADPATH is enough to have them found by +;;; Emacs. +(define %install-dir "/share/emacs/site-lisp") ;; These are the default inclusion/exclusion regexps for the install phase. (define %default-include '("^[^/]*\\.el$" "^[^/]*\\.info$" "^doc/.*\\.info$")) @@ -74,50 +73,23 @@ archive, a directory, or an Emacs Lisp file." #t) (gnu:unpack #:source source))) -(define* (set-emacs-load-path #:key source inputs #:allow-other-keys) - (define (inputs->directories inputs) - "Extract the directory part from INPUTS." - (match inputs - (((names . directories) ...) directories))) - - (define (input-directory->el-directory input-directory) - "Return the correct Emacs Lisp directory in INPUT-DIRECTORY or #f, if there -is no Emacs Lisp directory." - (let ((legacy-elisp-directory (string-append input-directory %legacy-install-suffix)) - (guix-elisp-directory - (string-append - input-directory %install-suffix "/" - (store-directory->elpa-name-version input-directory)))) - (cond - ((file-exists? guix-elisp-directory) guix-elisp-directory) - ((file-exists? legacy-elisp-directory) legacy-elisp-directory) - (else #f)))) - - (define (input-directories->el-directories input-directories) - "Return the list of Emacs Lisp directories in INPUT-DIRECTORIES." - (filter-map input-directory->el-directory input-directories)) - - "Set the EMACSLOADPATH environment variable so that dependencies are found." +(define* (add-source-to-load-path #:key dummy #:allow-other-keys) + "Augment the EMACSLOADPATH environment variable with the source directory." (let* ((source-directory (getcwd)) - (input-elisp-directories (input-directories->el-directories - (inputs->directories inputs))) - (emacs-load-path-value - (string-join - (append input-elisp-directories (list source-directory)) - ":" 'suffix))) + (emacs-load-path-value (string-append (getenv "EMACSLOADPATH") ":" + source-directory))) (setenv "EMACSLOADPATH" emacs-load-path-value) - (format #t "environment variable `EMACSLOADPATH' set to ~a\n" - emacs-load-path-value))) + (format #t "source directory ~s appended to the `EMACSLOADPATH' \ +environment variable\n" source-directory))) (define* (build #:key outputs inputs #:allow-other-keys) "Compile .el files." (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs")) (out (assoc-ref outputs "out")) - (elpa-name-ver (store-directory->elpa-name-version out)) - (el-dir (string-append out %install-suffix "/" elpa-name-ver))) + (site-lisp (string-append out %install-dir))) (setenv "SHELL" "sh") (parameterize ((%emacs emacs)) - (emacs-byte-compile-directory el-dir)))) + (emacs-byte-compile-directory site-lisp)))) (define* (patch-el-files #:key outputs #:allow-other-keys) "Substitute the absolute \"/bin/\" directory with the right location in the @@ -134,9 +106,7 @@ store in '.el' files." #:binary #t)) (let* ((out (assoc-ref outputs "out")) - (elpa-name-ver (store-directory->elpa-name-version out)) - (el-dir (string-append out %install-suffix "/" elpa-name-ver)) - + (site-lisp (string-append out %install-dir)) ;; (ice-9 regex) uses libc's regexp routines, which cannot deal with ;; strings containing NULs. Filter out such files. TODO: Remove ;; this workaround when <https://bugs.gnu.org/30116> is fixed. @@ -150,7 +120,7 @@ store in '.el' files." (error "patch-el-files: unable to locate " cmd-name)) (string-append "\"" cmd "\""))))) - (with-directory-excursion el-dir + (with-directory-excursion site-lisp ;; Some old '.el' files (e.g., tex-buf.el in AUCTeX) are still ;; ISO-8859-1-encoded. (unless (false-if-exception (substitute-program-names)) @@ -201,15 +171,14 @@ parallel. PARALLEL-TESTS? is ignored when using a non-make TEST-COMMAND." (not (any (cut match-stripped-file "excluded" <>) exclude))))) (let* ((out (assoc-ref outputs "out")) - (elpa-name-ver (store-directory->elpa-name-version out)) - (target-directory (string-append out %install-suffix "/" elpa-name-ver)) + (site-lisp (string-append out %install-dir)) (files-to-install (find-files source install-file?))) (cond ((not (null? files-to-install)) (for-each (lambda (file) (let* ((stripped-file (string-drop file (string-length source))) - (target-file (string-append target-directory stripped-file))) + (target-file (string-append site-lisp stripped-file))) (format #t "`~a' -> `~a'~%" file target-file) (install-file file (dirname target-file)))) files-to-install) @@ -223,14 +192,12 @@ parallel. PARALLEL-TESTS? is ignored when using a non-make TEST-COMMAND." (define* (move-doc #:key outputs #:allow-other-keys) "Move info files from the ELPA package directory to the info directory." (let* ((out (assoc-ref outputs "out")) - (elpa-name-ver (store-directory->elpa-name-version out)) - (el-dir (string-append out %install-suffix "/" elpa-name-ver)) - (name-ver (strip-store-file-name out)) + (site-lisp (string-append out %install-dir)) (info-dir (string-append out "/share/info/")) - (info-files (find-files el-dir "\\.info$"))) + (info-files (find-files site-lisp "\\.info$"))) (unless (null? info-files) (mkdir-p info-dir) - (with-directory-excursion el-dir + (with-directory-excursion site-lisp (when (file-exists? "dir") (delete-file "dir")) (for-each (lambda (f) (copy-file f (string-append info-dir "/" (basename f))) @@ -242,11 +209,11 @@ parallel. PARALLEL-TESTS? is ignored when using a non-make TEST-COMMAND." "Generate the autoloads file." (let* ((emacs (string-append (assoc-ref inputs "emacs") "/bin/emacs")) (out (assoc-ref outputs "out")) + (site-lisp (string-append out %install-dir)) (elpa-name-ver (store-directory->elpa-name-version out)) - (elpa-name (package-name->name+version elpa-name-ver)) - (el-dir (string-append out %install-suffix "/" elpa-name-ver))) + (elpa-name (package-name->name+version elpa-name-ver))) (parameterize ((%emacs emacs)) - (emacs-generate-autoloads elpa-name el-dir)))) + (emacs-generate-autoloads elpa-name site-lisp)))) (define (emacs-package? name) "Check if NAME correspond to the name of an Emacs package." @@ -269,7 +236,7 @@ second hyphen. This corresponds to 'name-version' as used in ELPA packages." (define %standard-phases (modify-phases gnu:%standard-phases (replace 'unpack unpack) - (add-after 'unpack 'set-emacs-load-path set-emacs-load-path) + (add-after 'unpack 'add-source-to-load-path add-source-to-load-path) (delete 'bootstrap) (delete 'configure) ;; Move the build phase after install: the .el files are byte compiled diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm new file mode 100644 index 0000000000..46fcad7848 --- /dev/null +++ b/guix/build/qt-build-system.scm @@ -0,0 +1,109 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch> +;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix build qt-build-system) + #:use-module ((guix build cmake-build-system) #:prefix cmake:) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 ftw) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (%standard-phases + qt-build)) + +;; Commentary: +;; +;; Builder-side code of the standard Qt build procedure. +;; +;; Code: + +(define (variables-for-wrapping base-directories) + + (define (collect-sub-dirs base-directories subdirectory) + (filter-map + (lambda (dir) + (let ((directory (string-append dir subdirectory))) + (if (directory-exists? directory) directory #f))) + base-directories)) + + (filter + (lambda (var-to-wrap) (not (null? (last var-to-wrap)))) + (map + (lambda (var-spec) + `(,(first var-spec) = ,(collect-sub-dirs base-directories (last var-spec)))) + (list + ;; these shall match the search-path-specification for Qt and KDE + ;; libraries + '("XDG_DATA_DIRS" "/share") + '("XDG_CONFIG_DIRS" "/etc/xdg") + '("QT_PLUGIN_PATH" "/lib/qt5/plugins") + '("QML2_IMPORT_PATH" "/lib/qt5/qml"))))) + +(define* (wrap-all-programs #:key inputs outputs + (qt-wrap-excluded-outputs '()) + #:allow-other-keys) + "Implement phase \"qt-wrap\": look for GSettings schemas and +gtk+-v.0 libraries and create wrappers with suitably set environment variables +if found. + +Wrapping is not applied to outputs whose name is listed in +QT-WRAP-EXCLUDED-OUTPUTS. This is useful when an output is known not +to contain any Qt binaries, and where wrapping would gratuitously +add a dependency of that output on Qt." + (define (find-files-to-wrap directory) + (append-map + (lambda (dir) + (if (directory-exists? dir) (find-files dir ".*") (list))) + (list (string-append directory "/bin") + (string-append directory "/sbin") + (string-append directory "/libexec") + (string-append directory "/lib/libexec")))) + + (define input-directories + ;; FIXME: Filter out unwanted inputs, e.g. cmake + (match inputs + (((_ . dir) ...) + dir))) + + (define handle-output + (match-lambda + ((output . directory) + (unless (member output qt-wrap-excluded-outputs) + (let ((bin-list (find-files-to-wrap directory)) + (vars-to-wrap (variables-for-wrapping + (append (list output) + input-directories)))) + (when (not (null? vars-to-wrap)) + (for-each (cut apply wrap-program <> vars-to-wrap) + bin-list))))))) + + (for-each handle-output outputs) + #t) + +(define %standard-phases + (modify-phases cmake:%standard-phases + (add-after 'install 'qt-wrap wrap-all-programs))) + +(define* (qt-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given package, applying all of PHASES in order." + (apply cmake:cmake-build #:inputs inputs #:phases phases args)) diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm index 48a32674e9..d2486ee86c 100644 --- a/guix/build/qt-utils.scm +++ b/guix/build/qt-utils.scm @@ -26,9 +26,9 @@ (if env-val (string-append env-val ":" path) path))) (let ((qml-path (suffix "QML2_IMPORT_PATH" - (string-append out "/qml"))) + (string-append out "/lib/qt5/qml"))) (plugin-path (suffix "QT_PLUGIN_PATH" - (string-append out "/plugins"))) + (string-append out "/lib/qt5/plugins"))) (xdg-data-path (suffix "XDG_DATA_DIRS" (string-append out "/share"))) (xdg-config-path (suffix "XDG_CONFIG_DIRS" diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index a5a9c92a42..ce7999b433 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1127,7 +1127,9 @@ exception if it's already taken." (lambda (key . args) (match key ('flock-error - (handler args)) + (apply handler args) + ;; No open port to the lock, so return #f. + #f) ('system-error ;; When using the statically-linked Guile in the initrd, ;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore |