diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build-system/cmake.scm | 18 | ||||
| -rw-r--r-- | guix/build-system/glib-or-gtk.scm | 16 | ||||
| -rw-r--r-- | guix/build-system/gnu.scm | 18 | ||||
| -rw-r--r-- | guix/build-system/meson.scm | 14 | ||||
| -rw-r--r-- | guix/build-system/texlive.scm | 4 | ||||
| -rw-r--r-- | guix/build/cmake-build-system.scm | 2 | ||||
| -rw-r--r-- | guix/build/gnu-bootstrap.scm | 114 | ||||
| -rw-r--r-- | guix/build/gnu-build-system.scm | 14 | ||||
| -rw-r--r-- | guix/build/utils.scm | 103 | ||||
| -rw-r--r-- | guix/derivations.scm | 59 | ||||
| -rw-r--r-- | guix/gexp.scm | 58 | ||||
| -rw-r--r-- | guix/packages.scm | 12 | ||||
| -rw-r--r-- | guix/profiles.scm | 12 | ||||
| -rw-r--r-- | guix/scripts/environment.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 2 | ||||
| -rw-r--r-- | guix/self.scm | 10 | ||||
| -rw-r--r-- | guix/store.scm | 40 | ||||
| -rw-r--r-- | guix/tests.scm | 5 |
20 files changed, 357 insertions, 154 deletions
diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index ca88fadddf..29259c5785 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; @@ -43,16 +43,19 @@ `((guix build cmake-build-system) ,@%gnu-build-system-modules)) -(define (default-cmake) +(define (default-cmake target) "Return the default CMake package." ;; Do not use `@' to avoid introducing circular dependencies. (let ((module (resolve-interface '(gnu packages cmake)))) - (module-ref module 'cmake-minimal))) + (module-ref module + (if target + 'cmake-minimal-cross + 'cmake-minimal)))) (define* (lower name #:key source inputs native-inputs outputs system target - (cmake (default-cmake)) + (cmake (default-cmake target)) #:allow-other-keys #:rest arguments) "Return a bag for NAME." @@ -69,6 +72,7 @@ '()) ,@`(("cmake" ,cmake)) ,@native-inputs + ,@(if target '() inputs) ,@(if target ;; Use the standard cross inputs of ;; 'gnu-build-system'. @@ -76,7 +80,7 @@ '()) ;; Keep the standard inputs of 'gnu-build-system'. ,@(standard-packages))) - (host-inputs inputs) + (host-inputs (if target inputs '())) ;; The cross-libc is really a target package, but for bootstrapping ;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a @@ -99,7 +103,7 @@ (build-type "RelWithDebInfo") (tests? #t) (test-target "test") - (parallel-build? #t) (parallel-tests? #f) + (parallel-build? #t) (parallel-tests? #t) (validate-runpath? #t) (patch-shebangs? #t) (strip-binaries? #t) @@ -178,7 +182,7 @@ provides a 'CMakeLists.txt' file as its build system." (build-type "RelWithDebInfo") (tests? #f) ; nothing can be done (test-target "test") - (parallel-build? #t) (parallel-tests? #f) + (parallel-build? #t) (parallel-tests? #t) (validate-runpath? #t) (patch-shebangs? #t) (strip-binaries? #t) diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm index 8de7dfbfc2..fb1f8fb930 100644 --- a/guix/build-system/glib-or-gtk.scm +++ b/guix/build-system/glib-or-gtk.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch> ;;; @@ -92,15 +92,15 @@ (bag (name name) (system system) - (host-inputs `(,@(if source - `(("source" ,source)) - '()) - ,@inputs)) - (build-inputs `(("glib:bin" ,glib "bin") ; to compile schemas + (host-inputs (if source + `(("source" ,source)) + '())) + (build-inputs `(,@native-inputs + ,@inputs + ("glib:bin" ,glib "bin") ; to compile schemas ,@(if implicit-inputs? (standard-packages) - '()) - ,@native-inputs)) + '()))) (outputs outputs) (build glib-or-gtk-build) (arguments (strip-keyword-arguments private-keywords arguments))))) diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 3cc89f8852..d6613edb33 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -296,13 +296,19 @@ standard packages used as implicit inputs of the GNU build system." `(("source" ,source)) '()) ,@native-inputs + + ;; When not cross-compiling, ensure implicit inputs come + ;; last. That way, libc headers come last, which allows + ;; #include_next to work correctly; see + ;; <https://bugs.gnu.org/30756>. + ,@(if target '() inputs) ,@(if (and target implicit-cross-inputs?) (standard-cross-packages target 'host) '()) ,@(if implicit-inputs? (standard-packages) '()))) - (host-inputs inputs) + (host-inputs (if target inputs '())) ;; The cross-libc is really a target package, but for bootstrapping ;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a @@ -454,13 +460,19 @@ is one of `host' or `target'." (libc (module-ref cross 'cross-libc))) (case kind ((host) + ;; Cross-GCC appears once here, so that it's in $PATH... `(("cross-gcc" ,(gcc target #:xbinutils (binutils target) #:libc (libc target))) ("cross-binutils" ,(binutils target)))) ((target) (let ((libc (libc target))) - `(("cross-libc" ,libc) + ;; ... and once here, so that libstdc++ & co. are in + ;; CROSS_CPLUS_INCLUDE_PATH, etc. + `(("cross-gcc" ,(gcc target + #:xbinutils (binutils target) + #:libc libc)) + ("cross-libc" ,libc) ;; MinGW's libc doesn't have a "static" output. ,@(if (member "static" (package-outputs libc)) diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm index b29f2f4ecf..b68bcb80de 100644 --- a/guix/build-system/meson.scm +++ b/guix/build-system/meson.scm @@ -74,13 +74,13 @@ (system system) (build-inputs `(("meson" ,meson) ("ninja" ,ninja) - ,@native-inputs)) - (host-inputs `(,@(if source - `(("source" ,source)) - '()) - ,@inputs - ;; Keep the standard inputs of 'gnu-build-system'. - ,@(standard-packages))) + ,@native-inputs + ,@inputs + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (host-inputs (if source + `(("source" ,source)) + '())) (outputs outputs) (build meson-build) (arguments (strip-keyword-arguments private-keywords arguments))))) diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm index ad99d1e2d0..8bbca0ccb7 100644 --- a/guix/build-system/texlive.scm +++ b/guix/build-system/texlive.scm @@ -42,8 +42,8 @@ ;; These variables specify the SVN tag and the matching SVN revision. They ;; are taken from https://www.tug.org/svn/texlive/tags/ -(define %texlive-tag "texlive-2018.2") -(define %texlive-revision 49435) +(define %texlive-tag "texlive-2019.3") +(define %texlive-revision 51265) (define (texlive-origin name version locations hash) "Return an <origin> object for a TeX Live package consisting of multiple diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm index 9b1112f2d6..d1ff5071be 100644 --- a/guix/build/cmake-build-system.scm +++ b/guix/build/cmake-build-system.scm @@ -67,6 +67,8 @@ ,@(if target (list (string-append "-DCMAKE_C_COMPILER=" target "-gcc") + (string-append "-DCMAKE_CXX_COMPILER=" + target "-g++") (if (string-contains target "mingw") "-DCMAKE_SYSTEM_NAME=Windows" "-DCMAKE_SYSTEM_NAME=Linux")) diff --git a/guix/build/gnu-bootstrap.scm b/guix/build/gnu-bootstrap.scm new file mode 100644 index 0000000000..1cb9dc5512 --- /dev/null +++ b/guix/build/gnu-bootstrap.scm @@ -0,0 +1,114 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Timothy Sample <samplet@ngyro.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/>. + +;; Commentary: +;; +;; These procedures can be used to adapt the GNU Build System to build +;; pure Scheme packages targeting the bootstrap Guile. +;; +;; Code: + +(define-module (guix build gnu-bootstrap) + #:use-module (guix build utils) + #:use-module (system base compile) + #:export (bootstrap-configure + bootstrap-build + bootstrap-install)) + +(define (bootstrap-configure version modules scripts) + "Create a procedure that configures an early bootstrap package. The +procedure will search the MODULES directory and configure all of the +'.in' files with VERSION. It will then search the SCRIPTS directory and +configure all of the '.in' files with the bootstrap Guile and its module +and object directories." + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (guile-dir (assoc-ref inputs "guile")) + (guile (string-append guile-dir "/bin/guile")) + (moddir (string-append out "/share/guile/site/" + (effective-version))) + (godir (string-append out "/lib/guile/" + (effective-version) + "/site-ccache"))) + (for-each (lambda (template) + (format #t "Configuring ~a~%" template) + (let ((target (string-drop-right template 3))) + (copy-file template target) + (substitute* target + (("@VERSION@") version)))) + (find-files modules + (lambda (fn st) + (string-suffix? ".in" fn)))) + (for-each (lambda (template) + (format #t "Configuring ~a~%" template) + (let ((target (string-drop-right template 3))) + (copy-file template target) + (substitute* target + (("@GUILE@") guile) + (("@MODDIR@") moddir) + (("@GODIR@") godir)) + (chmod target #o755))) + (find-files scripts + (lambda (fn st) + (string-suffix? ".in" fn)))) + #t))) + +(define (bootstrap-build modules) + "Create a procedure that builds an early bootstrap package. The +procedure will search the MODULES directory and compile all of the +'.scm' files." + (lambda _ + (add-to-load-path (getcwd)) + (for-each (lambda (scm) + (let* ((base (string-drop-right scm 4)) + (go (string-append base ".go")) + (dir (dirname scm))) + (format #t "Compiling ~a~%" scm) + (compile-file scm #:output-file go))) + (find-files modules "\\.scm$")) + #t)) + +(define (bootstrap-install modules scripts) + "Create a procedure that installs an early bootstrap package. The +procedure will install all of the '.scm' and '.go' files in the MODULES +directory, and all the executable files in the SCRIPTS directory." + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (guile-dir (assoc-ref inputs "guile")) + (guile (string-append guile-dir "/bin/guile")) + (moddir (string-append out "/share/guile/site/" + (effective-version))) + (godir (string-append out "/lib/guile/" + (effective-version) + "/site-ccache"))) + (for-each (lambda (scm) + (let* ((base (string-drop-right scm 4)) + (go (string-append base ".go")) + (dir (dirname scm))) + (format #t "Installing ~a~%" scm) + (install-file scm (string-append moddir "/" dir)) + (format #t "Installing ~a~%" go) + (install-file go (string-append godir "/" dir)))) + (find-files modules "\\.scm$")) + (for-each (lambda (script) + (format #t "Installing ~a~%" script) + (install-file script (string-append out "/bin"))) + (find-files scripts + (lambda (fn st) + (executable-file? fn)))) + #t))) diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 4df0bb4904..2e7dff2034 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org> +;;; Copyright © 2020 Brendan Tildesley <mail@brendan.scot> ;;; ;;; This file is part of GNU Guix. ;;; @@ -173,12 +174,16 @@ working directory." \"autoreconf\". Otherwise do nothing." ;; Note: Run that right after 'unpack' so that the generated files are ;; visible when the 'patch-source-shebangs' phase runs. - (if (not (file-exists? "configure")) + (define (script-exists? file) + (and (file-exists? file) + (not (file-is-directory? file)))) + + (if (not (script-exists? "configure")) ;; First try one of the BOOTSTRAP-SCRIPTS. If none exists, and it's ;; clearly an Autoconf-based project, run 'autoreconf'. Otherwise, do ;; nothing (perhaps the user removed or overrode the 'configure' phase.) - (let ((script (find file-exists? bootstrap-scripts))) + (let ((script (find script-exists? bootstrap-scripts))) ;; GNU packages often invoke the 'git-version-gen' script from ;; 'configure.ac' so make sure it has a valid shebang. (false-if-file-not-found @@ -186,12 +191,15 @@ working directory." (if script (let ((script (string-append "./" script))) + (setenv "NOCONFIGURE" "true") (format #t "running '~a'~%" script) (if (executable-file? script) (begin (patch-shebang script) (invoke script)) - (invoke "sh" script))) + (invoke "sh" script)) + ;; Let's clean up after ourselves. + (unsetenv "NOCONFIGURE")) (if (or (file-exists? "configure.ac") (file-exists? "configure.in")) (invoke "autoreconf" "-vif") diff --git a/guix/build/utils.scm b/guix/build/utils.scm index b8be73ead4..419c10195b 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -108,6 +108,8 @@ invoke/quiet + make-desktop-entry-file + locale-category->string)) @@ -892,7 +894,7 @@ transferred and the continuation of the transfer as a thunk." (x x))) (define patch-shebang - (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$"))) + (let ((shebang-rx (make-regexp "^[[:blank:]]*(/[[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$"))) (lambda* (file #:optional (path (search-path-as-string->list (getenv "PATH"))) @@ -1324,6 +1326,105 @@ not supported." (&wrap-error (program prog) (type 'no-interpreter-found))))))))) +(define* (make-desktop-entry-file destination #:key + (type "Application") ; One of "Application", "Link" or "Directory". + (version "1.1") + name + (generic-name name) + (no-display #f) + comment + icon + (hidden #f) + only-show-in + not-show-in + (d-bus-activatable #f) + try-exec + exec + path + (terminal #f) + actions + mime-type + (categories "Application") + implements + keywords + (startup-notify #t) + startup-w-m-class + #:rest all-args) + "Create a desktop entry file at DESTINATION. +You must specify NAME. + +Values can be booleans, numbers, strings or list of strings. + +Additionally, locales can be specified with an alist where the key is the +locale. The #f key specifies the default. Example: + + #:name '((#f \"I love Guix\") (\"fr\" \"J'aime Guix\")) + +produces + + Name=I love Guix + Name[fr]=J'aime Guix + +For a complete description of the format, see the specifications at +https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-latest.html." + (define (escape-semicolon s) + (string-join (string-split s #\;) "\\;")) + (define* (parse key value #:optional locale) + (set! value (match value + (#t "true") + (#f "false") + ((? number? n) n) + ((? string? s) (escape-semicolon s)) + ((? list? value) + (catch 'wrong-type-arg + (lambda () (string-join (map escape-semicolon value) ";")) + (lambda args (error "List arguments can only contain strings: ~a" args)))) + (_ (error "Value must be a boolean, number, string or list of strings")))) + (format #t "~a=~a~%" + (if locale + (format #f "~a[~a]" key locale) + key) + value)) + + (define key-error-message "This procedure only takes key arguments beside DESTINATION") + + (unless name + (error "Missing NAME key argument")) + (unless (member #:type all-args) + (set! all-args (append (list #:type type) all-args))) + (mkdir-p (dirname destination)) + + (with-output-to-file destination + (lambda () + (format #t "[Desktop Entry]~%") + (let loop ((args all-args)) + (match args + (() #t) + ((_) (error key-error-message)) + ((key value . ...) + (unless (keyword? key) + (error key-error-message)) + (set! key + (string-join (map string-titlecase + (string-split (symbol->string + (keyword->symbol key)) + #\-)) + "")) + (match value + (((_ . _) . _) + (for-each (lambda (locale-subvalue) + (parse key + (if (and (list? (cdr locale-subvalue)) + (= 1 (length (cdr locale-subvalue)))) + ;; Support both proper and improper lists for convenience. + (cadr locale-subvalue) + (cdr locale-subvalue)) + (car locale-subvalue))) + value)) + (_ + (parse key value))) + (loop (cddr args)))))))) + ;;; ;;; Locales. diff --git a/guix/derivations.scm b/guix/derivations.scm index f6d6f7db25..7db61d272f 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -1105,39 +1105,13 @@ recursively." (string-tokenize (dirname file-name) not-slash)))))) (define* (imported-files store files ;deprecated - #:key (name "file-import") - (system (%current-system)) - (guile (%guile-for-build))) - "Return a derivation that imports FILES into STORE. FILES must be a list + #:key (name "file-import")) + "Return a store item that contains FILES. FILES must be a list of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file system, imported, and appears under FINAL-PATH in the resulting store path." - (let* ((files (map (match-lambda - ((final-path . file-name) - (list final-path - (add-to-store store (basename final-path) #f - "sha256" file-name)))) - files)) - (builder - `(begin - (mkdir %output) (chdir %output) - ,@(append-map (match-lambda - ((final-path store-path) - (append (match (parent-directories final-path) - (() '()) - ((head ... tail) - (append (map (lambda (d) - `(false-if-exception - (mkdir ,d))) - head) - `((or (file-exists? ,tail) - (mkdir ,tail)))))) - `((symlink ,store-path ,final-path))))) - files)))) - (build-expression->derivation store name builder - #:system system - #:inputs files - #:guile-for-build guile - #:local-build? #t))) + (add-file-tree-to-store store + `(,name directory + ,@(file-mapping->tree files)))) ;; The "file not found" error condition. (define-condition-type &file-search-error &error @@ -1164,10 +1138,8 @@ of symbols.)" (define* (%imported-modules store modules ;deprecated #:key (name "module-import") - (system (%current-system)) - (guile (%guile-for-build)) (module-path %load-path)) - "Return a derivation that contains the source files of MODULES, a list of + "Return a store item that contains the source files of MODULES, a list of module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH search path." ;; TODO: Determine the closure of MODULES, build the `.go' files, @@ -1176,8 +1148,7 @@ search path." (let ((f (module->source-file-name m))) (cons f (search-path* module-path f)))) modules))) - (imported-files store files #:name name #:system system - #:guile guile))) + (imported-files store files #:name name))) (define* (%compiled-modules store modules ;deprecated #:key (name "module-import-compiled") @@ -1187,11 +1158,8 @@ search path." "Return a derivation that builds a tree containing the `.go' files corresponding to MODULES. All the MODULES are built in a context where they can refer to each other." - (let* ((module-drv (%imported-modules store modules - #:system system - #:guile guile + (let* ((module-dir (%imported-modules store modules #:module-path module-path)) - (module-dir (derivation->output-path module-drv)) (files (map (lambda (m) (let ((f (string-join (map symbol->string m) "/"))) @@ -1222,7 +1190,7 @@ they can refer to each other." files))) (build-expression->derivation store name builder - #:inputs `(("modules" ,module-drv)) + #:inputs `(("modules" ,module-dir)) #:system system #:guile-for-build guile #:local-build? #t))) @@ -1240,8 +1208,7 @@ MODULES are compiled." (list modules (derivation-file-name guile) system)) (or (hash-ref %module-cache key) - (let ((result (cons (%imported-modules store modules - #:system system #:guile guile) + (let ((result (cons (%imported-modules store modules) (%compiled-modules store modules #:system system #:guile guile)))) (hash-set! %module-cache key result) @@ -1375,10 +1342,8 @@ and PROPERTIES." #:guile guile-drv #:system system) '(#f . #f))) - (mod-drv (car mod+go-drv)) + (mod-dir (car mod+go-drv)) (go-drv (cdr mod+go-drv)) - (mod-dir (and mod-drv - (derivation->output-path mod-drv))) (go-dir (and go-drv (derivation->output-path go-drv)))) (derivation store name guile @@ -1395,7 +1360,7 @@ and PROPERTIES." #:inputs `((,(or guile-for-build (%guile-for-build))) (,builder) ,@(map cdr inputs) - ,@(if mod-drv `((,mod-drv) (,go-drv)) '())) + ,@(if mod-dir `((,mod-dir) (,go-drv)) '())) ;; When MODULES is non-empty, shamelessly clobber ;; $GUILE_LOAD_COMPILED_PATH. diff --git a/guix/gexp.scm b/guix/gexp.scm index 133e0f5679..99390bcafc 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -785,7 +785,7 @@ second element is the derivation to compile them." (target 'current) (graft? (%graft?)) (guile-for-build (%guile-for-build)) - (effective-version "2.2") + (effective-version "3.0") deprecation-warnings) "*Note: This API is subject to change; use at your own risk!* @@ -886,7 +886,7 @@ derivations--e.g., code evaluated for its side effects." (modules '()) (module-path %load-path) (guile-for-build (%guile-for-build)) - (effective-version "2.2") + (effective-version "3.0") (graft? (%graft?)) references-graphs allowed-references disallowed-references @@ -1302,49 +1302,6 @@ execution environment." ;;; Module handling. ;;; -(define %not-slash - (char-set-complement (char-set #\/))) - -(define (file-mapping->tree mapping) - "Convert MAPPING, an alist like: - - ((\"guix/build/utils.scm\" . \"…/utils.scm\")) - -to a tree suitable for 'interned-file-tree'." - (let ((mapping (map (match-lambda - ((destination . source) - (cons (string-tokenize destination - %not-slash) - source))) - mapping))) - (fold (lambda (pair result) - (match pair - ((destination . source) - (let loop ((destination destination) - (result result)) - (match destination - ((file) - (let* ((mode (stat:mode (stat source))) - (type (if (zero? (logand mode #o100)) - 'regular - 'executable))) - (alist-cons file - `(,type (file ,source)) - result))) - ((file rest ...) - (let ((directory (assoc-ref result file))) - (alist-cons file - `(directory - ,@(loop rest - (match directory - (('directory . entries) entries) - (#f '())))) - (if directory - (alist-delete file result) - result))))))))) - '() - mapping))) - (define %utils-module ;; This file provides 'mkdir-p', needed to implement 'imported-files' and ;; other primitives below. Note: We give the file name relative to this @@ -1479,14 +1436,9 @@ TARGET, a GNU triplet." (ice-9 format) (srfi srfi-1) (srfi srfi-26) + (system base target) (system base compile)) - ;; TODO: Inline this on the next rebuild cycle. - (ungexp-splicing - (if target - (gexp ((use-modules (system base target)))) - (gexp ()))) - (define (regular? file) (not (member file '("." "..")))) @@ -1601,12 +1553,12 @@ TARGET, a GNU triplet." ;;; (define (default-guile) - ;; Lazily resolve 'guile-2.2' (not 'guile-final' because this is for + ;; Lazily resolve 'guile-3.0' (not 'guile-final' because this is for ;; programs returned by 'program-file' and we don't want to keep references ;; to several Guile packages). This module must not refer to (gnu …) ;; modules directly, to avoid circular dependencies, hence this hack. (module-ref (resolve-interface '(gnu packages guile)) - 'guile-2.2)) + 'guile-3.0)) (define* (load-path-expression modules #:optional (path %load-path) #:key (extensions '()) system target) diff --git a/guix/packages.scm b/guix/packages.scm index 70b1478c91..ef96b5692f 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1,9 +1,9 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2017, 2018 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> -;;; Copyright © 2017, 2019 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com> ;;; ;;; This file is part of GNU Guix. @@ -232,7 +232,7 @@ name of its URI." (define %supported-systems ;; This is the list of system types that are supported. By default, we ;; expect all packages to build successfully here. - '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux")) + '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu")) (define %hurd-systems ;; The GNU/Hurd systems for which support is being developed. @@ -636,8 +636,10 @@ specifies modules in scope when evaluating SNIPPET." (apply invoke (string-append #+tar "/bin/tar") "cvfa" #$output - ;; avoid non-determinism in the archive - "--mtime=@0" + ;; Avoid non-determinism in the archive. Set the mtime + ;; to 1 as is the case in the store (software like gzip + ;; behaves differently when it stumbles upon mtime = 0). + "--mtime=@1" "--owner=root:0" "--group=root:0" (if tar-supports-sort? diff --git a/guix/profiles.scm b/guix/profiles.scm index 3a6498993c..2a838d3a9a 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> @@ -1116,6 +1116,8 @@ for both major versions of GTK+." ;; Don't run the hook when there's nothing to do. (let* ((pkg-gtk+ (module-ref ; lazy reference (resolve-interface '(gnu packages gtk)) 'gtk+)) + (pkg-gtk+2 (module-ref ; lazy reference + (resolve-interface '(gnu packages gtk)) 'gtk+-2)) (gexp #~(begin #$(if gtk+ (build @@ -1129,7 +1131,7 @@ for both major versions of GTK+." (build gtk+-2 "2.10.0" #~(string-append - #$gtk+-2 "/bin/gtk-query-immodules-2.0")) + #$pkg-gtk+2:bin "/bin/gtk-query-immodules-2.0")) #t)))) (if (or gtk+ gtk+-2) (gexp->derivation "gtk-im-modules" gexp @@ -1557,8 +1559,10 @@ are cross-built for TARGET." (guix search-paths) (srfi srfi-1)) - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) + (let ((line (cond-expand (guile-2.2 'line) + (else _IOLBF)))) ;Guile 2.0 + (setvbuf (current-output-port) line) + (setvbuf (current-error-port) line)) #+(if locales? set-utf8-locale #t) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index ca12346815..e6f45d3eba 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -38,8 +38,6 @@ #:use-module (gnu system file-systems) #:use-module (gnu packages) #:use-module (gnu packages bash) - #:use-module (gnu packages commencement) - #:use-module (gnu packages guile) #:use-module ((gnu packages bootstrap) #:select (bootstrap-executable %bootstrap-guile)) #:use-module (ice-9 format) @@ -724,7 +722,7 @@ message if any test fails." store (if bootstrap? %bootstrap-guile - (canonical-package guile-2.2))))) + (default-guile))))) (run-with-store store ;; Containers need a Bourne shell at /bin/sh. (mlet* %store-monad ((bash (environment-bash container? diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index b6fb73838d..9d981c05d6 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -1035,7 +1035,7 @@ Create a bundle of PACKAGE.\n")) store (if (assoc-ref opts 'bootstrap?) %bootstrap-guile - (canonical-package guile-2.2)) + (default-guile)) (assoc-ref opts 'system) #:graft? (assoc-ref opts 'graft?)))) (let* ((derivation? (assoc-ref opts 'derivation-only?)) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 110d4f2977..8af0a7a27e 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -53,8 +53,6 @@ #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:use-module (gnu packages) - #:autoload (gnu packages base) (canonical-package) - #:autoload (gnu packages guile) (guile-2.2) #:autoload (gnu packages bootstrap) (%bootstrap-guile) #:export (build-and-use-profile delete-generations @@ -949,5 +947,5 @@ option processing with 'parse-command-line'." (%store) (if (assoc-ref opts 'bootstrap?) %bootstrap-guile - (canonical-package guile-2.2))))) + (default-guile))))) (process-actions (%store) opts)))))))) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index b7e0a4a416..dbd02431fe 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -787,7 +787,7 @@ Use '~/.config/guix/channels.scm' instead.")) store (if (assoc-ref opts 'bootstrap?) %bootstrap-guile - (canonical-package guile-2.2))))) + (default-guile))))) (with-profile-lock profile (run-with-store store (build-and-install instances profile))))))))))))))) diff --git a/guix/self.scm b/guix/self.scm index 6b633f9bc0..e3b36b9407 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -49,11 +49,11 @@ (module-ref (resolve-interface module) variable)))) (match-lambda ("guile" (ref '(gnu packages guile) 'guile-3.0)) - ("guile-json" (ref '(gnu packages guile) 'guile3.0-json)) - ("guile-ssh" (ref '(gnu packages ssh) 'guile3.0-ssh)) - ("guile-git" (ref '(gnu packages guile) 'guile3.0-git)) - ("guile-sqlite3" (ref '(gnu packages guile) 'guile3.0-sqlite3)) - ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile3.0-gcrypt)) + ("guile-json" (ref '(gnu packages guile) 'guile-json-3)) + ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh)) + ("guile-git" (ref '(gnu packages guile) 'guile-git)) + ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3)) + ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile-gcrypt)) ("gnutls" (ref '(gnu packages tls) 'guile3.0-gnutls)) ("zlib" (ref '(gnu packages compression) 'zlib)) ("lzlib" (ref '(gnu packages compression) 'lzlib)) diff --git a/guix/store.scm b/guix/store.scm index fdaae27914..5dea264811 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -103,6 +103,7 @@ add-text-to-store add-to-store add-file-tree-to-store + file-mapping->tree binary-file with-build-handler build-things @@ -1223,6 +1224,45 @@ an arbitrary directory layout in the store without creating a derivation." (hash-set! cache tree result) result))))) +(define (file-mapping->tree mapping) + "Convert MAPPING, an alist like: + + ((\"guix/build/utils.scm\" . \"…/utils.scm\")) + +to a tree suitable for 'add-file-tree-to-store' and 'interned-file-tree'." + (let ((mapping (map (match-lambda + ((destination . source) + (cons (string-tokenize destination %not-slash) + source))) + mapping))) + (fold (lambda (pair result) + (match pair + ((destination . source) + (let loop ((destination destination) + (result result)) + (match destination + ((file) + (let* ((mode (stat:mode (stat source))) + (type (if (zero? (logand mode #o100)) + 'regular + 'executable))) + (alist-cons file + `(,type (file ,source)) + result))) + ((file rest ...) + (let ((directory (assoc-ref result file))) + (alist-cons file + `(directory + ,@(loop rest + (match directory + (('directory . entries) entries) + (#f '())))) + (if directory + (alist-delete file result) + result))))))))) + '() + mapping))) + (define current-build-prompt ;; When true, this is the prompt to abort to when 'build-things' is called. (make-parameter #f)) diff --git a/guix/tests.scm b/guix/tests.scm index ff31bcad44..95a7d7c4b8 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -415,6 +415,9 @@ default values, and with EXTRA-FIELDS set as specified." #:implicit-inputs? #f #:tests? #f ;cannot run "make check" ,@(substitute-keyword-arguments (package-arguments gnu-make) + ((#:configure-flags flags ''()) + ;; As in 'gnu-make-boot0', work around a 'config.status' defect. + `(cons "--disable-dependency-tracking" ,flags)) ((#:phases phases) `(modify-phases ,phases (replace 'build |