Merge branch 'master' into staging

7 files changed, 79 insertions, 55 deletions

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 <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; 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 <ludo@gnu.org>
+# Copyright © 2012, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 #
 # 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/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" <<EOF
   (timezone "Europe/Paris")                           ; 6
   (locale "en_US.UTF-8")                              ; 7
 
-  (bootloader (GRUB-config (device "/dev/sdX")))      ; 9
+  (bootloader (GRUB-config (target "/dev/sdX")))      ; 9
   (file-systems (cons (file-system
                         (device (file-system-label "root"))
                         (mount-point "/")
@@ -137,7 +137,7 @@ OS_BASE='
 
   (bootloader (bootloader-configuration
                (bootloader grub-bootloader)
-               (device "/dev/sdX")))
+               (target "/dev/sdX")))
   (file-systems (cons (file-system
                         (device (file-system-label "root"))
                         (mount-point "/")
@@ -209,7 +209,7 @@ make_user_config ()
 
   (bootloader (bootloader-configuration
                 (bootloader grub-bootloader)
-                (device "/dev/sdX")))
+                (target "/dev/sdX")))
   (file-systems (cons (file-system
                         (device (file-system-label "root"))
                         (mount-point "/")
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/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 <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; 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> 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
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))