summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/guix-environment.sh14
-rw-r--r--tests/opam.scm225
-rw-r--r--tests/publish.scm17
-rw-r--r--tests/store-deduplication.scm44
-rw-r--r--tests/substitute.scm42
5 files changed, 264 insertions, 78 deletions
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index b44aca099d..30b21028aa 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -118,6 +118,18 @@ fi
# in its profile (e.g., for 'gzip'), but we have to accept them.
guix environment guix --bootstrap -n
+# Try program transformation options.
+mkdir "$tmpdir/emacs-36.8"
+drv="`guix environment --ad-hoc emacs -n 2>&1 | grep 'emacs.*\.drv'`"
+transformed_drv="`guix environment --ad-hoc emacs --with-source="$tmpdir/emacs-36.8" -n 2>&1 | grep 'emacs.*\.drv'`"
+test -n "$drv"
+test "$drv" != "$transformed_drv"
+case "$transformed_drv" in
+ *-emacs-36.8.drv) true;;
+ *) false;;
+esac
+rmdir "$tmpdir/emacs-36.8"
+
if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
then
# Compute the build environment for the initial GNU Make.
diff --git a/tests/opam.scm b/tests/opam.scm
index a1320abfdc..e0ec5ef3d4 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -21,98 +21,177 @@
#:use-module (guix base32)
#:use-module (gcrypt hash)
#:use-module (guix tests)
+ #:use-module ((guix build syscalls) #:select (mkdtemp!))
#:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which))
+ #:use-module ((guix utils) #:select (call-with-temporary-output-file))
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
#:use-module (web uri)
- #:use-module (ice-9 match))
-
-(define test-url-file
- "http: \"https://example.org/foo-1.0.0.tar.gz\"
-checksum: \"ac8920f39a8100b94820659bc2c20817\"")
-
-(define test-source-hash
- "")
-
-(define test-urls
- "repo ac8920f39a8100b94820659bc2c20817 0o644
-packages/foo/foo.1.0.0/url ac8920f39a8100b94820659bc2c20817 0o644
-packages/foo/foo.1.0.0/opam ac8920f39a8100b94820659bc2c20817 0o644
-packages/foo/foo.1.0.0/descr ac8920f39a8100b94820659bc2c20817 0o644")
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 peg))
(define test-opam-file
-"opam-version: 1.2
+"opam-version: \"2.0\"
+ version: \"1.0.0\"
maintainer: \"Alice Doe\"
-authors: \"Alice Doe, John Doe\"
+authors: [
+ \"Alice Doe\"
+ \"John Doe\"
+]
homepage: \"https://example.org/\"
bug-reports: \"https://example.org/bugs\"
-license: \"MIT\"
dev-repo: \"https://example.org/git\"
build: [
- \"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\"
+ [\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\"]
]
build-test: [
- \"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\" \"--tests\" \"true\"
+ [\"ocaml\" \"pkg/pkg.ml\" \"build\" \"--pinned\" \"%{pinned}%\" \"--tests\" \"true\"]
]
depends: [
\"alcotest\" {test & >= \"0.7.2\"}
\"ocamlbuild\" {build & >= \"0.9.2\"}
-]")
+ \"zarith\" {>= \"0.7\"}
+]
+synopsis: \"Some example package\"
+description: \"\"\"
+This package is just an example.\"\"\"
+url {
+ src: \"https://example.org/foo-1.0.0.tar.gz\"
+ checksum: \"md5=74c6e897658e820006106f45f736381f\"
+}")
+
+(define test-source-hash
+ "")
+
+(define test-repo
+ (mkdtemp! "/tmp/opam-repo.XXXXXX"))
(test-begin "opam")
(test-assert "opam->guix-package"
- ;; Replace network resources with sample data.
- (mock ((guix import utils) url-fetch
- (lambda (url file-name)
- (match url
- ("https://example.org/foo-1.0.0.tar.gz"
- (begin
- (mkdir-p "foo-1.0.0")
- (system* "tar" "czvf" file-name "foo-1.0.0/")
- (delete-file-recursively "foo-1.0.0")
- (set! test-source-hash
- (call-with-input-file file-name port-sha256))))
- (_ (error "Unexpected URL: " url)))))
- (mock ((guix http-client) http-fetch/cached
- (lambda (url . rest)
- (match (uri->string url)
- ("https://opam.ocaml.org/urls.txt"
- (values (open-input-string test-urls)
- (string-length test-urls)))
- (_ (error "Unexpected URL: " url)))))
- (mock ((guix http-client) http-fetch
- (lambda (url . rest)
- (match url
- ("https://opam.ocaml.org/packages/foo/foo.1.0.0/url"
- (values (open-input-string test-url-file)
- (string-length test-url-file)))
- ("https://opam.ocaml.org/packages/foo/foo.1.0.0/opam"
- (values (open-input-string test-opam-file)
- (string-length test-opam-file)))
- (_ (error "Unexpected URL: " url)))))
- (match (opam->guix-package "foo")
- (('package
- ('name "ocaml-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri "https://example.org/foo-1.0.0.tar.gz")
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'ocaml-build-system)
- ('inputs
- ('quasiquote
- (("ocamlbuild" ('unquote 'ocamlbuild))
- ("ocaml-alcotest" ('unquote 'ocaml-alcotest)))))
- ('home-page "https://example.org/")
- ('synopsis "")
- ('description "")
- ('license 'license:expat))
- (string=? (bytevector->nix-base32-string
- test-source-hash)
- hash))
- (x
- (pk 'fail x #f)))))))
+ (mock ((guix import utils) url-fetch
+ (lambda (url file-name)
+ (match url
+ ("https://example.org/foo-1.0.0.tar.gz"
+ (begin
+ (mkdir-p "foo-1.0.0")
+ (system* "tar" "czvf" file-name "foo-1.0.0/")
+ (delete-file-recursively "foo-1.0.0")
+ (set! test-source-hash
+ (call-with-input-file file-name port-sha256))))
+ (_ (error "Unexpected URL: " url)))))
+ (let ((my-package (string-append test-repo "/packages/foo/foo.1.0.0")))
+ (mkdir-p my-package)
+ (with-output-to-file (string-append my-package "/opam")
+ (lambda _
+ (format #t "~a" test-opam-file))))
+ (mock ((guix import opam) get-opam-repository
+ (lambda _
+ test-repo))
+ (match (opam->guix-package "foo")
+ (('package
+ ('name "ocaml-foo")
+ ('version "1.0.0")
+ ('source ('origin
+ ('method 'url-fetch)
+ ('uri "https://example.org/foo-1.0.0.tar.gz")
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'ocaml-build-system)
+ ('inputs
+ ('quasiquote
+ (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+ ('native-inputs
+ ('quasiquote
+ (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
+ ("ocamlbuild" ('unquote 'ocamlbuild)))))
+ ('home-page "https://example.org/")
+ ('synopsis "Some example package")
+ ('description "This package is just an example.")
+ ('license #f))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f))))))
+
+;; Test the opam file parser
+;; We fold over some test cases. Each case is a pair of the string to parse and the
+;; expected result.
+(test-assert "parse-strings"
+ (fold (lambda (test acc)
+ (display test) (newline)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam) string-pat) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("\"hello\"" . (string-pat "hello"))
+ ("\"hello world\"" . (string-pat "hello world"))
+ ("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\""))
+ ("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)"))
+ ("\"今日は\"" . (string-pat "今日は")))))
+
+(test-assert "parse-multiline-strings"
+ (fold (lambda (test acc)
+ (display test) (newline)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam) multiline-string) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("\"\"\"hello\"\"\"" . (multiline-string "hello"))
+ ("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello \"world\"!"))
+ ("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello \"\"world\"\"!")))))
+
+(test-assert "parse-lists"
+ (fold (lambda (test acc)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam) list-pat) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("[]" . list-pat)
+ ("[make]" . (list-pat (var "make")))
+ ("[\"make\"]" . (list-pat (string-pat "make")))
+ ("[\n a\n b\n c]" . (list-pat (var "a") (var "b") (var "c")))
+ ("[a b \"c\"]" . (list-pat (var "a") (var "b") (string-pat "c"))))))
+
+(test-assert "parse-dicts"
+ (fold (lambda (test acc)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam) dict) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("{}" . dict)
+ ("{a: \"b\"}" . (dict (record "a" (string-pat "b"))))
+ ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record "c" (string-pat "d")))))))
+
+(test-assert "parse-conditions"
+ (fold (lambda (test acc)
+ (and acc
+ (let ((result (peg:tree (match-pattern (@@ (guix import opam) condition) (car test)))))
+ (if (equal? result (cdr test))
+ #t
+ (pk 'fail (list (car test) result (cdr test)) #f)))))
+ #t '(("" . #f)
+ ("{}" . #f)
+ ("{build}" . (condition-var "build"))
+ ("{>= \"0.2.0\"}" . (condition-greater-or-equal
+ (condition-string "0.2.0")))
+ ("{>= \"0.2.0\" & test}" . (condition-and
+ (condition-greater-or-equal
+ (condition-string "0.2.0"))
+ (condition-var "test")))
+ ("{>= \"0.2.0\" | build}" . (condition-or
+ (condition-greater-or-equal
+ (condition-string "0.2.0"))
+ (condition-var "build"))))))
(test-end "opam")
diff --git a/tests/publish.scm b/tests/publish.scm
index 0e793c1ee5..79a786e723 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -411,10 +411,12 @@ FileSize: ~a~%"
(random-text))))
(test-equal "with cache, uncompressed"
(list #t
+ (* 42 3600) ;TTL on narinfo
`(("StorePath" . ,item)
("URL" . ,(string-append "nar/" (basename item)))
("Compression" . "none"))
200 ;nar/…
+ (* 42 3600) ;TTL on nar/…
(path-info-nar-size
(query-path-info %store item)) ;FileSize
404) ;nar/gzip/…
@@ -423,7 +425,7 @@ FileSize: ~a~%"
(let ((thread (with-separate-output-ports
(call-with-new-thread
(lambda ()
- (guix-publish "--port=6796" "-C2"
+ (guix-publish "--port=6796" "-C2" "--ttl=42h"
(string-append "--cache=" cache)))))))
(wait-until-ready 6796)
(let* ((base "http://localhost:6796/")
@@ -437,13 +439,19 @@ FileSize: ~a~%"
(and (= 404 (response-code response))
(wait-for-file cached)
- (let* ((body (http-get-port url))
+ (let* ((response (http-get url))
+ (body (http-get-port url))
(compressed (http-get (string-append base "nar/gzip/"
(basename item))))
(uncompressed (http-get (string-append base "nar/"
(basename item))))
(narinfo (recutils->alist body)))
(list (file-exists? nar)
+ (match (assq-ref (response-headers response)
+ 'cache-control)
+ ((('max-age . ttl)) ttl)
+ (_ #f))
+
(filter (lambda (item)
(match item
(("Compression" . _) #t)
@@ -452,6 +460,11 @@ FileSize: ~a~%"
(_ #f)))
narinfo)
(response-code uncompressed)
+ (match (assq-ref (response-headers uncompressed)
+ 'cache-control)
+ ((('max-age . ttl)) ttl)
+ (_ #f))
+
(string->number
(assoc-ref narinfo "FileSize"))
(response-code compressed))))))))))
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index e438aa84c6..e2870a363d 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -48,7 +48,7 @@
(put-bytevector port data))))
identical)
;; Make the parent of IDENTICAL read-only. This should not prevent
- ;; deduplication for inserting its hard link.
+ ;; deduplication from inserting its hard link.
(chmod (dirname (second identical)) #o544)
(call-with-output-file unique
@@ -64,4 +64,46 @@
(stat:nlink (stat unique))
(map (compose stat:nlink stat) identical))))))
+(test-equal "deduplicate, ENOSPC"
+ (cons* #f ;inode comparison
+ (append (make-list 3 4)
+ (make-list 7 1))) ;'nlink' values
+
+ ;; In this scenario the first 3 files are properly deduplicated and then we
+ ;; simulate a full '.links' directory where link(2) gets ENOSPC, thereby
+ ;; preventing deduplication of the subsequent files.
+ (call-with-temporary-directory
+ (lambda (store)
+ (let ((true-link link)
+ (links 0)
+ (data1 (string->utf8 "Hello, world!"))
+ (data2 (string->utf8 "Hi, world!"))
+ (identical (map (lambda (n)
+ (string-append store "/" (number->string n)
+ "/a/b/c"))
+ (iota 10)))
+ (populate (lambda (data)
+ (lambda (file)
+ (mkdir-p (dirname file))
+ (call-with-output-file file
+ (lambda (port)
+ (put-bytevector port data)))))))
+ (for-each (populate data1) (take identical 5))
+ (for-each (populate data2) (drop identical 5))
+ (dynamic-wind
+ (lambda ()
+ (set! link (lambda (old new)
+ (set! links (+ links 1))
+ (if (<= links 3)
+ (true-link old new)
+ (throw 'system-error "link" "~A" '("Whaaat?!")
+ (list ENOSPC))))))
+ (lambda ()
+ (deduplicate store (nar-sha256 store) #:store store))
+ (lambda ()
+ (set! link true-link)))
+
+ (cons (apply = (map (compose stat:ino stat) identical))
+ (map (compose stat:nlink stat) identical))))))
+
(test-end "store-deduplication")
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 964a57f30b..f4f2e9512d 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -211,6 +211,46 @@ a file for NARINFO."
(lambda ()
(guix-substitute "--query"))))))))
+(test-equal "query narinfo with signature over nothing"
+ ;; The signature is computed over the empty string, not over the important
+ ;; parts, so the narinfo must be ignored.
+ ""
+
+ (with-narinfo (string-append "Signature: " (signature-field "") "\n"
+ %narinfo "\n")
+ (string-trim-both
+ (with-output-to-string
+ (lambda ()
+ (with-input-from-string (string-append "have " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ (lambda ()
+ (guix-substitute "--query"))))))))
+
+(test-equal "query narinfo with signature over irrelevant bits"
+ ;; The signature is valid but it does not cover the
+ ;; StorePath/NarHash/References tuple and is thus irrelevant; the narinfo
+ ;; must be ignored.
+ ""
+
+ (let ((prefix (string-append "StorePath: " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
+URL: example.nar
+Compression: none\n")))
+ (with-narinfo (string-append prefix
+ "Signature: " (signature-field prefix) "
+NarHash: sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+NarSize: 42
+References: bar baz
+Deriver: " (%store-prefix) "/foo.drv
+System: mips64el-linux\n")
+ (string-trim-both
+ (with-output-to-string
+ (lambda ()
+ (with-input-from-string (string-append "have " (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ (lambda ()
+ (guix-substitute "--query")))))))))
+
(test-equal "query narinfo signed with authorized key"
(string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")