From 3b32891b12ee18c57b0fc346ed7dce8b6976066b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 20 Nov 2018 18:25:13 +0100 Subject: lint: 'check-derivation' tries all the package's supported systems. This allows us to catch architecture-specific evaluation failures. * guix/scripts/lint.scm (check-derivation): Move body into... [try]: ... this. New procedure. Call 'try' for each supported system of PACKAGE. --- guix/scripts/lint.scm | 54 ++++++++++++++++++++++++++++----------------------- 1 file changed, 30 insertions(+), 24 deletions(-) (limited to 'guix') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index e477bf0ddc..e8cf2dc1ff 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -774,30 +774,36 @@ descriptions maintained upstream." (define (check-derivation package) "Emit a warning if we fail to compile PACKAGE to a derivation." - (catch #t - (lambda () - (guard (c ((nix-protocol-error? c) - (emit-warning package - (format #f (G_ "failed to create derivation: ~a") - (nix-protocol-error-message c)))) - ((message-condition? c) - (emit-warning package - (format #f (G_ "failed to create derivation: ~a") - (condition-message c))))) - (with-store store - ;; Disable grafts since it can entail rebuilds. - (package-derivation store package #:graft? #f) - - ;; If there's a replacement, make sure we can compute its - ;; derivation. - (match (package-replacement package) - (#f #t) - (replacement - (package-derivation store replacement #:graft? #f)))))) - (lambda args - (emit-warning package - (format #f (G_ "failed to create derivation: ~s~%") - args))))) + (define (try system) + (catch #t + (lambda () + (guard (c ((nix-protocol-error? c) + (emit-warning package + (format #f (G_ "failed to create ~a derivation: ~a") + system + (nix-protocol-error-message c)))) + ((message-condition? c) + (emit-warning package + (format #f (G_ "failed to create ~a derivation: ~a") + system + (condition-message c))))) + (with-store store + ;; Disable grafts since it can entail rebuilds. + (package-derivation store package system #:graft? #f) + + ;; If there's a replacement, make sure we can compute its + ;; derivation. + (match (package-replacement package) + (#f #t) + (replacement + (package-derivation store replacement system + #:graft? #f)))))) + (lambda args + (emit-warning package + (format #f (G_ "failed to create ~a derivation: ~s") + system args))))) + + (for-each try (package-supported-systems package))) (define (check-license package) "Warn about type errors of the 'license' field of PACKAGE." -- cgit v1.2.3 From 40bbcaa65d90a8c869d9732af26cb6ceb8e81ca8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 20 Nov 2018 18:28:34 +0100 Subject: lint: 'check-derivation' fully disables grafts. Previously grafting could take place indirectly, for instance when lowering origins. * guix/scripts/lint.scm (check-derivation)[try]: Parameterize '%graft?'. --- guix/scripts/lint.scm | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) (limited to 'guix') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index e8cf2dc1ff..2314f3b28c 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -33,6 +33,7 @@ #:use-module (guix packages) #:use-module (guix licenses) #:use-module (guix records) + #:use-module (guix grafts) #:use-module (guix ui) #:use-module (guix upstream) #:use-module (guix utils) @@ -789,15 +790,16 @@ descriptions maintained upstream." (condition-message c))))) (with-store store ;; Disable grafts since it can entail rebuilds. - (package-derivation store package system #:graft? #f) - - ;; If there's a replacement, make sure we can compute its - ;; derivation. - (match (package-replacement package) - (#f #t) - (replacement - (package-derivation store replacement system - #:graft? #f)))))) + (parameterize ((%graft? #f)) + (package-derivation store package system #:graft? #f) + + ;; If there's a replacement, make sure we can compute its + ;; derivation. + (match (package-replacement package) + (#f #t) + (replacement + (package-derivation store replacement system + #:graft? #f))))))) (lambda args (emit-warning package (format #f (G_ "failed to create ~a derivation: ~s") -- cgit v1.2.3 From 3dd28aa37cc3f3a6bbb5f7f8d9fb49cc457b0c10 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Wed, 21 Nov 2018 01:19:54 +0300 Subject: describe: Fix 'format' option. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fix ‘guix describe’ ignores ‘--format=FORMAT’ option. * guix/scripts/describe.scm (%options): Fix 'format' option. --- guix/scripts/describe.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index e59502076c..d3203e9924 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -40,7 +40,7 @@ (lambda (opt name arg result) (unless (member arg '("human" "channels")) (leave (G_ "~a: unsupported output format~%") arg)) - (alist-cons 'format 'channels result))) + (alist-cons 'format (string->symbol arg) result))) (option '(#\h "help") #f #f (lambda args (show-help) -- cgit v1.2.3 From 1255400faabfcf0ca1666d17f2f34ea0d49f6b1f Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Wed, 21 Nov 2018 11:23:25 +0300 Subject: describe: Add profile option. * guix/scripts/describe.scm (%options): Add profile option. (show-help): Document this. (display-checkout-info): Check for profile argument. * doc/guix.texi (Invoking guix describe): Document this. --- guix/scripts/describe.scm | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index d3203e9924..d817d7f7ca 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -41,6 +41,10 @@ (unless (member arg '("human" "channels")) (leave (G_ "~a: unsupported output format~%") arg)) (alist-cons 'format (string->symbol arg) result))) + (option '(#\p "profile") #t #f + (lambda (opt name arg result) + (alist-cons 'profile (canonicalize-profile arg) + result))) (option '(#\h "help") #f #f (lambda args (show-help) @@ -58,6 +62,8 @@ Display information about the channels currently in use.\n")) (display (G_ " -f, --format=FORMAT display information in the given FORMAT")) + (display (G_ " + -p, --profile=PROFILE display information about PROFILE")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -78,11 +84,11 @@ Display information about the channels currently in use.\n")) (format #t (G_ "~%;; warning: GUIX_PACKAGE_PATH=\"~a\"~%") string)))))) -(define (display-checkout-info fmt) +(define* (display-checkout-info fmt #:optional directory) "Display information about the current checkout according to FMT, a symbol denoting the requested format. Exit if the current directory does not lie within a Git checkout." - (let* ((program (car (command-line))) + (let* ((program (or directory (car (command-line)))) (directory (catch 'git-error (lambda () (repository-discover (dirname program))) @@ -146,15 +152,16 @@ in the format specified by FMT." ;;; (define (guix-describe . args) - (let* ((opts (args-fold* args %options - (lambda (opt name arg result) - (leave (G_ "~A: unrecognized option~%") - name)) - cons - %default-options)) - (format (assq-ref opts 'format))) + (let* ((opts (args-fold* args %options + (lambda (opt name arg result) + (leave (G_ "~A: unrecognized option~%") + name)) + cons + %default-options)) + (format (assq-ref opts 'format)) + (profile (or (assq-ref opts 'profile) (current-profile)))) (with-error-handling - (match (current-profile) + (match profile (#f (display-checkout-info format)) (profile -- cgit v1.2.3