From f9e8a12379c6fefc9e5c3c7fc3926599bbefc013 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 21 Jan 2019 17:41:11 +0100 Subject: store: Rename '&nix-error' to '&store-error'. * guix/store.scm (&nix-error): Rename to... (&store-error): ... this, and adjust users. (&nix-connection-error): Rename to... (&store-connection-error): ... this, and adjust users. (&nix-protocol-error): Rename to... (&store-protocol-error): ... this, adjust users. (&nix-error, &nix-connection-error, &nix-protocol-error): Define these condition types and their getters as deprecrated aliases. * build-aux/run-system-tests.scm, guix/derivations.scm, guix/grafts.scm, guix/scripts/challenge.scm, guix/scripts/graph.scm, guix/scripts/lint.scm, guix/scripts/offload.scm, guix/serialization.scm, guix/ssh.scm, guix/tests.scm, guix/ui.scm, tests/derivations.scm, tests/gexp.scm, tests/guix-daemon.sh, tests/packages.scm, tests/store.scm, doc/guix.texi: Adjust to use the new names. --- tests/derivations.scm | 42 +++++++++++++++++++++--------------------- tests/gexp.scm | 4 ++-- tests/guix-daemon.sh | 8 ++++---- tests/packages.scm | 2 +- tests/store.scm | 46 +++++++++++++++++++++++----------------------- 5 files changed, 51 insertions(+), 51 deletions(-) (limited to 'tests') diff --git a/tests/derivations.scm b/tests/derivations.scm index 5f294c1827..c0601c0e88 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -185,9 +185,9 @@ (set-build-options %store #:use-substitutes? #f #:keep-going? #t) - (guard (c ((nix-protocol-error? c) - (and (= 100 (nix-protocol-error-status c)) - (string-contains (nix-protocol-error-message c) + (guard (c ((store-protocol-error? c) + (and (= 100 (store-protocol-error-status c)) + (string-contains (store-protocol-error-message c) (derivation-file-name d1)) (not (valid-path? %store (derivation->output-path d1))) (valid-path? %store (derivation->output-path d2))))) @@ -222,8 +222,8 @@ (test-assert "unknown built-in builder" (let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '()))) - (guard (c ((nix-protocol-error? c) - (string-contains (nix-protocol-error-message c) "failed"))) + (guard (c ((store-protocol-error? c) + (string-contains (store-protocol-error-message c) "failed"))) (build-derivations %store (list drv)) #f))) @@ -253,8 +253,8 @@ . ,(object->string (%local-url)))) #:hash-algo 'sha256 #:hash (sha256 (random-bytevector 100))))) ;wrong - (guard (c ((nix-protocol-error? c) - (string-contains (nix-protocol-error-message c) "failed"))) + (guard (c ((store-protocol-error? c) + (string-contains (store-protocol-error-message c) "failed"))) (build-derivations %store (list drv)) #f)))) @@ -268,8 +268,8 @@ . ,(object->string (%local-url)))) #:hash-algo 'sha256 #:hash (sha256 (random-bytevector 100))))) - (guard (c ((nix-protocol-error? c) - (string-contains (nix-protocol-error-message (pk c)) "failed"))) + (guard (c ((store-protocol-error? c) + (string-contains (store-protocol-error-message (pk c)) "failed"))) (build-derivations %store (list drv)) #f)))) @@ -279,8 +279,8 @@ (drv (derivation %store "world" "builtin:download" '() #:env-vars `(("url" . ,(object->string url)))))) - (guard (c ((nix-protocol-error? c) - (string-contains (nix-protocol-error-message c) "failed"))) + (guard (c ((store-protocol-error? c) + (string-contains (store-protocol-error-message c) "failed"))) (build-derivations %store (list drv)) #f))) @@ -607,7 +607,7 @@ `("-c" ,(string-append "echo " txt "> $out")) #:inputs `((,%bash) (,txt)) #:allowed-references '()))) - (guard (c ((nix-protocol-error? c) + (guard (c ((store-protocol-error? c) ;; There's no specific error message to check for. #t)) (build-derivations %store (list drv)) @@ -625,7 +625,7 @@ `("-c" ,"echo $out > $out") #:inputs `((,%bash)) #:allowed-references '()))) - (guard (c ((nix-protocol-error? c) + (guard (c ((store-protocol-error? c) ;; There's no specific error message to check for. #t)) (build-derivations %store (list drv)) @@ -644,7 +644,7 @@ `("-c" ,(string-append "echo " txt "> $out")) #:inputs `((,%bash) (,txt)) #:disallowed-references (list txt)))) - (guard (c ((nix-protocol-error? c) + (guard (c ((store-protocol-error? c) ;; There's no specific error message to check for. #t)) (build-derivations %store (list drv)) @@ -765,8 +765,8 @@ (builder '(begin (sleep 100) (mkdir %output) #t)) (drv (build-expression->derivation store "silent" builder)) (out-path (derivation->output-path drv))) - (guard (c ((nix-protocol-error? c) - (and (string-contains (nix-protocol-error-message c) + (guard (c ((store-protocol-error? c) + (and (string-contains (store-protocol-error-message c) "failed") (not (valid-path? store out-path))))) (build-derivations store (list drv)) @@ -779,8 +779,8 @@ (builder '(begin (sleep 100) (mkdir %output) #t)) (drv (build-expression->derivation store "slow" builder)) (out-path (derivation->output-path drv))) - (guard (c ((nix-protocol-error? c) - (and (string-contains (nix-protocol-error-message c) + (guard (c ((store-protocol-error? c) + (and (string-contains (store-protocol-error-message c) "failed") (not (valid-path? store out-path))))) (build-derivations store (list drv)) @@ -942,11 +942,11 @@ #f)) ; fail! (drv (build-expression->derivation %store "fail" builder)) (out-path (derivation->output-path drv))) - (guard (c ((nix-protocol-error? c) + (guard (c ((store-protocol-error? c) ;; Note that the output path may exist at this point, but it ;; is invalid. (and (string-match "build .* failed" - (nix-protocol-error-message c)) + (store-protocol-error-message c)) (not (valid-path? %store out-path))))) (build-derivations %store (list drv)) #f))) diff --git a/tests/gexp.scm b/tests/gexp.scm index c4b437cd49..cee2c96610 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -919,7 +919,7 @@ (chdir #$output) (symlink #$%bootstrap-guile "guile")) #:allowed-references '())))) - (guard (c ((nix-protocol-error? c) #t)) + (guard (c ((store-protocol-error? c) #t)) (build-derivations %store (list drv)) #f))) @@ -943,7 +943,7 @@ (chdir #$output) (symlink #$%bootstrap-guile "guile")) #:disallowed-references (list %bootstrap-guile))))) - (guard (c ((nix-protocol-error? c) #t)) + (guard (c ((store-protocol-error? c) #t)) (build-derivations %store (list drv)) #f))) diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index 9ae6e0b77a..4c19a55722 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +# Copyright © 2012, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès # # This file is part of GNU Guix. # @@ -109,7 +109,7 @@ guile -c " (define (build-without-failing drv) (lambda (store) - (guard (c ((nix-protocol-error? c) (values #t store))) + (guard (c ((store-protocol-error? c) (values #t store))) (build-derivations store (list drv)) (values #f store)))) @@ -177,9 +177,9 @@ client_code=' `("-e" ,build) #:inputs `((,bash) (,build)) #:env-vars `(("x" . ,(random-text)))))) - (exit (guard (c ((nix-protocol-error? c) + (exit (guard (c ((store-protocol-error? c) (->bool - (string-contains (pk (nix-protocol-error-message c)) + (string-contains (pk (store-protocol-error-message c)) "failed")))) (build-derivations store (list drv)) #f))))' diff --git a/tests/packages.scm b/tests/packages.scm index ed635d9011..29e5e4103c 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -570,7 +570,7 @@ (symlink %output (string-append %output "/self")) #t))))) (d (package-derivation %store p))) - (guard (c ((nix-protocol-error? c) #t)) + (guard (c ((store-protocol-error? c) #t)) (build-derivations %store (list d)) #f))) diff --git a/tests/store.scm b/tests/store.scm index 5ff9308d7d..e28c0c5aaa 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -63,9 +63,9 @@ (test-equal "connection handshake error" EPROTO (let ((port (%make-void-port "rw"))) - (guard (c ((nix-connection-error? c) - (and (eq? port (nix-connection-error-file c)) - (nix-connection-error-code c)))) + (guard (c ((store-connection-error? c) + (and (eq? port (store-connection-error-file c)) + (store-connection-error-code c)))) (open-connection #f #:port port) 'broken))) @@ -120,7 +120,7 @@ (test-assert "valid-path? error" (with-store s - (guard (c ((nix-protocol-error? c) #t)) + (guard (c ((store-protocol-error? c) #t)) (valid-path? s "foo") #f))) @@ -133,7 +133,7 @@ (with-store s (let-syntax ((true-if-error (syntax-rules () ((_ exp) - (guard (c ((nix-protocol-error? c) #t)) + (guard (c ((store-protocol-error? c) #t)) exp #f))))) (and (true-if-error (valid-path? s "foo")) (true-if-error (valid-path? s "bar")) @@ -274,7 +274,7 @@ (test-assert "references/substitutes missing reference info" (with-store s (set-build-options s #:use-substitutes? #f) - (guard (c ((nix-protocol-error? c) #t)) + (guard (c ((store-protocol-error? c) #t)) (let* ((b (add-to-store s "bash" #t "sha256" (search-bootstrap-binary "bash" (%current-system)))) @@ -422,7 +422,7 @@ %store "foo" `(display ,s) #:guile-for-build (package-derivation s %bootstrap-guile (%current-system))))) - (guard (c ((nix-protocol-error? c) #t)) + (guard (c ((store-protocol-error? c) #t)) (build-derivations %store (list d)))))))) "Here’s a Greek letter: λ.")) @@ -442,7 +442,7 @@ (display "lambda: λ\n")) #:guile-for-build (package-derivation %store %bootstrap-guile)))) - (guard (c ((nix-protocol-error? c) #t)) + (guard (c ((store-protocol-error? c) #t)) (build-derivations %store (list d)))))))) "garbage: �lambda: λ")) @@ -620,12 +620,12 @@ #:fallback? #f #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) - (guard (c ((nix-protocol-error? c) + (guard (c ((store-protocol-error? c) ;; XXX: the daemon writes "hash mismatch in downloaded ;; path", but the actual error returned to the client ;; doesn't mention that. (pk 'corrupt c) - (not (zero? (nix-protocol-error-status c))))) + (not (zero? (store-protocol-error-status c))))) (build-derivations s (list d)) #f)))))) @@ -646,7 +646,7 @@ (set-build-options s #:use-substitutes? #t #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) - (guard (c ((nix-protocol-error? c) + (guard (c ((store-protocol-error? c) ;; The substituter failed as expected. Now make ;; sure that #:fallback? #t works correctly. (set-build-options s @@ -712,9 +712,9 @@ (dump (call-with-bytevector-output-port (cute export-paths %store (list file2) <>)))) (delete-paths %store (list file0 file1 file2)) - (guard (c ((nix-protocol-error? c) - (and (not (zero? (nix-protocol-error-status c))) - (string-contains (nix-protocol-error-message c) + (guard (c ((store-protocol-error? c) + (and (not (zero? (store-protocol-error-status c))) + (string-contains (store-protocol-error-message c) "not valid")))) ;; Here we get an exception because DUMP does not include FILE0 and ;; FILE1, which are dependencies of FILE2. @@ -816,10 +816,10 @@ (bytevector-u8-set! dump index (logxor #xff byte))) (and (not (file-exists? file)) - (guard (c ((nix-protocol-error? c) + (guard (c ((store-protocol-error? c) (pk 'c c) - (and (not (zero? (nix-protocol-error-status c))) - (string-contains (nix-protocol-error-message c) + (and (not (zero? (store-protocol-error-status c))) + (string-contains (store-protocol-error-message c) "corrupt")))) (let* ((source (open-bytevector-input-port dump)) (imported (import-paths %store source))) @@ -906,10 +906,10 @@ (begin (write (random-text) entropy-port) (force-output entropy-port) - (guard (c ((nix-protocol-error? c) + (guard (c ((store-protocol-error? c) (pk 'determinism-exception c) - (and (not (zero? (nix-protocol-error-status c))) - (string-contains (nix-protocol-error-message c) + (and (not (zero? (store-protocol-error-status c))) + (string-contains (store-protocol-error-message c) "deterministic")))) ;; This one will produce a different result. Since we're in ;; 'check' mode, this must fail. @@ -945,10 +945,10 @@ #:guile-for-build (package-derivation store %bootstrap-guile (%current-system)))) (file (derivation->output-path drv))) - (guard (c ((nix-protocol-error? c) + (guard (c ((store-protocol-error? c) (pk 'multiple-build c) - (and (not (zero? (nix-protocol-error-status c))) - (string-contains (nix-protocol-error-message c) + (and (not (zero? (store-protocol-error-status c))) + (string-contains (store-protocol-error-message c) "deterministic")))) ;; This one will produce a different result on the second run. (current-build-output-port (current-error-port)) -- cgit v1.2.3 From f61e6e5238ff43b959c258ed92531029a1c82fa7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 21 Jan 2019 22:17:17 +0100 Subject: tests: Adjust for removal of 'device' field in . This is a followup to commit 5f7467f046c3c1648cdf6eb81b3ec041bfc1f9bb. * tests/guix-system.sh: For records, use 'target' rather than 'device'. --- tests/guix-system.sh | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'tests') diff --git a/tests/guix-system.sh b/tests/guix-system.sh index adb623d244..9903677a02 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -109,7 +109,7 @@ cat > "$tmpfile" < +;;; Copyright © 2018 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -52,6 +53,22 @@ ((weird _ ...) ;weird! (syntax-violation name "invalid field specifier" #'weird))))) +(define (report-duplicate-field-specifier name ctor) + "Report the first duplicate identifier among the bindings in CTOR." + (syntax-case ctor () + ((_ bindings ...) + (let loop ((bindings #'(bindings ...)) + (seen '())) + (syntax-case bindings () + (((field value) rest ...) + (not (memq (syntax->datum #'field) seen)) + (loop #'(rest ...) (cons (syntax->datum #'field) seen))) + ((duplicate rest ...) + (syntax-violation name "duplicate field initializer" + #'duplicate)) + (() + #t)))))) + (eval-when (expand load eval) ;; The procedures below are needed both at run time and at expansion time. @@ -169,6 +186,9 @@ of TYPE matches the expansion-time ABI." #'(field (... ...))) (wrap-field-value f (field-default-value f)))) + ;; Pass S to make sure source location info is preserved. + (report-duplicate-field-specifier 'name s) + (let ((fields (append fields (map car default-values)))) (cond ((lset= eq? fields '(expected ...)) #`(let* #,(field-bindings diff --git a/tests/records.scm b/tests/records.scm index 09ada70c2d..d9469a78bd 100644 --- a/tests/records.scm +++ b/tests/records.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -288,6 +288,30 @@ (and (string-match "extra.*initializer.*baz" message) (eq? proc 'foo))))) +(test-assert "define-record-type* & duplicate initializers" + (let ((exp '(begin + (define-record-type* foo make-foo + foo? + (bar foo-bar (default 42))) + + (foo (bar 1) + (bar 2)))) + (loc (current-source-location))) ;keep this alignment! + (catch 'syntax-error + (lambda () + (eval exp (test-module)) + #f) + (lambda (key proc message location form . args) + (and (string-match "duplicate.*initializer" message) + (eq? proc 'foo) + + ;; Make sure the location is that of the field specifier. + (lset= equal? + (pk 'expected-loc + `((line . ,(- (assq-ref loc 'line) 1)) + ,@(alist-delete 'line loc))) + (pk 'actual-loc location))))))) + (test-assert "ABI checks" (let ((module (test-module))) (eval '(begin -- cgit v1.2.3