From 7c8b7e35d020197cffadec2702438e9900192fc0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 30 Apr 2018 15:19:41 +0200 Subject: weather: Fix type error when reporting CI stats. * guix/scripts/weather.scm (report-server-coverage): Remove 'missing' binding above 'queued-subset' call. Before that 'queued-subset' would be called with a number instead of a list. --- guix/scripts/weather.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'guix/scripts') diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm index 5c934abae..d7c2fbea1 100644 --- a/guix/scripts/weather.scm +++ b/guix/scripts/weather.scm @@ -208,10 +208,10 @@ unavailable)~%")) 0 queue))) (newline) (unless (null? missing) - (let ((missing (length missing))) - (match (queued-subset queue missing) - (#f #f) - ((= length queued) + (match (queued-subset queue missing) + (#f #f) + ((= length queued) + (let ((missing (length missing))) (format #t (G_ " ~,1f% (~h out of ~h) of the missing items \ are queued~%") (* 100. (/ queued missing)) -- cgit v1.3 From bb6f94c71e9a8dfb1a0f5cad4b0196bdb175375c Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Tue, 1 May 2018 01:11:31 +0200 Subject: guix system: search: Display all provision names as 'shepherdnames'. * guix/scripts/system/search.scm (service-type-shepherd-names): Append provision lists together instead of returning a list of provision cars. --- guix/scripts/system/search.scm | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'guix/scripts') diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm index 7229c60a0..955cdd1e9 100644 --- a/guix/scripts/system/search.scm +++ b/guix/scripts/system/search.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018 Ludovic Courtès +;;; Copyright © 2018 Clément Lassieur ;;; ;;; This file is part of GNU Guix. ;;; @@ -59,10 +60,8 @@ provided TYPE has a default value." (define (service-type-shepherd-names type) "Return the default names of Shepherd services created for TYPE." - (match (map shepherd-service-provision - (service-type-default-shepherd-services type)) - (((names . _) ...) - names))) + (append-map shepherd-service-provision + (service-type-default-shepherd-services type))) (define* (service-type->recutils type port #:optional (width (%text-width)) -- cgit v1.3 From 2d2f98efb36db3f003d950a004806234962b4f4d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 4 May 2018 15:05:05 +0200 Subject: guix build: Nicely report unbound variables with hints. * guix/ui.scm (print-unbound-variable-error): Add "error:" to the message. (report-unbound-variable-error): New procedure, with code formerly in 'report-load-error'. (report-load-error): Use it. (call-with-unbound-variable-handling): New procedure. (with-unbound-variable-handling): New macro. * guix/scripts/build.scm (options->derivations): Wrap body in 'with-unbound-variable-handling'. * tests/guix-build.sh (GUIX_PACKAGE_PATH): Add test. --- guix/scripts/build.scm | 76 ++++++++++++++++++++++++++------------------------ guix/ui.scm | 51 +++++++++++++++++++++++++-------- tests/guix-build.sh | 21 +++++++++++++- 3 files changed, 100 insertions(+), 48 deletions(-) (limited to 'guix/scripts') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 401087e83..4dd4fbccd 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -661,43 +661,47 @@ build." (define system (assoc-ref opts 'system)) (define graft? (assoc-ref opts 'graft?)) - (parameterize ((%graft? graft?)) - (append-map (match-lambda - ((? package? p) - (let ((p (or (and graft? (package-replacement p)) p))) - (match src - (#f - (list (package->derivation store p system))) - (#t - (match (package-source p) - (#f - (format (current-error-port) - (G_ "~a: warning: \ + ;; We may get 'unbound-variable' errors while evaluating the 'inputs' fields + ;; of user packages. Since 'guix build' is the primary tool for people + ;; testing new packages, report such errors gracefully. + (with-unbound-variable-handling + (parameterize ((%graft? graft?)) + (append-map (match-lambda + ((? package? p) + (let ((p (or (and graft? (package-replacement p)) p))) + (match src + (#f + (list (package->derivation store p system))) + (#t + (match (package-source p) + (#f + (format (current-error-port) + (G_ "~a: warning: \ package '~a' has no source~%") - (location->string (package-location p)) - (package-name p)) - '()) - (s - (list (package-source-derivation store s))))) - (proc - (map (cut package-source-derivation store <>) - (proc p)))))) - ((? derivation? drv) - (list drv)) - ((? procedure? proc) - (list (run-with-store store - (mbegin %store-monad - (set-guile-for-build (default-guile)) - (proc)) - #:system system))) - ((? gexp? gexp) - (list (run-with-store store - (mbegin %store-monad - (set-guile-for-build (default-guile)) - (gexp->derivation "gexp" gexp - #:system system)))))) - (map (cut transform store <>) - (options->things-to-build opts))))) + (location->string (package-location p)) + (package-name p)) + '()) + (s + (list (package-source-derivation store s))))) + (proc + (map (cut package-source-derivation store <>) + (proc p)))))) + ((? derivation? drv) + (list drv)) + ((? procedure? proc) + (list (run-with-store store + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (proc)) + #:system system))) + ((? gexp? gexp) + (list (run-with-store store + (mbegin %store-monad + (set-guile-for-build (default-guile)) + (gexp->derivation "gexp" gexp + #:system system)))))) + (map (cut transform store <>) + (options->things-to-build opts)))))) (define (show-build-log store file urls) "Show the build log for FILE, falling back to remote logs from URLS if diff --git a/guix/ui.scm b/guix/ui.scm index 223d2eb2a..8d351607d 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -76,6 +76,7 @@ show-manifest-transaction call-with-error-handling with-error-handling + with-unbound-variable-handling leave-on-EPIPE read/eval read/eval-package-expression @@ -158,7 +159,7 @@ messages." ((proc message (variable) _ ...) ;; We can always omit PROC because when it's useful (i.e., different from ;; "module-lookup"), it gets displayed before. - (format port (G_ "~a: unbound variable") variable)) + (format port (G_ "error: ~a: unbound variable") variable)) (_ (default-printer)))) @@ -309,6 +310,21 @@ PORT." (- (terminal-columns) 5)))) (texi->plain-text message)))) +(define* (report-unbound-variable-error args #:key frame) + "Return the given unbound-variable error, where ARGS is the list of 'throw' +arguments." + (match args + ((key . args) + (print-exception (current-error-port) frame key args))) + (match args + (('unbound-variable proc message (variable) _ ...) + (match (known-variable-definition variable) + (#f + (display-hint (G_ "Did you forget a @code{use-modules} form?"))) + ((? module? module) + (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?") + (module-name module)))))))) + (define* (report-load-error file args #:optional frame) "Report the failure to load FILE, a user-provided Scheme file. ARGS is the list of arguments received by the 'throw' handler." @@ -329,16 +345,8 @@ ARGS is the list of arguments received by the 'throw' handler." (let ((loc (source-properties->location properties))) (format (current-error-port) (G_ "~a: error: ~a~%") (location->string loc) message))) - (('unbound-variable proc message (variable) _ ...) - (match args - ((key . args) - (print-exception (current-error-port) frame key args))) - (match (known-variable-definition variable) - (#f - (display-hint (G_ "Did you forget a @code{use-modules} form?"))) - (module - (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?") - (module-name module)))))) + (('unbound-variable _ ...) + (report-unbound-variable-error args #:frame frame)) (('srfi-34 obj) (if (message-condition? obj) (if (error-location? obj) @@ -379,6 +387,27 @@ exiting. ARGS is the list of arguments received by the 'throw' handler." (warning (G_ "failed to load '~a':~%") file) (apply display-error #f (current-error-port) args)))) +(define (call-with-unbound-variable-handling thunk) + (define tag + (make-prompt-tag "user-code")) + + (catch 'unbound-variable + (lambda () + (call-with-prompt tag + thunk + (const #f))) + (const #t) + (rec (handle-error . args) + (let* ((stack (make-stack #t handle-error tag)) + (frame (and stack (last-frame-with-source stack)))) + (report-unbound-variable-error args #:frame frame) + (exit 1))))) + +(define-syntax-rule (with-unbound-variable-handling exp ...) + "Capture 'unbound-variable' exceptions in the dynamic extent of EXP... and +report them in a user-friendly way." + (call-with-unbound-variable-handling (lambda () exp ...))) + (define (install-locale) "Install the current locale settings." (catch 'system-error diff --git a/tests/guix-build.sh b/tests/guix-build.sh index b84723fa4..92e729932 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès +# Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès # # This file is part of GNU Guix. # @@ -138,6 +138,25 @@ test `guix build -d --sources=transitive foo \ | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \ | wc -l` -eq 3 + +# Unbound variables. +cat > "$module_dir/foo.scm"< "$module_dir/err" || true +grep "unbound" "$module_dir/err" # actual error +grep "forget.*(gnu packages base)" "$module_dir/err" # hint +rm -f "$module_dir"/* + # Should all return valid log files. drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" -- cgit v1.3