From 49483f71381ad32cdbe81b1c8ed2cc023329cc18 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 8 Nov 2017 13:26:08 +0100 Subject: services: Add 'lookup-service-types'. * gnu/services.scm (lookup-service-types): New procedure. * tests/services.scm ("lookup-service-types"): New test. --- tests/services.scm | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/services.scm b/tests/services.scm index 8484ee982a..ca32b565c4 100644 --- a/tests/services.scm +++ b/tests/services.scm @@ -23,7 +23,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) - #:use-module (srfi srfi-64)) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) (define live-service (@@ (gnu services herd) live-service)) @@ -206,4 +207,11 @@ (list (map live-service-provision unload) (map shepherd-service-provision load))))) +(test-eq "lookup-service-types" + system-service-type + (and (null? (lookup-service-types 'does-not-exist-at-all)) + (match (lookup-service-types 'system) + ((one) one) + (x x)))) + (test-end) -- cgit 1.4.1 From c5a4a92f1a796e342b7db4c458f1fdb61ffc8d40 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 8 Nov 2017 13:33:25 +0100 Subject: gnu: Improve error reporting of the use-.*modules macros. Suggested by Julien Lepiller and myglc2 at . * gnu.scm (%try-use-modules): New procedure. (package-module-hint, service-module-hint): New procedures. (try-use-modules): New macro. (use-package-modules, use-service-modules, use-system-modules): Use it. * tests/guix-system.sh: Test it. --- gnu.scm | 100 ++++++++++++++++++++++++++++++++++++++++++++++++--- po/guix/POTFILES.in | 1 + tests/guix-system.sh | 28 +++++++++++++++ 3 files changed, 125 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/gnu.scm b/gnu.scm index 913ce61600..3e7e7c0ebc 100644 --- a/gnu.scm +++ b/gnu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2015 Joshua S. Grant ;;; Copyright © 2017 Mathieu Othacehe ;;; @@ -19,6 +19,14 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu) + #:use-module (guix i18n) + #:use-module (guix utils) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (ice-9 match) + #:use-module (guix packages) + #:use-module (gnu packages) + #:use-module (gnu services) #:export (use-package-modules use-service-modules use-system-modules)) @@ -52,13 +60,97 @@ (module-use! i (resolve-interface m)))) %public-modules))) +(define (%try-use-modules modules location make-hint) + "Attempt to load all of MODULES. Report errors as coming from LOCATION, a + record, and use MAKE-HINT to produce a fix hint." + (define (location->string loc) + (match loc + (#f "") + (($ file line column) + (format #f "~a:~a:~a: " file line column)))) + + (for-each (lambda (module) + (catch 'misc-error + (lambda () + (process-use-modules `((,module)))) + (lambda _ + (raise + (apply + make-compound-condition + (condition + (&message + (message (format #f (G_ "module ~a not found") + module)))) + (condition + (&error-location (location location))) + (or (and=> (make-hint module) list) + '())))))) + modules)) + +(define (package-module-hint module) + (define last-name + (match module + ((_ ... last) + (symbol->string last)))) + + (match (find-packages-by-name last-name) + (() + (condition + (&fix-hint + (hint (G_ "\ +You may use @command{guix package --show=foo | grep location} to search +for the location of package @code{foo}. +If you get the line @code{location: gnu/packages/bar.scm:174:2}, +add @code{bar} to the @code{use-package-modules} form."))))) + ((package _ ...) + (condition + (&fix-hint + (hint (format #f (G_ "\ +Try adding @code{(use-package-modules ~a)}.") + (basename (location-file (package-location package)) + ".scm")))))))) + +(define (service-module-hint module) + (define last-name + (match module + ((_ ... last) + last))) + + (match (lookup-service-types last-name) + (() + (condition + (&fix-hint + (hint (format #f (G_ "\ +You may use @command{guix system search ~a} to search for a service +matching @code{~a}. +If you get the line @code{location: gnu/services/foo.scm:188:2}, +add @code{foo} to the @code{use-service-modules} form.") + last-name last-name))))) + ((package _ ...) + (condition + (&fix-hint + (hint (format #f (G_ "\ +Try adding @code{(use-service-modules ~a)}.") + (basename (location-file (service-type-location package)) + ".scm")))))))) + +(define-syntax-rule (try-use-modules hint modules ...) + (eval-when (expand load eval) + (%try-use-modules '(modules ...) + (source-properties->location + (current-source-location)) + hint))) + (define-syntax-rule (use-package-modules module ...) - (use-modules (gnu packages module) ...)) + (try-use-modules package-module-hint + (gnu packages module) ...)) (define-syntax-rule (use-service-modules module ...) - (use-modules (gnu services module) ...)) + (try-use-modules service-module-hint + (gnu services module) ...)) (define-syntax-rule (use-system-modules module ...) - (use-modules (gnu system module) ...)) + (try-use-modules (const #f) ;no hint + (gnu system module) ...)) ;;; gnu.scm ends here diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index e3f767cc67..6510b99e8f 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -1,5 +1,6 @@ # List of source files which contain translatable strings. # This should be source files of the various tools, and not package modules. +gnu.scm gnu/packages.scm gnu/services.scm gnu/system.scm diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 31ee637133..1346d8d5a8 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -68,6 +68,34 @@ else fi +# Reporting of module not found errors. + +cat > "$tmpfile" < "$errorfile" +then false +else + grep "$tmpfile:3:2: .*module .*openssh.*not found" "$errorfile" + grep "Try.*use-service-modules ssh" "$errorfile" +fi + +cat > "$tmpfile" < "$errorfile" +then false +else + grep "$tmpfile:3:2: .*module .*qemu.*not found" "$errorfile" + grep "Try.*use-package-modules virtualization" "$errorfile" +fi + # Reporting of unbound variables. cat > "$tmpfile" < Date: Fri, 10 Nov 2017 00:02:30 +0100 Subject: tests: Adjust to unbound-variable exception printer. * tests/guix-system.sh: Adjust unbound-variable test for commit dc856223f5eab57d8a4881782ec0f50abd12afa3. --- tests/guix-system.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 1346d8d5a8..4bb866adfa 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -123,9 +123,9 @@ else then # FIXME: With Guile 2.2.0 the error is reported on line 4. # See . - grep "$tmpfile:[49]:.*[Uu]nbound variable.*GRUB-config" "$errorfile" + grep "$tmpfile:[49]:[0-9]: GRUB-config.*[Uu]nbound variable" "$errorfile" else - grep "$tmpfile:9:.*[Uu]nbound variable.*GRUB-config" "$errorfile" + grep "$tmpfile:9:[0-9]: GRUB-config.*[Uu]nbound variable" "$errorfile" fi fi -- cgit 1.4.1 From 4ad3a3f995dc9bd00edbe37eb773bf07d1ad14c0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 11 Nov 2017 15:33:04 +0100 Subject: tests: Refer to "time@1.8". This is a followup to dd00e0919fcecd895ff4e5a646cf068f46ff8d12. * tests/guix-build.sh: Refer to "time@1.8". --- tests/guix-build.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 880a582777..004a40dee2 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -184,7 +184,7 @@ test "`guix build superseded -d`" = "`guix build bar -d`" # Parsing package names and versions. guix build -n time # PASS -guix build -n time@1.7 # PASS, version found +guix build -n time@1.8 # PASS, version found if guix build -n time@3.2; # FAIL, version not found then false; else true; fi if guix build -n something-that-will-never-exist; # FAIL -- cgit 1.4.1 From ae0307f7c2a6f382311a1cedcbbb3d35b6623bab Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 11 Nov 2017 15:33:47 +0100 Subject: tests: Adjust to new unbound-variable error message. This is a followup to dc856223f5eab57d8a4881782ec0f50abd12afa3. * tests/guix-package.sh: Adjust unbound-variable message regexp. --- tests/guix-package.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 99952f130c..ffc8c64e24 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -337,6 +337,6 @@ if guix package --bootstrap -n -m "$module_dir/manifest.scm" \ then false else cat "$module_dir/stderr" - grep "manifest.scm:[1-3]:.*[Uu]nbound variable.*wonderful-package" \ + grep "manifest.scm:[1-3]:.*wonderful-package.*: unbound variable" \ "$module_dir/stderr" fi -- cgit 1.4.1 From ff23b47dbee038236386ddc2ed2fff4c77ad3aa1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 13 Nov 2017 09:58:47 +0100 Subject: tests: 'guix-gc.sh' passes even when 'out' or 'drv' are defined as env vars. This fixes a test failure exhibited by fb17a89912c2a3738dae716e30481c11e1c6f0ac whereby assignments to 'out' in guix-gc.sh would go to the 'out' environment variable, when it exists, which in turn prevents garbage collection of $out. * tests/guix-gc.sh: Add 'unset' invocations. --- tests/guix-gc.sh | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh index a100f186f5..57c5e7dd61 100644 --- a/tests/guix-gc.sh +++ b/tests/guix-gc.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2013, 2015 Ludovic Courtès +# Copyright © 2013, 2015, 2017 Ludovic Courtès # # This file is part of GNU Guix. # @@ -25,6 +25,14 @@ guix gc --version trap "rm -f guix-gc-root" EXIT rm -f guix-gc-root +# Below we are using 'drv' and 'out' to contain store file names. If 'drv' +# and 'out' are environment variables, 'list-runtime-roots' will "see" them +# and thus prevent $drv and $out from being garbage-collected. Using 'unset' +# allows us to make sure these are truly local shell variables and not +# environments variables. +unset drv +unset out + # For some operations, passing extra arguments is an error. for option in "" "-C 500M" "--verify" "--optimize" do -- cgit 1.4.1 From 19fd7229bc668e5b34adc5357557aff3f62b9308 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 17 Nov 2017 10:47:11 +0100 Subject: workers: Add test with exceptions. * tests/workers.scm ("exceptions"): New test. --- tests/workers.scm | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) (limited to 'tests') diff --git a/tests/workers.scm b/tests/workers.scm index 44b882f691..4eaefbb43d 100644 --- a/tests/workers.scm +++ b/tests/workers.scm @@ -42,4 +42,30 @@ (poll))) result)) +;; Same as above, but throw exceptions within the workers and make sure they +;; remain alive. +(test-equal "exceptions" + 4242 + (let* ((pool (make-pool 10)) + (result 0) + (1+! (let ((lock (make-mutex))) + (lambda () + (with-mutex lock + (set! result (+ result 1))))))) + (let loop ((i 10)) + (unless (zero? i) + (pool-enqueue! pool (lambda () + (throw 'whatever))) + (loop (- i 1)))) + (let loop ((i 4242)) + (unless (zero? i) + (pool-enqueue! pool 1+!) + (loop (- i 1)))) + (let poll () + (unless (pool-idle? pool) + (pk 'busy result) + (sleep 1) + (poll))) + result)) + (test-end) -- cgit 1.4.1