diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/nar.scm | 42 | ||||
| -rw-r--r-- | tests/publish.scm | 45 | ||||
| -rw-r--r-- | tests/ui.scm | 6 |
3 files changed, 91 insertions, 2 deletions
diff --git a/tests/nar.scm b/tests/nar.scm index 9796980e35..4f4b304b1d 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 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -241,6 +241,46 @@ (lambda () (rmdir input))))) +(test-assert "write-file #:select? + restore-file" + (let ((input (string-append %test-dir ".input"))) + (mkdir input) + (dynamic-wind + (const #t) + (lambda () + (with-file-tree input + (directory "root" + ((directory "a" (("x") ("y") ("z"))) + ("b") ("c") ("d" -> "b"))) + (let* ((output %test-dir) + (nar (string-append output ".nar"))) + (dynamic-wind + (lambda () #t) + (lambda () + (call-with-output-file nar + (lambda (port) + (write-file input port + #:select? + (lambda (file stat) + (and (not (string=? (basename file) + "a")) + (not (eq? (stat:type stat) + 'symlink))))))) + (call-with-input-file nar + (cut restore-file <> output)) + + ;; Make sure "a" and "d" have been filtered out. + (and (not (file-exists? (string-append output "/root/a"))) + (file=? (string-append output "/root/b") + (string-append input "/root/b")) + (file=? (string-append output "/root/c") + (string-append input "/root/c")) + (not (file-exists? (string-append output "/root/d"))))) + (lambda () + (false-if-exception (delete-file nar)) + (false-if-exception (rm-rf output))))))) + (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 diff --git a/tests/publish.scm b/tests/publish.scm index 6645286f5a..d6d537c58a 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -30,12 +30,14 @@ #:use-module (guix base64) #:use-module ((guix serialization) #:select (restore-file)) #:use-module (guix pk-crypto) + #:use-module (web uri) #:use-module (web client) #:use-module (web response) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 rdelim)) @@ -101,6 +103,37 @@ References: ~a~%" (publish-uri (string-append "/" (store-path-hash-part %item) ".narinfo"))))) +(test-equal "/*.narinfo with properly encoded '+' sign" + ;; See <http://bugs.gnu.org/21888>. + (let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!")) + (info (query-path-info %store item)) + (unsigned-info + (format #f + "StorePath: ~a +URL: nar/~a +Compression: none +NarHash: sha256:~a +NarSize: ~d +References: ~%" + item + (uri-encode (basename item)) + (bytevector->nix-base32-string + (path-info-hash info)) + (path-info-nar-size info))) + (signature (base64-encode + (string->utf8 + (canonical-sexp->string + ((@@ (guix scripts publish) signed-string) + unsigned-info)))))) + (format #f "~aSignature: 1;~a;~a~%" + unsigned-info (gethostname) signature)) + + (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))) + (utf8->string + (http-get-body + (publish-uri + (string-append "/" (store-path-hash-part item) ".narinfo")))))) + (test-equal "/nar/*" "bar" (call-with-temporary-output-file @@ -112,6 +145,18 @@ References: ~a~%" (call-with-input-string nar (cut restore-file <> temp))) (call-with-input-file temp read-string)))) +(test-equal "/nar/ with properly encoded '+' sign" + "Congrats!" + (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))) + (call-with-temporary-output-file + (lambda (temp port) + (let ((nar (utf8->string + (http-get-body + (publish-uri + (string-append "/nar/" (uri-encode (basename item)))))))) + (call-with-input-string nar (cut restore-file <> temp))) + (call-with-input-file temp read-string))))) + (test-equal "/nar/invalid" 404 (begin diff --git a/tests/ui.scm b/tests/ui.scm index 51577acb76..058207e8b9 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -189,6 +189,10 @@ Second line" 24)) (string->duration "1m") (string->duration "30d")) +(test-equal "duration, 1 second" + (make-time time-duration 0 1) + (string->duration "1s")) + (test-equal "duration, integer" #f (string->duration "1")) |