From 652163154c06b47936a453f44ea35938789718de Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 11 Nov 2018 17:13:20 +0100 Subject: guix package: '--show' errors when asked for a non-existent package. Fixes . Reported by swedebugia . * guix/scripts/package.scm (process-query): Call 'leave' when 'find-packages-by-name' returns the empty list. * tests/guix-package.sh: Test it. --- tests/guix-package.sh | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'tests') diff --git a/tests/guix-package.sh b/tests/guix-package.sh index f7dfbfad00..7eeb4304d1 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -106,6 +106,10 @@ guix package --show=guile | grep "^name: guile" # Ensure `--show' doesn't fail for packages with non-package inputs. guix package --show=texlive +# Fail for non-existent packages or package/version pairs. +if guix package --show=does-not-exist; then false; else true; fi +if guix package --show=emacs@42; then false; else true; fi + # Search. LC_MESSAGES=C export LC_MESSAGES -- cgit v1.2.3 From 9ed86fe175c15c819d6d86681c8136ff6bc927c0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 4 Apr 2015 21:59:25 +0200 Subject: tests: Add 'test-assertm' to (guix tests). * guix/tests.scm (test-assertm): New macro. * tests/gexp.scm (test-assertm): Remove. * tests/profiles.scm (test-assertm): Remove. * tests/challenge.scm (%store, test-assertm): Remove. * tests/debug-link.scm (%store, test-assertm): Remove. * tests/size.scm (%store, test-assertm): Remove. --- guix/tests.scm | 25 +++++++++++++++++++++++++ tests/challenge.scm | 8 -------- tests/debug-link.scm | 8 -------- tests/gexp.scm | 5 ----- tests/profiles.scm | 11 ----------- tests/size.scm | 8 -------- 6 files changed, 25 insertions(+), 40 deletions(-) (limited to 'tests') diff --git a/guix/tests.scm b/guix/tests.scm index bcf9b990e5..66524ddc2f 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -27,6 +27,7 @@ #:use-module (guix build-system gnu) #:use-module (gnu packages bootstrap) #:use-module (srfi srfi-34) + #:use-module (srfi srfi-64) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) #:use-module (web uri) @@ -39,6 +40,8 @@ shebang-too-long? mock %test-substitute-urls + test-assertm + test-equalm %substitute-directory with-derivation-narinfo with-derivation-substitute @@ -161,6 +164,28 @@ given by REPLACEMENT." (lambda () body ...) (lambda () (module-set! m 'proc original))))) +(define-syntax-rule (test-assertm name exp) + "Like 'test-assert', but EXP is a monadic value. A new connection to the +store is opened." + (test-assert name + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store store exp + #:guile-for-build (%guile-for-build))) + (lambda () + (close-connection store)))))) + +(define-syntax-rule (test-equalm name value exp) + "Like 'test-equal', but EXP is a monadic value. A new connection to the +store is opened." + (test-equal name + value + (with-store store + (run-with-store store exp + #:guile-for-build (%guile-for-build))))) + ;;; ;;; Narinfo files, as used by the substituter. diff --git a/tests/challenge.scm b/tests/challenge.scm index 4b13ec278e..c962800f3f 100644 --- a/tests/challenge.scm +++ b/tests/challenge.scm @@ -31,17 +31,9 @@ #:use-module (rnrs bytevectors) #:use-module (ice-9 match)) -(define %store - (open-connection-for-tests)) - (define query-path-hash* (store-lift query-path-hash)) -(define-syntax-rule (test-assertm name exp) - (test-assert name - (run-with-store %store exp - #:guile-for-build (%guile-for-build)))) - (define* (call-with-derivation-narinfo* drv thunk hash) (lambda (store) (with-derivation-narinfo drv (sha256 => hash) diff --git a/tests/debug-link.scm b/tests/debug-link.scm index 2dde3cb460..a1ae4f141c 100644 --- a/tests/debug-link.scm +++ b/tests/debug-link.scm @@ -43,14 +43,6 @@ (define read-elf (compose parse-elf get-bytevector-all)) -(define %store - (open-connection-for-tests)) - -(define-syntax-rule (test-assertm name exp) - (test-assert name - (run-with-store %store exp - #:guile-for-build (%guile-for-build)))) - (test-begin "debug-link") diff --git a/tests/gexp.scm b/tests/gexp.scm index 467370f8cb..ab60bdab68 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -62,11 +62,6 @@ #:target target) #:guile-for-build (%guile-for-build))) -(define-syntax-rule (test-assertm name exp) - (test-assert name - (run-with-store %store exp - #:guile-for-build (%guile-for-build)))) - (define %extension-package ;; Example of a package to use when testing 'with-extensions'. (dummy-package "extension" diff --git a/tests/profiles.scm b/tests/profiles.scm index 9f366a04ef..1f9bbd099d 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -47,17 +47,6 @@ ;; Globally disable grafts because they can trigger early builds. (%graft? #f) -(define-syntax-rule (test-assertm name exp) - (test-assert name - (run-with-store %store exp - #:guile-for-build (%guile-for-build)))) - -(define-syntax-rule (test-equalm name value exp) - (test-equal name - value - (run-with-store %store exp - #:guile-for-build (%guile-for-build)))) - ;; Example manifest entries. (define guile-1.8.8 diff --git a/tests/size.scm b/tests/size.scm index 575b1abfdd..0aaa8fbc29 100644 --- a/tests/size.scm +++ b/tests/size.scm @@ -30,14 +30,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-64)) -(define %store - (open-connection-for-tests)) - -(define-syntax-rule (test-assertm name exp) - (test-assert name - (run-with-store %store exp - #:guile-for-build (%guile-for-build)))) - (test-begin "size") -- cgit v1.2.3 From 3ed56ad09b1d2be15e98d195b56886ec14899518 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 13 Nov 2018 11:15:41 +0100 Subject: tests: Remove check for a feature that appeared in Guile 2.0.10. * tests/nar.scm: Remove test for 'open-sha256-input-port'. --- tests/nar.scm | 7 ------- 1 file changed, 7 deletions(-) (limited to 'tests') diff --git a/tests/nar.scm b/tests/nar.scm index d610ea53f7..ff16c3c400 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -332,13 +332,6 @@ (lambda () (rmdir input))))) -;; 'restore-file-set' depends on 'open-sha256-input-port', which in turn -;; relies on a Guile 2.0.10+ feature. -(test-skip (if (false-if-exception - (open-sha256-input-port (%make-void-port "r"))) - 0 - 3)) - (test-assert "restore-file-set (signed, valid)" (with-store store (let* ((texts (unfold (cut >= <> 10) -- cgit v1.2.3 From 8390869811f56f5b2ff947efb9d48bcf219a0444 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 13 Nov 2018 11:38:00 +0100 Subject: tests: Check file canonicalization for 'restore-file-set'. * guix/tests.scm (canonical-file?): New procedure. * tests/nar.scm ("restore-file-set (signed, valid)"): Check that every item of FILES matches 'canonical-file?'. --- guix/tests.scm | 9 +++++++++ tests/nar.scm | 5 ++++- 2 files changed, 13 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/guix/tests.scm b/guix/tests.scm index 66524ddc2f..f4948148c4 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -36,6 +36,7 @@ random-text random-bytevector file=? + canonical-file? network-reachable? shebang-too-long? mock @@ -150,6 +151,14 @@ too expensive to build entirely in the test store." (else (error "what?" (lstat a)))))) +(define (canonical-file? file) + "Return #t if FILE is in the store, is read-only, and its mtime is 1." + (let ((st (lstat file))) + (or (not (string-prefix? (%store-prefix) file)) + (eq? 'symlink (stat:type st)) + (and (= 1 (stat:mtime st)) + (zero? (logand #o222 (stat:mode st))))))) + (define (network-reachable?) "Return true if we can reach the Internet." (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) diff --git a/tests/nar.scm b/tests/nar.scm index ff16c3c400..bf1b066687 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -25,6 +25,8 @@ #:select (open-sha256-port open-sha256-input-port)) #:use-module ((guix packages) #:select (base32)) + #:use-module ((guix build utils) + #:select (find-files)) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) @@ -354,7 +356,8 @@ (map (lambda (file) (call-with-input-file file get-string-all)) - files)))))))) + files)) + (every canonical-file? files))))))) (test-assert "restore-file-set (missing signature)" (let/ec return -- cgit v1.2.3 From f5a2724ae453f4a4b55ff848f4ad7e30efb6eef8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 13 Nov 2018 14:20:27 +0100 Subject: deduplication: Restore directory mtime and permissions after deduplication. Fixes . * guix/store/deduplication.scm (replace-with-link): Call 'set-file-time' and 'chmod' after 'rename-file'. * tests/nar.scm ("restore-file-set with directories (signed, valid)"): New test. --- guix/store/deduplication.scm | 12 +++++++++--- tests/nar.scm | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 44 insertions(+), 3 deletions(-) (limited to 'tests') diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm index 53810c680f..21b0c81f3d 100644 --- a/guix/store/deduplication.scm +++ b/guix/store/deduplication.scm @@ -102,11 +102,17 @@ LINK-PREFIX." SWAP-DIRECTORY as the directory to store temporary hard links. Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system." - (let ((temp-link (get-temp-link target swap-directory))) - (make-file-writable (dirname to-replace)) + (let* ((temp-link (get-temp-link target swap-directory)) + (parent (dirname to-replace)) + (stat (stat parent))) + (make-file-writable parent) (catch 'system-error (lambda () - (rename-file temp-link to-replace)) + (rename-file temp-link to-replace) + + ;; Restore PARENT's mtime and permissions. + (set-file-time parent stat) + (chmod parent (stat:mode stat))) (lambda args (delete-file temp-link) (unless (= EMLINK (system-error-errno args)) diff --git a/tests/nar.scm b/tests/nar.scm index bf1b066687..5ffe68c9e2 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -359,6 +359,41 @@ files)) (every canonical-file? files))))))) +(test-assert "restore-file-set with directories (signed, valid)" + ;; describes a bug whereby directories + ;; containing files subject to deduplication were not canonicalized--i.e., + ;; their mtime and permissions were not reset. Ensure that this bug is + ;; gone. + (with-store store + (let* ((text1 (random-text)) + (text2 (random-text)) + (tree `("tree" directory + ("a" regular (data ,text1)) + ("b" directory + ("c" regular (data ,text2)) + ("d" regular (data ,text1))))) ;duplicate + (file (add-file-tree-to-store store tree)) + (dump (call-with-bytevector-output-port + (cute export-paths store (list file) <>)))) + (delete-paths store (list file)) + (and (not (file-exists? file)) + (let* ((source (open-bytevector-input-port dump)) + (imported (restore-file-set source))) + (and (equal? imported (list file)) + (file-exists? file) + (valid-path? store file) + (string=? text1 + (call-with-input-file (string-append file "/a") + get-string-all)) + (string=? text2 + (call-with-input-file + (string-append file "/b/c") + get-string-all)) + (= (stat:ino (stat (string-append file "/a"))) ;deduplication + (stat:ino (stat (string-append file "/b/d")))) + (every canonical-file? + (find-files file #:directories? #t)))))))) + (test-assert "restore-file-set (missing signature)" (let/ec return (with-store store -- cgit v1.2.3