From ea89b62a18c988ead226cec542a5f4fdd3d58ac0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 10 Mar 2019 22:21:14 +0100 Subject: packages: 'patch-and-repack' specifies a 'type' property for the derivation. * guix/packages.scm (patch-and-repack): Pass #:properties to 'gexp->derivation'. --- guix/packages.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index 8515bb7c6f..e5e568efab 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -645,7 +645,9 @@ specifies modules in scope when evaluating SNIPPET." #:graft? #f #:system system #:deprecation-warnings #t ;to avoid a rebuild - #:guile-for-build guile-for-build)))) + #:guile-for-build guile-for-build + #:properties `((type . origin) + (patches . ,(length patches))))))) (define (transitive-inputs inputs) "Return the closure of INPUTS when considering the 'propagated-inputs' -- cgit v1.2.3 From 3c6b9fb5d2627c9f23b58ce530025a8dc8cc3c3c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Jun 2019 15:54:17 +0200 Subject: gexp: Remove #:pre-load-modules? parameter. * guix/gexp.scm (gexp->derivation): Remove #:pre-load-modules?. (compiled-modules): Likewise. Inline the case correspoding to PRE-LOAD-MODULES? = #t. * guix/packages.scm (patch-and-repack): Remove #:pre-load-modules?. --- guix/gexp.scm | 68 ++++++++++++++++++++----------------------------------- guix/packages.scm | 3 --- 2 files changed, 24 insertions(+), 47 deletions(-) (limited to 'guix/packages.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index 4f2adba90a..9bf68a91f4 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -633,12 +633,6 @@ names and file names suitable for the #:allowed-references argument to leaked-env-vars local-build? (substitutable? #t) (properties '()) - - ;; TODO: This parameter is transitional; it's here - ;; to avoid a full rebuild. Remove it on the next - ;; rebuild cycle. - (pre-load-modules? #t) - deprecation-warnings (script-name (string-append name "-builder"))) "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a @@ -743,8 +737,6 @@ The other arguments are as for 'derivation'." #:module-path module-path #:extensions extensions #:guile guile-for-build - #:pre-load-modules? - pre-load-modules? #:deprecation-warnings deprecation-warnings) (return #f))) @@ -1220,11 +1212,7 @@ last one is created from the given object." (guile (%guile-for-build)) (module-path %load-path) (extensions '()) - (deprecation-warnings #f) - - ;; TODO: This flag is here to prevent a full - ;; rebuild. Remove it on the next rebuild cycle. - (pre-load-modules? #t)) + (deprecation-warnings #f)) "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." @@ -1257,11 +1245,8 @@ they can refer to each other." (let* ((base (basename entry ".scm")) (output (string-append output "/" base ".go"))) (format #t "[~2@a/~2@a] Compiling '~a'...~%" - (+ 1 processed - (ungexp-splicing (if pre-load-modules? - (gexp ((ungexp total))) - (gexp ())))) - (ungexp (* total (if pre-load-modules? 2 1))) + (+ 1 processed (ungexp total)) + (ungexp (* total 2)) entry) (compile-file entry #:output-file output @@ -1275,6 +1260,26 @@ they can refer to each other." processed entries))) + (define* (load-from-directory directory + #:optional (loaded 0)) + "Load all the source files found in DIRECTORY." + ;; XXX: This works around . + (let ((entries (map (cut string-append directory "/" <>) + (scandir directory regular?)))) + (fold (lambda (file loaded) + (if (file-is-directory? file) + (load-from-directory file loaded) + (begin + (format #t "[~2@a/~2@a] Loading '~a'...~%" + (+ 1 loaded) (ungexp (* 2 total)) + file) + (save-module-excursion + (lambda () + (primitive-load file))) + (+ 1 loaded)))) + loaded + entries))) + (setvbuf (current-output-port) (cond-expand (guile-2.2 'line) (else _IOLBF))) @@ -1310,32 +1315,7 @@ they can refer to each other." (mkdir (ungexp output)) (chdir (ungexp modules)) - (ungexp-splicing - (if pre-load-modules? - (gexp ((define* (load-from-directory directory - #:optional (loaded 0)) - "Load all the source files found in DIRECTORY." - ;; XXX: This works around . - (let ((entries (map (cut string-append directory "/" <>) - (scandir directory regular?)))) - (fold (lambda (file loaded) - (if (file-is-directory? file) - (load-from-directory file loaded) - (begin - (format #t "[~2@a/~2@a] Loading '~a'...~%" - (+ 1 loaded) - (ungexp (* 2 total)) - file) - (save-module-excursion - (lambda () - (primitive-load file))) - (+ 1 loaded)))) - loaded - entries))) - - (load-from-directory "."))) - (gexp ()))) - + (load-from-directory ".") (process-directory "." (ungexp output) 0)))) ;; TODO: Pass MODULES as an environment variable. diff --git a/guix/packages.scm b/guix/packages.scm index 9cd4cbc416..92859be441 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -642,9 +642,6 @@ specifies modules in scope when evaluating SNIPPET." (let ((name (tarxz-name original-file-name))) (gexp->derivation name build - ;; TODO: Remove this on the next rebuild cycle. - #:pre-load-modules? #f - #:graft? #f #:system system #:deprecation-warnings #t ;to avoid a rebuild -- cgit v1.2.3 From 25c639e2a3b96204950f1ac8a92cb518783f0d61 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 17 Jun 2019 15:55:36 +0200 Subject: packages: 'patch-and-repack' no longer uses #:deprecation-warnings. * guix/packages.scm (patch-and-repack): Remove #:deprecation-warnings argument passed to 'gexp->derivation'. --- guix/packages.scm | 1 - 1 file changed, 1 deletion(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index 92859be441..9d2ab5be0f 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -644,7 +644,6 @@ specifies modules in scope when evaluating SNIPPET." (gexp->derivation name build #:graft? #f #:system system - #:deprecation-warnings #t ;to avoid a rebuild #:guile-for-build guile-for-build #:properties `((type . origin) (patches . ,(length patches))))))) -- cgit v1.2.3 From 814e12dc87a191718374d811c0a3024d38dffcbb Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sun, 16 Jun 2019 10:50:15 +0200 Subject: packages: Retain version in file name when repacking source checkouts. Fixes . * guix/packages.scm (patch-and-repack): If FILE-NAME is a source checkout, reuse the name without the '-checkout' part. --- guix/packages.scm | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index 9d2ab5be0f..ac965acd2f 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2015 Eric Bavier ;;; Copyright © 2016 Alex Kost ;;; Copyright © 2017 Efraim Flashner +;;; Copyright © 2019 Marius Bakke ;;; ;;; This file is part of GNU Guix. ;;; @@ -505,11 +506,17 @@ specifies modules in scope when evaluating SNIPPET." (and=> (file-extension file-name) (cut string-every char-set:hex-digit <>))) + (define (checkout? directory) + ;; Return true if DIRECTORY is a checkout (git, svn, etc). + (string-suffix? "-checkout" directory)) + (define (tarxz-name file-name) ;; Return a '.tar.xz' file name based on FILE-NAME. - (let ((base (if (numeric-extension? file-name) - original-file-name - (file-sans-extension file-name)))) + (let ((base (cond ((numeric-extension? file-name) + original-file-name) + ((checkout? file-name) + (string-drop-right file-name 9)) + (else (file-sans-extension file-name))))) (string-append base (if (equal? (file-extension base) "tar") ".xz" -- cgit v1.2.3 From 6cef554be8926b026226b4bfd0bb2f37bd24aeae Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 1 Aug 2019 08:46:13 -0400 Subject: packages: Apply target triplet in bag-transitive-host-inputs. Fixes a bug where propagated inputs that should be cross-compiled are instead compiled for the host system. * guix/packages.scm (bag-transitive-host-inputs): Call transitive-inputs in the context of the bag's target system triplet. --- guix/packages.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index c94a651f27..143417b861 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -796,7 +796,8 @@ dependencies are known to build on SYSTEM." (define (bag-transitive-host-inputs bag) "Same as 'package-transitive-target-inputs', but applied to a bag." - (transitive-inputs (bag-host-inputs bag))) + (parameterize ((%current-target-system (bag-target bag))) + (transitive-inputs (bag-host-inputs bag)))) (define (bag-transitive-target-inputs bag) "Return the \"target inputs\" of BAG, recursively." -- cgit v1.2.3 From bc60349b5bc58a0b803df5adce1de6db82453744 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 6 Sep 2019 14:41:58 +0200 Subject: packages: 'supported-package?' binds '%current-system' for graph traversal. Previously, (supported-package? coreutils "armhf-linux") with (%current-system) = "x86_64-linux" would return false. That's because 'supported-package?' would traverse the x86_64 dependency graph, which contains 'tcc-boot0', which supports x86 only. Consequently, 'supported-package?' would match only 53 packages for "armhf-linux" when running on x86, as is the case during continuous integration. * guix/packages.scm (package-transitive-supported-systems): Add an optional 'system' parameter. Use 'mlambda' instead of 'mlambdaq' for memoization. (supported-package?): Pass 'system' to 'package-transitive-supported-systems'. * tests/packages.scm ("package-transitive-supported-systems, implicit inputs") ("package-transitive-supported-systems: reduced binary seed, implicit inputs"): Remove calls to 'invalidate-memoization!', which no longer work and were presumably introduced to work around the bug we're fixing (see commit 0db65c168fd6dec57a357735fe130c80feba5460). * tests/packages.scm ("supported-package?"): Rewrite test to use only existing system name since otherwise 'bootstrap-executable' raises an exception. ("supported-package? vs. system-dependent graph"): New test. --- guix/packages.scm | 30 ++++++++++++++++++------------ tests/packages.scm | 36 +++++++++++++++++++++++++++++------- 2 files changed, 47 insertions(+), 19 deletions(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index d9eeee15a2..39ab28d807 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -767,23 +767,29 @@ in INPUTS and their transitive propagated inputs." (transitive-inputs inputs))) (define package-transitive-supported-systems - (mlambdaq (package) - "Return the intersection of the systems supported by PACKAGE and those + (let () + (define supported-systems + (mlambda (package system) + (parameterize ((%current-system system)) + (fold (lambda (input systems) + (match input + ((label (? package? package) . _) + (lset-intersection string=? systems + (supported-systems package system))) + (_ + systems))) + (package-supported-systems package) + (bag-direct-inputs (package->bag package)))))) + + (lambda* (package #:optional (system (%current-system))) + "Return the intersection of the systems supported by PACKAGE and those supported by its dependencies." - (fold (lambda (input systems) - (match input - ((label (? package? p) . _) - (lset-intersection - string=? systems (package-transitive-supported-systems p))) - (_ - systems))) - (package-supported-systems package) - (bag-direct-inputs (package->bag package))))) + (supported-systems package system)))) (define* (supported-package? package #:optional (system (%current-system))) "Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its dependencies are known to build on SYSTEM." - (member system (package-transitive-supported-systems package))) + (member system (package-transitive-supported-systems package system))) (define (bag-direct-inputs bag) "Same as 'package-direct-inputs', but applied to a bag." diff --git a/tests/packages.scm b/tests/packages.scm index 0478fff237..423c5061aa 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -341,7 +341,6 @@ (build-system gnu-build-system) (supported-systems `("does-not-exist" "foobar" ,@%supported-systems))))) - (invalidate-memoization! package-transitive-supported-systems) (parameterize ((%current-system "armhf-linux")) ; a traditionally-bootstrapped architecture (package-transitive-supported-systems p)))) @@ -354,17 +353,40 @@ (build-system gnu-build-system) (supported-systems `("does-not-exist" "foobar" ,@%supported-systems))))) - (invalidate-memoization! package-transitive-supported-systems) (parameterize ((%current-system "x86_64-linux")) (package-transitive-supported-systems p)))) (test-assert "supported-package?" - (let ((p (dummy-package "foo" - (build-system gnu-build-system) - (supported-systems '("x86_64-linux" "does-not-exist"))))) + (let* ((d (dummy-package "dep" + (build-system trivial-build-system) + (supported-systems '("x86_64-linux")))) + (p (dummy-package "foo" + (build-system gnu-build-system) + (inputs `(("d" ,d))) + (supported-systems '("x86_64-linux" "armhf-linux"))))) + (and (supported-package? p "x86_64-linux") + (not (supported-package? p "i686-linux")) + (not (supported-package? p "armhf-linux"))))) + +(test-assert "supported-package? vs. system-dependent graph" + ;; The inputs of a package can depend on (%current-system). Thus, + ;; 'supported-package?' must make sure that it binds (%current-system) + ;; appropriately before traversing the dependency graph. In the example + ;; below, 'supported-package?' must thus return true for both systems. + (let* ((p0a (dummy-package "foo-arm" + (build-system trivial-build-system) + (supported-systems '("armhf-linux")))) + (p0b (dummy-package "foo-x86_64" + (build-system trivial-build-system) + (supported-systems '("x86_64-linux")))) + (p (dummy-package "bar" + (build-system trivial-build-system) + (inputs + (if (string=? (%current-system) "armhf-linux") + `(("foo" ,p0a)) + `(("foo" ,p0b))))))) (and (supported-package? p "x86_64-linux") - (not (supported-package? p "does-not-exist")) - (not (supported-package? p "i686-linux"))))) + (supported-package? p "armhf-linux")))) (test-skip (if (not %store) 8 0)) -- cgit v1.2.3 From 36eef80d45ae754ba42a761ffc97e38cc7253bd0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 9 Sep 2019 10:19:59 +0200 Subject: packages: 'package-field-location' really catches 'system-error. This had been wrong since forever (i.e., 2013). * guix/packages.scm (package-field-location): Catch 'system-error, not 'system. --- guix/packages.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index 143417b861..b92ed0ab0c 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -351,7 +351,7 @@ object." (match (package-location package) (($ file line column) - (catch 'system + (catch 'system-error (lambda () ;; In general we want to keep relative file names for modules. (with-fluids ((%file-port-name-canonicalization 'relative)) -- cgit v1.2.3