summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2019-02-06 13:03:26 +0100
committerRicardo Wurmus <rekado@elephly.net>2019-02-06 13:03:26 +0100
commitba88eea2b3a8a33ecd7fc0ec64e3917c6c2fe21d (patch)
tree75c68e44d3d76440f416552711b1a47ec83e411e /tests
parentf380f9d55e6757c242acf6c71c4a3ccfcdb066b2 (diff)
parent4aeb7f34c948f32363f2ae29c6942c6328df758c (diff)
downloadpatches-ba88eea2b3a8a33ecd7fc0ec64e3917c6c2fe21d.tar
patches-ba88eea2b3a8a33ecd7fc0ec64e3917c6c2fe21d.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/channels.scm88
-rw-r--r--tests/derivations.scm57
-rw-r--r--tests/gexp.scm24
-rw-r--r--tests/guix-build.sh4
-rw-r--r--tests/guix-daemon.sh10
-rw-r--r--tests/guix-package-net.sh33
-rw-r--r--tests/guix-system.sh12
-rw-r--r--tests/lint.scm119
-rw-r--r--tests/nar.scm36
-rw-r--r--tests/packages.scm102
-rw-r--r--tests/profiles.scm34
-rw-r--r--tests/publish.scm6
-rw-r--r--tests/records.scm26
-rw-r--r--tests/services.scm4
-rw-r--r--tests/status.scm98
-rw-r--r--tests/store.scm52
-rw-r--r--tests/upstream.scm3
17 files changed, 600 insertions, 108 deletions
diff --git a/tests/channels.scm b/tests/channels.scm
index f3fc383ac3..8540aef435 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -18,9 +18,16 @@
(define-module (test-channels)
#:use-module (guix channels)
+ #:use-module (guix profiles)
#:use-module ((guix build syscalls) #:select (mkdtemp!))
#:use-module (guix tests)
+ #:use-module (guix store)
+ #:use-module ((guix grafts) #:select (%graft?))
+ #:use-module (guix derivations)
+ #:use-module (guix sets)
+ #:use-module (guix gexp)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
@@ -34,8 +41,9 @@
(and spec
(with-output-to-file (string-append instance-dir "/.guix-channel")
(lambda _ (format #t "~a" spec))))
- ((@@ (guix channels) channel-instance)
- name commit instance-dir))
+ (checkout->channel-instance instance-dir
+ #:commit commit
+ #:name name))
(define instance--boring (make-instance))
(define instance--no-deps
@@ -136,4 +144,80 @@
'abc1234)))
instances))))))
+(test-assert "channel-instances->manifest"
+ ;; Compute the manifest for a graph of instances and make sure we get a
+ ;; derivation graph that mirrors the instance graph. This test also ensures
+ ;; we don't try to access Git repositores at all at this stage.
+ (let* ((spec (lambda deps
+ `(channel (version 0)
+ (dependencies
+ ,@(map (lambda (dep)
+ `(channel
+ (name ,dep)
+ (url "http://example.org")))
+ deps)))))
+ (guix (make-instance #:name 'guix))
+ (instance0 (make-instance #:name 'a))
+ (instance1 (make-instance #:name 'b #:spec (spec 'a)))
+ (instance2 (make-instance #:name 'c #:spec (spec 'b)))
+ (instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
+ (%graft? #f) ;don't try to build stuff
+
+ ;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
+ (let ((source (channel-instance-checkout guix)))
+ (mkdir (string-append source "/build-aux"))
+ (call-with-output-file (string-append source
+ "/build-aux/build-self.scm")
+ (lambda (port)
+ (write '(begin
+ (use-modules (guix) (gnu packages bootstrap))
+
+ (lambda _
+ (package->derivation %bootstrap-guile)))
+ port))))
+
+ (with-store store
+ (let ()
+ (define manifest
+ (run-with-store store
+ (channel-instances->manifest (list guix
+ instance0 instance1
+ instance2 instance3))))
+
+ (define entries
+ (manifest-entries manifest))
+
+ (define (depends? drv in out)
+ ;; Return true if DRV depends (directly or indirectly) on all of IN
+ ;; and none of OUT.
+ (let ((set (list->set
+ (requisites store
+ (list (derivation-file-name drv)))))
+ (in (map derivation-file-name in))
+ (out (map derivation-file-name out)))
+ (and (every (cut set-contains? set <>) in)
+ (not (any (cut set-contains? set <>) out)))))
+
+ (define (lookup name)
+ (run-with-store store
+ (lower-object
+ (manifest-entry-item
+ (manifest-lookup manifest
+ (manifest-pattern (name name)))))))
+
+ (let ((drv-guix (lookup "guix"))
+ (drv0 (lookup "a"))
+ (drv1 (lookup "b"))
+ (drv2 (lookup "c"))
+ (drv3 (lookup "d")))
+ (and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
+ (depends? drv0
+ (list) (list drv1 drv2 drv3))
+ (depends? drv1
+ (list drv0) (list drv2 drv3))
+ (depends? drv2
+ (list drv1) (list drv3))
+ (depends? drv3
+ (list drv2 drv0) (list))))))))
+
(test-end "channels")
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 5f294c1827..dbb5b584eb 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,24 +644,25 @@
`("-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))
#f)))
-;; Here we should get the value of $NIX_STATE_DIR that the daemon sees, which
-;; is a unique value for each test process; this value is the same as the one
-;; we see in the process executing this file since it is set by 'test-env'.
+;; Here we should get the value of $GUIX_STATE_DIRECTORY that the daemon sees,
+;; which is a unique value for each test process; this value is the same as
+;; the one we see in the process executing this file since it is set by
+;; 'test-env'.
(test-equal "derivation #:leaked-env-vars"
- (getenv "NIX_STATE_DIR")
- (let* ((value (getenv "NIX_STATE_DIR"))
+ (getenv "GUIX_STATE_DIRECTORY")
+ (let* ((value (getenv "GUIX_STATE_DIRECTORY"))
(drv (derivation %store "leaked-env-vars" %bash
- '("-c" "echo -n $NIX_STATE_DIR > $out")
+ '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
#:hash (sha256 (string->utf8 value))
#:hash-algo 'sha256
#:inputs `((,%bash))
- #:leaked-env-vars '("NIX_STATE_DIR"))))
+ #:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
(and (build-derivations %store (list drv))
(call-with-input-file (derivation->output-path drv)
get-string-all))))
@@ -765,8 +766,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 +780,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 +943,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 35a76a496e..cee2c96610 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -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)))
@@ -1171,6 +1171,24 @@
(string=? (readlink (string-append comp "/text"))
text)))))))
+(test-equal "lower-object, computed-file, #:system"
+ '("mips64el-linux")
+ (run-with-store %store
+ (let* ((exp #~(symlink #$coreutils #$output))
+ (computed (computed-file "computed" exp
+ #:guile %bootstrap-guile)))
+ ;; Make sure that the SYSTEM argument to 'lower-object' is honored.
+ (mlet* %store-monad ((drv (lower-object computed "mips64el-linux"))
+ (refs (references* (derivation-file-name drv))))
+ (return (delete-duplicates
+ (filter-map (lambda (file)
+ (and (string-suffix? ".drv" file)
+ (let ((drv (read-derivation-from-file
+ file)))
+ (derivation-system drv))))
+ (cons (derivation-file-name drv)
+ refs))))))))
+
(test-assert "lower-object & gexp-input-error?"
(guard (c ((gexp-input-error? c)
(gexp-error-invalid-input c)))
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 7842ce87c6..66bf6be8d0 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, 2018 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -37,7 +37,7 @@ guix build hello -d | \
grep -e '-hello-[0-9\.]\+\.drv$'
# Passing a URI.
-GUIX_DAEMON_SOCKET="file://$NIX_STATE_DIR/daemon-socket/socket" \
+GUIX_DAEMON_SOCKET="file://$GUIX_STATE_DIRECTORY/daemon-socket/socket" \
guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
( if GUIX_DAEMON_SOCKET="weird://uri" \
diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh
index 9ae6e0b77a..ce82cfd1e6 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.
#
@@ -63,7 +63,7 @@ guile -c "
(exit (has-substitutes? store \"$out\"))"
# Now, run guix-daemon --no-substitutes.
-socket="$NIX_STATE_DIR/alternate-socket"
+socket="$GUIX_STATE_DIRECTORY/alternate-socket"
guix-daemon --no-substitutes --listen="$socket" --disable-chroot &
daemon_pid=$!
trap 'kill $daemon_pid' EXIT
@@ -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-package-net.sh b/tests/guix-package-net.sh
index 927c856b23..82c346dd4c 100644
--- a/tests/guix-package-net.sh
+++ b/tests/guix-package-net.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
#
# This file is part of GNU Guix.
@@ -167,6 +167,37 @@ then false; fi
guix package -p "$profile" -p "$profile_alt" --search-paths \
| grep "LIBRARY_PATH.*$profile/lib.$profile_alt/lib"
+# Simulate an upgrade and make sure the package order is preserved.
+module_dir="t-guix-package-net-$$"
+trap 'rm -rf "$module_dir"' EXIT
+
+mkdir "$module_dir"
+cat > "$module_dir/new.scm" <<EOF
+(define-module (new)
+ #:use-module (guix)
+ #:use-module (gnu packages bootstrap))
+
+(define-public new-guile
+ (package (inherit %bootstrap-guile)
+ (version (string-append "42." (getenv "V_MINOR")))))
+(define-public new-gcc
+ (package (inherit %bootstrap-gcc)
+ (version (string-append "77." (getenv "V_MINOR")))))
+EOF
+
+guix package --bootstrap -p "$profile" -i gcc-bootstrap
+installed="`guix package -p "$profile" -I | cut -f1`"
+
+for i in 1 2
+do
+ V_MINOR="$i"
+ export V_MINOR
+
+ guix package -p "$profile" --bootstrap -L "$module_dir" -u .
+ post_upgrade="`guix package -p "$profile" -I | cut -f1`"
+ test "$post_upgrade" = "$installed"
+done
+
#
# Try with the default profile.
#
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 23d2da4903..9903677a02 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
#
@@ -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 "/")
@@ -258,7 +258,9 @@ cat > "$tmpdir/config.scm"<<EOF
(operating-system
$OS_BASE
- (services (cons (tor-service (local-file "my-torrc"))
+ (services (cons (service tor-service-type
+ (tor-configuration
+ (config-file (local-file "my-torrc"))))
%base-services)))
EOF
diff --git a/tests/lint.scm b/tests/lint.scm
index 300153e24e..dc2b17aeec 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,7 +38,7 @@
#:use-module (gnu packages)
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
- #:use-module (gnu packages python)
+ #:use-module (gnu packages python-xyz)
#:use-module (web uri)
#:use-module (web server)
#:use-module (web server http)
@@ -571,6 +572,86 @@
(check-source-file-name pkg)))
"file name should contain the package name"))))
+(test-assert "source-unstable-tarball"
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (source
+ (origin
+ (method url-fetch)
+ (uri "https://github.com/example/example/archive/v0.0.tar.gz")
+ (sha256 %null-sha256))))))
+ (check-source-unstable-tarball pkg)))
+ "source URI should not be an autogenerated tarball"))
+
+(test-assert "source-unstable-tarball: source #f"
+ (not
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (source #f))))
+ (check-source-unstable-tarball pkg)))
+ "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: valid"
+ (not
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (source
+ (origin
+ (method url-fetch)
+ (uri "https://github.com/example/example/releases/download/x-0.0/x-0.0.tar.gz")
+ (sha256 %null-sha256))))))
+ (check-source-unstable-tarball pkg)))
+ "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: package named archive"
+ (not
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (source
+ (origin
+ (method url-fetch)
+ (uri "https://github.com/example/archive/releases/download/x-0.0/x-0.0.tar.gz")
+ (sha256 %null-sha256))))))
+ (check-source-unstable-tarball pkg)))
+ "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: not-github"
+ (not
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (source
+ (origin
+ (method url-fetch)
+ (uri "https://bitbucket.org/archive/example/download/x-0.0.tar.gz")
+ (sha256 %null-sha256))))))
+ (check-source-unstable-tarball pkg)))
+ "source URI should not be an autogenerated tarball"))))
+
+(test-assert "source-unstable-tarball: git-fetch"
+ (not
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/archive/example.git")
+ (commit "0")))
+ (sha256 %null-sha256))))))
+ (check-source-unstable-tarball pkg)))
+ "source URI should not be an autogenerated tarball"))))
+
(test-skip (if (http-server-can-listen?) 0 1))
(test-equal "source: 200"
""
@@ -669,6 +750,42 @@
(check-mirror-url (dummy-package "x" (source source)))))
"mirror://gnu/foo/foo.tar.gz"))
+(test-assert "github-url"
+ (string-null?
+ (with-warnings
+ (with-http-server 200 %long-string
+ (check-github-url
+ (dummy-package "x" (source
+ (origin
+ (method url-fetch)
+ (uri (%local-url))
+ (sha256 %null-sha256)))))))))
+
+(let ((github-url "https://github.com/foo/bar/bar-1.0.tar.gz"))
+ (test-assert "github-url: one suggestion"
+ (string-contains
+ (with-warnings
+ (with-http-server (301 `((location . ,(string->uri github-url)))) ""
+ (let ((initial-uri (%local-url)))
+ (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+ (with-http-server (302 `((location . ,(string->uri initial-uri)))) ""
+ (check-github-url
+ (dummy-package "x" (source
+ (origin
+ (method url-fetch)
+ (uri (%local-url))
+ (sha256 %null-sha256))))))))))
+ github-url))
+ (test-assert "github-url: already the correct github url"
+ (string-null?
+ (with-warnings
+ (check-github-url
+ (dummy-package "x" (source
+ (origin
+ (method url-fetch)
+ (uri github-url)
+ (sha256 %null-sha256)))))))))
+
(test-assert "cve"
(mock ((guix scripts lint) package-vulnerabilities (const '()))
(string-null?
diff --git a/tests/nar.scm b/tests/nar.scm
index 5ffe68c9e2..bfc71c69a8 100644
--- a/tests/nar.scm
+++ b/tests/nar.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.
;;;
@@ -334,6 +334,40 @@
(lambda ()
(rmdir input)))))
+(test-eq "restore-file with non-UTF8 locale" ;<https://bugs.gnu.org/33603>
+ 'encoding-error
+ (let* ((file (search-path %load-path "guix.scm"))
+ (output (string-append %test-dir "/output"))
+ (locale (setlocale LC_ALL "C")))
+ (dynamic-wind
+ (lambda () #t)
+ (lambda ()
+ (define-values (port get-bytevector)
+ (open-bytevector-output-port))
+
+ (write-file-tree "root" port
+ #:file-type+size
+ (match-lambda
+ ("root" (values 'directory 0))
+ ("root/λ" (values 'regular 0)))
+ #:file-port (const (%make-void-port "r"))
+ #:symlink-target (const #f)
+ #:directory-entries (const '("λ")))
+ (close-port port)
+
+ (mkdir %test-dir)
+ (catch 'encoding-error
+ (lambda ()
+ ;; This show throw to 'encoding-error.
+ (restore-file (open-bytevector-input-port (get-bytevector))
+ output)
+ (scandir output))
+ (lambda args
+ 'encoding-error)))
+ (lambda ()
+ (false-if-exception (rm-rf %test-dir))
+ (setlocale LC_ALL locale)))))
+
(test-assert "restore-file-set (signed, valid)"
(with-store store
(let* ((texts (unfold (cut >= <> 10)
diff --git a/tests/packages.scm b/tests/packages.scm
index 85c3ebe8b2..dd93328db6 100644
--- a/tests/packages.scm
+++ b/tests/packages.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>
;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -98,8 +98,8 @@
(test-assert "transaction-upgrade-entry, zero upgrades"
(let* ((old (dummy-package "foo" (version "1")))
- (tx (mock ((gnu packages) find-newest-available-packages
- (const vlist-null))
+ (tx (mock ((gnu packages) find-best-packages-by-name
+ (const '()))
((@@ (guix scripts package) transaction-upgrade-entry)
(manifest-entry
(inherit (package->manifest-entry old))
@@ -111,8 +111,8 @@
(test-assert "transaction-upgrade-entry, one upgrade"
(let* ((old (dummy-package "foo" (version "1")))
(new (dummy-package "foo" (version "2")))
- (tx (mock ((gnu packages) find-newest-available-packages
- (const (vhash-cons "foo" (list "2" new) vlist-null)))
+ (tx (mock ((gnu packages) find-best-packages-by-name
+ (const (list new)))
((@@ (guix scripts package) transaction-upgrade-entry)
(manifest-entry
(inherit (package->manifest-entry old))
@@ -128,8 +128,8 @@
(let* ((old (dummy-package "foo" (version "1")))
(new (dummy-package "bar" (version "2")))
(dep (deprecated-package "foo" new))
- (tx (mock ((gnu packages) find-newest-available-packages
- (const (vhash-cons "foo" (list "2" dep) vlist-null)))
+ (tx (mock ((gnu packages) find-best-packages-by-name
+ (const (list dep)))
((@@ (guix scripts package) transaction-upgrade-entry)
(manifest-entry
(inherit (package->manifest-entry old))
@@ -251,6 +251,28 @@
(package-transitive-supported-systems d)
(package-transitive-supported-systems e))))
+(test-assert "package-closure"
+ (let-syntax ((dummy-package/no-implicit
+ (syntax-rules ()
+ ((_ name rest ...)
+ (package
+ (inherit (dummy-package name rest ...))
+ (build-system trivial-build-system))))))
+ (let* ((a (dummy-package/no-implicit "a"))
+ (b (dummy-package/no-implicit "b"
+ (propagated-inputs `(("a" ,a)))))
+ (c (dummy-package/no-implicit "c"
+ (inputs `(("a" ,a)))))
+ (d (dummy-package/no-implicit "d"
+ (native-inputs `(("b" ,b)))))
+ (e (dummy-package/no-implicit "e"
+ (inputs `(("c" ,c) ("d" ,d))))))
+ (lset= eq?
+ (list a b c d e)
+ (package-closure (list e))
+ (package-closure (list e d))
+ (package-closure (list e c b))))))
+
(test-equal "origin-actual-file-name"
"foo-1.tar.gz"
(let ((o (dummy-origin (uri "http://www.example.com/foo-1.tar.gz"))))
@@ -587,7 +609,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)))
@@ -1012,6 +1034,28 @@
((one)
(eq? one guile-2.0))))
+(test-assert "fold-available-packages with/without cache"
+ (let ()
+ (define no-cache
+ (fold-available-packages (lambda* (name version result #:rest rest)
+ (cons (cons* name version rest)
+ result))
+ '()))
+
+ (define from-cache
+ (call-with-temporary-directory
+ (lambda (cache)
+ (generate-package-cache cache)
+ (mock ((guix describe) current-profile (const cache))
+ (mock ((gnu packages) cache-is-authoritative? (const #t))
+ (fold-available-packages (lambda* (name version result
+ #:rest rest)
+ (cons (cons* name version rest)
+ result))
+ '()))))))
+
+ (lset= equal? no-cache from-cache)))
+
(test-assert "find-packages-by-name"
(match (find-packages-by-name "hello")
(((? (cut eq? hello <>))) #t)
@@ -1022,6 +1066,24 @@
(((? (cut eq? hello <>))) #t)
(wrong (pk 'find-packages-by-name wrong #f))))
+(test-equal "find-packages-by-name with cache"
+ (find-packages-by-name "guile")
+ (call-with-temporary-directory
+ (lambda (cache)
+ (generate-package-cache cache)
+ (mock ((guix describe) current-profile (const cache))
+ (mock ((gnu packages) cache-is-authoritative? (const #t))
+ (find-packages-by-name "guile"))))))
+
+(test-equal "find-packages-by-name + version, with cache"
+ (find-packages-by-name "guile" "2")
+ (call-with-temporary-directory
+ (lambda (cache)
+ (generate-package-cache cache)
+ (mock ((guix describe) current-profile (const cache))
+ (mock ((gnu packages) cache-is-authoritative? (const #t))
+ (find-packages-by-name "guile" "2"))))))
+
(test-assert "--search-paths with pattern"
;; Make sure 'guix package --search-paths' correctly reports environment
;; variables when file patterns are used (in particular, it must follow
@@ -1130,8 +1192,32 @@
(lambda (key . args)
key)))
+(test-equal "find-package-locations"
+ (map (lambda (package)
+ (cons (package-version package)
+ (package-location package)))
+ (find-packages-by-name "guile"))
+ (find-package-locations "guile"))
+
+(test-equal "find-package-locations with cache"
+ (map (lambda (package)
+ (cons (package-version package)
+ (package-location package)))
+ (find-packages-by-name "guile"))
+ (call-with-temporary-directory
+ (lambda (cache)
+ (generate-package-cache cache)
+ (mock ((guix describe) current-profile (const cache))
+ (mock ((gnu packages) cache-is-authoritative? (const #t))
+ (find-package-locations "guile"))))))
+
+(test-equal "specification->location"
+ (package-location (specification->package "guile@2"))
+ (specification->location "guile@2"))
+
(test-end "packages")
;;; Local Variables:
;;; eval: (put 'dummy-package 'scheme-indent-function 1)
+;;; eval: (put 'dummy-package/no-implicit 'scheme-indent-function 1)
;;; End:
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 1f9bbd099d..9a05030aff 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -330,7 +330,7 @@
(test-assert "package->manifest-entry, search paths"
;; See <http://bugs.gnu.org/22073>.
- (let ((mpl (@ (gnu packages python) python2-matplotlib)))
+ (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib)))
(lset= eq?
(package-transitive-native-search-paths mpl)
(manifest-entry-search-paths
@@ -591,6 +591,36 @@
(built-derivations (list drv))
(return (readlink (readlink (string-append profile "/dangling")))))))
+(test-equalm "profile in profile"
+ '("foo" "0")
+
+ ;; Make sure we can build a profile that has another profile has one of its
+ ;; entries. The new profile's /manifest and /etc/profile must override the
+ ;; other's.
+ (mlet* %store-monad
+ ((prof0 (profile-derivation
+ (manifest
+ (list (package->manifest-entry %bootstrap-guile)))
+ #:hooks '()
+ #:locales? #f))
+ (prof1 (profile-derivation
+ (manifest (list (manifest-entry
+ (name "foo")
+ (version "0")
+ (item prof0))))
+ #:hooks '()
+ #:locales? #f)))
+ (mbegin %store-monad
+ (built-derivations (list prof1))
+ (let ((out (derivation->output-path prof1)))
+ (return (and (file-exists?
+ (string-append out "/bin/guile"))
+ (let ((manifest (profile-manifest out)))
+ (match (manifest-entries manifest)
+ ((entry)
+ (list (manifest-entry-name entry)
+ (manifest-entry-version entry)))))))))))
+
(test-end "profiles")
;;; Local Variables:
diff --git a/tests/publish.scm b/tests/publish.scm
index 79a786e723..097ac036e0 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -63,12 +63,12 @@
(let ((socket (open-socket-for-uri uri)))
;; Make sure to use an unbuffered port so that we can then peek at the
;; underlying file descriptor via 'call-with-gzip-input-port'.
- (setvbuf socket _IONBF)
+ (setvbuf socket 'none)
(call-with-values
(lambda ()
(http-get uri #:port socket #:streaming? #t))
(lambda (response port)
- ;; Don't (setvbuf port _IONBF) because of <http://bugs.gnu.org/19610>
+ ;; Don't (setvbuf port 'none) because of <http://bugs.gnu.org/19610>
;; (PORT might be a custom binary input port).
port))))
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/services.scm b/tests/services.scm
index 5827dee80d..44ad0022c6 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -143,7 +143,7 @@
(default-value 'dflt)
(compose concatenate)
(extend cons)))
- (t2 (service-type (name 't2) (extensions '())
+ (t2 (service-type (name 't2)
(default-value 'dflt2)
(compose concatenate)
(extend cons)
diff --git a/tests/status.scm b/tests/status.scm
index 99abb41c8b..01a61f7345 100644
--- a/tests/status.scm
+++ b/tests/status.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -36,18 +36,18 @@
(test-equal "compute-status, builds + substitutes"
(list (build-status
- (building '("foo.drv"))
+ (building (list (build "foo.drv" "x86_64-linux")))
(downloading (list (download "bar" "http://example.org/bar"
#:size 500
#:start 'now))))
(build-status
- (building '("foo.drv"))
+ (building (list (build "foo.drv" "x86_64-linux")))
(downloading (list (download "bar" "http://example.org/bar"
#:size 500
#:transferred 42
#:start 'now))))
(build-status
- (builds-completed '("foo.drv"))
+ (builds-completed (list (build "foo.drv" "x86_64-linux")))
(downloads-completed (list (download "bar" "http://example.org/bar"
#:size 500
#:transferred 500
@@ -58,7 +58,7 @@
(compute-status event status
#:current-time
(const 'now))))))
- (display "@ build-started foo.drv\n" port)
+ (display "@ build-started foo.drv - x86_64-linux \n" port)
(display "@ substituter-started bar\n" port)
(display "@ download-started bar http://example.org/bar 500\n" port)
(display "various\nthings\nget\nwritten\n" port)
@@ -76,7 +76,8 @@
(test-equal "compute-status, missing events"
(list (build-status
- (building '("foo.drv"))
+ (building (list (build "foo.drv" "x86_64-linux"
+ #:log-file "foo.log")))
(downloading (list (download "baz" "http://example.org/baz"
#:size 500
#:transferred 42
@@ -86,7 +87,8 @@
#:transferred 0
#:start 'now))))
(build-status
- (builds-completed '("foo.drv"))
+ (builds-completed (list (build "foo.drv" "x86_64-linux"
+ #:log-file "foo.log")))
(downloads-completed (list (download "baz" "http://example.org/baz"
#:size 500
#:transferred 500
@@ -103,7 +105,7 @@
(compute-status event status
#:current-time
(const 'now))))))
- (display "@ build-started foo.drv\n" port)
+ (display "@ build-started foo.drv - x86_64-linux foo.log\n" port)
(display "@ download-started bar http://example.org/bar 999\n" port)
(display "various\nthings\nget\nwritten\n" port)
(display "@ download-progress baz http://example.org/baz 500 42\n"
@@ -125,9 +127,7 @@
(test-equal "current-build-output-port, UTF-8 + garbage"
;; What about a mixture of UTF-8 + garbage?
- (let ((replacement (cond-expand
- ((and guile-2 (not guile-2.2)) "?")
- (else "�"))))
+ (let ((replacement "�"))
`((build-log #f ,(string-append "garbage: " replacement "lambda: λ\n"))))
(let-values (((port get-status) (build-event-output-port cons '())))
(display "garbage: " port)
@@ -138,19 +138,19 @@
(test-equal "compute-status, multiplexed build output"
(list (build-status
- (building '("foo.drv"))
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121)))
(downloading (list (download "bar" "http://example.org/bar"
#:size 999
#:start 'now))))
(build-status
- (building '("foo.drv"))
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121)))
(downloading (list (download "bar" "http://example.org/bar"
#:size 999
#:transferred 42
#:start 'now))))
(build-status
- ;; XXX: Should "bar.drv" be present twice?
- (builds-completed '("bar.drv" "foo.drv"))
+ ;; "bar" is now only listed as a download.
+ (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121)))
(downloads-completed (list (download "bar" "http://example.org/bar"
#:size 999
#:transferred 999
@@ -164,8 +164,8 @@
#:derivation-path->output-path
(match-lambda
("bar.drv" "bar")))))))
- (display "@ build-started foo.drv 121\n" port)
- (display "@ build-started bar.drv 144\n" port)
+ (display "@ build-started foo.drv - x86_64-linux 121\n" port)
+ (display "@ build-started bar.drv - armhf-linux bar.log 144\n" port)
(display "@ build-log 121 6\nHello!" port)
(display "@ build-log 144 50
@ download-started bar http://example.org/bar 999\n" port)
@@ -180,4 +180,68 @@
(display "@ build-succeeded bar.drv\n" port)
(list first second (get-status))))))
+(test-equal "compute-status, build completion"
+ (list (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121))))
+ (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:completion 0.))))
+ (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:completion 50.))))
+ (build-status
+ (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:completion 100.)))))
+ (let-values (((port get-status)
+ (build-event-output-port (lambda (event status)
+ (compute-status event status
+ #:current-time
+ (const 'now))))))
+ (display "@ build-started foo.drv - x86_64-linux 121\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (let ((first (get-status)))
+ (display "@ build-log 121 20\n[ 0/100] building X\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (let ((second (get-status)))
+ (display "@ build-log 121 20\n[50/100] building Y\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (let ((third (get-status)))
+ (display "@ build-log 121 21\n[100/100] building Z\n" port)
+ (display "@ build-log 121 6\nHello!" port)
+ (display "@ build-succeeded foo.drv\n" port)
+ (list first second third (get-status)))))))
+
+(test-equal "compute-status, build phase"
+ (list (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:phase 'configure))))
+ (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:phase 'configure
+ #:completion 50.))))
+ (build-status
+ (building (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:phase 'install))))
+ (build-status
+ (builds-completed (list (build "foo.drv" "x86_64-linux" #:id 121
+ #:phase 'install)))))
+ (let-values (((port get-status)
+ (build-event-output-port (lambda (event status)
+ (compute-status event status
+ #:current-time
+ (const 'now))))))
+ (display "@ build-started foo.drv - x86_64-linux 121\n" port)
+ (display "@ build-log 121 27\nstarting phase `configure'\n" port)
+ (display "@ build-log 121 6\nabcde!" port)
+ (let ((first (get-status)))
+ (display "@ build-log 121 20\n[50/100] building Y\n" port)
+ (display "@ build-log 121 6\nfghik!" port)
+ (let ((second (get-status)))
+ (display "@ build-log 121 21\n[100/100] building Z\n" port)
+ (display "@ build-log 121 25\nstarting phase `install'\n" port)
+ (display "@ build-log 121 6\nlmnop!" port)
+ (let ((third (get-status)))
+ (display "@ build-succeeded foo.drv\n" port)
+ (list first second third (get-status)))))))
+
(test-end "status")
diff --git a/tests/store.scm b/tests/store.scm
index 3ff526cdcf..e28c0c5aaa 100644
--- a/tests/store.scm
+++ b/tests/store.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.
;;;
@@ -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,11 +442,9 @@
(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))))))))
- (cond-expand
- (guile-2.2 "garbage: �lambda: λ")
- (else "garbage: ?lambda: λ"))))
+ "garbage: �lambda: λ"))
(test-assert "log-file, derivation"
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
@@ -622,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))))))
@@ -648,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
@@ -714,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.
@@ -818,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)))
@@ -908,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.
@@ -947,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))
diff --git a/tests/upstream.scm b/tests/upstream.scm
index 6c86abe817..e431956960 100644
--- a/tests/upstream.scm
+++ b/tests/upstream.scm
@@ -24,6 +24,9 @@
(test-begin "upstream")
+;; FIXME: Temporarily skipping this test; see <https://bugs.gnu.org/34229>.
+(test-skip 1)
+
(test-equal "coalesce-sources same version"
(list (upstream-source
(package "foo") (version "1")