diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/gexp.scm | 31 | ||||
| -rw-r--r-- | tests/hash.scm | 4 | ||||
| -rw-r--r-- | tests/nar.scm | 62 | ||||
| -rw-r--r-- | tests/pypi.scm | 6 | ||||
| -rw-r--r-- | tests/store-database.scm | 7 | ||||
| -rw-r--r-- | tests/store.scm | 46 |
6 files changed, 133 insertions, 23 deletions
diff --git a/tests/gexp.scm b/tests/gexp.scm index 391a0f8be5..b22e635805 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -635,18 +635,16 @@ "guix/derivations.scm")) ("p/q" . ,(search-path %load-path "guix.scm")) ("p/z" . ,(search-path %load-path "guix/store.scm")))) - (drv (imported-files files))) + (dir (imported-files files))) (mbegin %store-monad - (built-derivations (list drv)) - (let ((dir (derivation->output-path drv))) - (return - (every (match-lambda - ((path . source) - (equal? (call-with-input-file (string-append dir "/" path) - get-bytevector-all) - (call-with-input-file source - get-bytevector-all)))) - files)))))) + (return + (every (match-lambda + ((path . source) + (equal? (call-with-input-file (string-append dir "/" path) + get-bytevector-all) + (call-with-input-file source + get-bytevector-all)))) + files))))) (test-assertm "imported-files with file-like objects" (mlet* %store-monad ((plain -> (plain-file "foo" "bar!")) @@ -654,16 +652,19 @@ (files -> `(("a/b/c" . ,q-scm) ("p/q" . ,plain))) (drv (imported-files files))) + (define (file=? file1 file2) + ;; Assume deduplication is in place. + (= (stat:ino (lstat file1)) + (stat:ino (lstat file2)))) + (mbegin %store-monad (built-derivations (list drv)) (mlet %store-monad ((dir -> (derivation->output-path drv)) (plain* (text-file "foo" "bar!")) (q-scm* (interned-file q-scm "c"))) (return - (and (string=? (readlink (string-append dir "/a/b/c")) - q-scm*) - (string=? (readlink (string-append dir "/p/q")) - plain*))))))) + (and (file=? (string-append dir "/a/b/c") q-scm*) + (file=? (string-append dir "/p/q") plain*))))))) (test-equal "gexp-modules & ungexp" '((bar) (foo)) diff --git a/tests/hash.scm b/tests/hash.scm index da87616eec..47dff3915b 100644 --- a/tests/hash.scm +++ b/tests/hash.scm @@ -64,12 +64,12 @@ (get))) (test-equal "open-sha256-port, hello" - %hello-sha256 + (list %hello-sha256 (string-length "hello world")) (let-values (((port get) (open-sha256-port))) (put-bytevector port (string->utf8 "hello world")) (force-output port) - (get))) + (list (get) (port-position port)))) (test-assert "port-sha256" (let* ((file (search-path %load-path "ice-9/psyntax.scm")) diff --git a/tests/nar.scm b/tests/nar.scm index 61646db964..9b5fb984b4 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 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -152,6 +152,66 @@ (test-begin "nar") +(test-assert "write-file-tree + restore-file" + (let* ((file1 (search-path %load-path "guix.scm")) + (file2 (search-path %load-path "guix/base32.scm")) + (file3 "#!/bin/something") + (output (string-append %test-dir "/output"))) + (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/foo" + (values 'regular (stat:size (stat file1)))) + ("root/lnk" + (values 'symlink 0)) + ("root/dir" + (values 'directory 0)) + ("root/dir/bar" + (values 'regular (stat:size (stat file2)))) + ("root/dir/exe" + (values 'executable (string-length file3)))) + #:file-port + (match-lambda + ("root/foo" (open-input-file file1)) + ("root/dir/bar" (open-input-file file2)) + ("root/dir/exe" (open-input-string file3))) + #:symlink-target + (match-lambda + ("root/lnk" "foo")) + #:directory-entries + (match-lambda + ("root" '("foo" "dir" "lnk")) + ("root/dir" '("bar" "exe")))) + (close-port port) + + (rm-rf %test-dir) + (mkdir %test-dir) + (restore-file (open-bytevector-input-port (get-bytevector)) + output) + (and (file=? (string-append output "/foo") file1) + (string=? (readlink (string-append output "/lnk")) + "foo") + (file=? (string-append output "/dir/bar") file2) + (string=? (call-with-input-file (string-append output "/dir/exe") + get-string-all) + file3) + (> (logand (stat:mode (lstat (string-append output "/dir/exe"))) + #o100) + 0) + (equal? '("." ".." "bar" "exe") + (scandir (string-append output "/dir"))) + (equal? '("." ".." "dir" "foo" "lnk") + (scandir output)))) + (lambda () + (false-if-exception (rm-rf %test-dir)))))) + (test-assert "write-file supports non-file output ports" (let ((input (string-append (dirname (search-path %load-path "guix.scm")) "/guix")) diff --git a/tests/pypi.scm b/tests/pypi.scm index 74f13e9662..310c6c8f29 100644 --- a/tests/pypi.scm +++ b/tests/pypi.scm @@ -89,7 +89,7 @@ baz > 13.37") (dummy-package "foo" (source (dummy-origin (uri - "https://pypi.python.org/packages/a2/3b/4756e6a0ceb14e084042a2a65c615d68d25621c6fd446d0fc10d14c4ce7d/certbot-0.8.1.tar.gz")))))) + "https://pypi.org/packages/a2/3b/4756e6a0ceb14e084042a2a65c615d68d25621c6fd446d0fc10d14c4ce7d/certbot-0.8.1.tar.gz")))))) (test-equal "guix-package->pypi-name, several URLs" "cram" @@ -120,7 +120,7 @@ baz > 13.37") (mock ((guix http-client) http-fetch (lambda (url . rest) (match url - ("https://pypi.python.org/pypi/foo/json" + ("https://pypi.org/pypi/foo/json" (values (open-input-string test-json) (string-length test-json))) ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) @@ -182,7 +182,7 @@ baz > 13.37") (mock ((guix http-client) http-fetch (lambda (url . rest) (match url - ("https://pypi.python.org/pypi/foo/json" + ("https://pypi.org/pypi/foo/json" (values (open-input-string test-json) (string-length test-json))) ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f) diff --git a/tests/store-database.scm b/tests/store-database.scm index fcae66e2de..4d91884250 100644 --- a/tests/store-database.scm +++ b/tests/store-database.scm @@ -32,7 +32,8 @@ (test-begin "store-database") -(test-assert "register-path" +(test-equal "register-path" + '(1 1) (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f) "-fake"))) (when (valid-path? %store file) @@ -50,7 +51,9 @@ (and (valid-path? %store file) (equal? (references %store file) (list ref)) (null? (valid-derivers %store file)) - (null? (referrers %store file)))))) + (null? (referrers %store file)) + (list (stat:mtime (lstat file)) + (stat:mtime (lstat ref))))))) (test-equal "new database" (list 1 2) diff --git a/tests/store.scm b/tests/store.scm index afecec940a..47fab0df18 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -210,6 +210,52 @@ (valid-path? store path) (file-exists? path))))) +(test-equal "add-file-tree-to-store" + `(42 + ("." directory #t) + ("./bar" directory #t) + ("./foo" directory #t) + ("./foo/a" regular "file a") + ("./foo/b" symlink "a") + ("./foo/c" directory #t) + ("./foo/c/p" regular "file p") + ("./foo/c/q" directory #t) + ("./foo/c/q/x" regular "#!/bin/sh\nexit 42") + ("./foo/c/q/y" symlink "..") + ("./foo/c/q/z" directory #t)) + (let* ((tree `("file-tree" directory + ("foo" directory + ("a" regular (data "file a")) + ("b" symlink "a") + ("c" directory + ("p" regular (data ,(string->utf8 "file p"))) + ("q" directory + ("x" executable + (data "#!/bin/sh\nexit 42")) + ("y" symlink "..") + ("z" directory)))) + ("bar" directory))) + (result (add-file-tree-to-store %store tree))) + (cons (status:exit-val (system* (string-append result "/foo/c/q/x"))) + (with-directory-excursion result + (map (lambda (file) + (let ((type (stat:type (lstat file)))) + `(,file ,type + ,(match type + ((or 'regular 'executable) + (call-with-input-file file + get-string-all)) + ('symlink (readlink file)) + ('directory #t))))) + (find-files "." #:directories? #t)))))) + +(test-equal "add-file-tree-to-store, flat" + "Hello, world!" + (let* ((tree `("flat-file" regular (data "Hello, world!"))) + (result (add-file-tree-to-store %store tree))) + (and (file-exists? result) + (call-with-input-file result get-string-all)))) + (test-assert "references" (let* ((t1 (add-text-to-store %store "random1" (random-text))) |