From 2c6ab6ccd430550dfbc95fbdd22ae017f39e5901 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 1 Apr 2013 16:08:31 +0200 Subject: store: Add `store-path-hash-part'. * guix/store.scm (store-path-hash-part): New procedure. * tests/store.scm ("store-path-hash-part", "store-path-hash-part #f"): New tests. --- tests/store.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) (limited to 'tests') diff --git a/tests/store.scm b/tests/store.scm index c2de99e160..d6e1aa54e3 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -48,6 +48,18 @@ (test-begin "store") +(test-equal "store-path-hash-part" + "283gqy39v3g9dxjy26rynl0zls82fmcg" + (store-path-hash-part + (string-append (%store-prefix) + "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) + +(test-equal "store-path-hash-part #f" + #f + (store-path-hash-part + (string-append (%store-prefix) + "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) + (test-skip (if %store 0 10)) (test-assert "dead-paths" -- cgit v1.2.3 From f65cf81a3cd15eab993e129977bca46972508b4b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 2 Apr 2013 10:44:20 +0200 Subject: Add preliminary binary substituter. * guix/scripts/substitute-binary.scm: New file. * Makefile.am (MODULES): Add it. * nix/scripts/substitute-binary.in: New file. * config-daemon.ac: Produce nix/scripts/substitute-binary. * daemon.am (nodist_pkglibexec_SCRIPTS): Add nix/scripts/substitute-binary. * guix/store.scm (substitutable-path-info): Use the `query-substitutable-path-infos' RPC. * nix/nix-daemon/guix-daemon.cc (main): Honor `NIX_SUBSTITUTERS'. * pre-inst-env.in: Set `NIX_SUBSTITUTERS'. * test-env.in: Leave `NIX_SUBSTITUTERS' unchanged. Set `GUIX_BINARY_SUBSTITUTE_URL, and create $NIX_STATE_DIR/substituter-data. Run `guix-daemon' within `./pre-inst-env'. * tests/store.scm ("substitute query"): New test. --- tests/store.scm | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) (limited to 'tests') diff --git a/tests/store.scm b/tests/store.scm index d6e1aa54e3..c75b99c6a9 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -26,6 +26,7 @@ #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module (ice-9 match) + #:use-module (web uri) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-64)) @@ -128,6 +129,44 @@ (null? (substitutable-paths s o)) (null? (substitutable-path-info s o))))) +(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1)) + +(test-assert "substitute query" + (let* ((s (open-connection)) + (d (package-derivation s %bootstrap-guile (%current-system))) + (o (derivation-path->output-path d)) + (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") + (compose uri-path string->uri)))) + ;; Create fake substituter data, to be read by `substitute-binary'. + (call-with-output-file (string-append dir "/nix-cache-info") + (lambda (p) + (format p "StoreDir: ~a\nWantMassQuery: 0\n" + (getenv "NIX_STORE_DIR")))) + (call-with-output-file (string-append dir "/" (store-path-hash-part o) + ".narinfo") + (lambda (p) + (format p "StorePath: ~a +URL: ~a +Compression: none +NarSize: 1234 +References: +System: ~a +Deriver: ~a~%" + o ; StorePath + (string-append dir "/example.nar") ; URL + (%current-system) ; System + (basename d)))) ; Deriver + + ;; Make sure `substitute-binary' correctly communicates the above data. + (set-build-options s #:use-substitutes? #t) + (and (has-substitutes? s o) + (equal? (list o) (substitutable-paths s (list o))) + (match (pk 'spi (substitutable-path-info s (list o))) + (((? substitutable? s)) + (and (equal? (substitutable-deriver s) d) + (null? (substitutable-references s)) + (equal? (substitutable-nar-size s) 1234))))))) + (test-end "store") -- cgit v1.2.3 From 53c63ee93790e4e4054bf6547199d3490b78bf47 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 8 Apr 2013 22:54:08 +0200 Subject: nar: Implement restoration from Nar. * guix/nar.scm (&nar-error, &nar-read-error): New condition types. (dump): New procedure. (write-contents)[dump]: Remove. Use the one above instead. (read-contents, write-file, restore-file): New procedures. (%archive-version-1): New variable. --- tests/nar.scm | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 tests/nar.scm (limited to 'tests') diff --git a/tests/nar.scm b/tests/nar.scm new file mode 100644 index 0000000000..2d9bffd487 --- /dev/null +++ b/tests/nar.scm @@ -0,0 +1,95 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-nar) + #:use-module (guix nar) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-64) + #:use-module (ice-9 ftw)) + +;; Test the (guix nar) module. + +(define (rm-rf dir) + (file-system-fold (const #t) ; enter? + (lambda (file stat result) ; leaf + (delete-file file)) + (const #t) ; down + (lambda (dir stat result) ; up + (rmdir dir)) + (const #t) ; skip + (const #t) ; error + #t + dir + lstat)) + + +(test-begin "nar") + +(test-assert "write-file + restore-file" + (let* ((input (string-append (dirname (search-path %load-path "guix.scm")) + "/guix")) + (output (string-append (dirname input) + "/test-nar-" + (number->string (getpid)))) + (nar (string-append output ".nar"))) + (dynamic-wind + (lambda () #t) + (lambda () + (call-with-output-file nar + (cut write-file input <>)) + (call-with-input-file nar + (cut restore-file <> output)) + (let* ((strip (cute string-drop <> (string-length input))) + (sibling (compose (cut string-append output <>) strip)) + (file=? (lambda (a b) + (and (eq? (stat:type (lstat a)) (stat:type (lstat b))) + (case (stat:type (lstat a)) + ((regular) + (equal? + (call-with-input-file a get-bytevector-all) + (call-with-input-file b get-bytevector-all))) + ((symlink) + (string=? (readlink a) (readlink b))) + (else + (error "what?" (lstat a)))))))) + (file-system-fold (const #t) + (lambda (name stat result) ; leaf + (and result + (file=? name (sibling name)))) + (lambda (name stat result) ; down + result) + (lambda (name stat result) ; up + result) + (const #f) ; skip + (lambda (name stat errno result) + (pk 'error name stat errno) + #f) + (> (stat:nlink (stat output)) 2) + input + lstat))) + (lambda () + (false-if-exception (delete-file nar)) + (false-if-exception (rm-rf output)) + )))) + +(test-end "nar") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- cgit v1.2.3 From 8f3114b7a433480c9534903d23d659ce3fb12ffb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 12 Apr 2013 14:35:01 +0200 Subject: nar: Add support for symlinks. * guix/nar.scm (write-file): Add case for type `symlink'. (restore-file): Likewise. * tests/nar.scm (random-file-size, make-file-tree, delete-file-tree, with-file-tree, file-tree-equal?, make-random-bytevector, populate-file): New procedures. (%test-dir): New variable. ("write-file + restore-file"): Use `%test-dir' and `file-tree-equal?'. ("write-file + restore-file with symlinks"): New test. --- tests/nar.scm | 183 +++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 149 insertions(+), 34 deletions(-) (limited to 'tests') diff --git a/tests/nar.scm b/tests/nar.scm index 2d9bffd487..4321cbda53 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -22,10 +22,122 @@ #:use-module (rnrs io ports) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) - #:use-module (ice-9 ftw)) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match)) ;; Test the (guix nar) module. + +;;; +;;; File system testing tools, initially contributed to Guile, then libchop. +;;; + +(define (random-file-size) + (define %average (* 1024 512)) ; 512 KiB + (define %stddev (* 1024 64)) ; 64 KiB + (inexact->exact + (max 0 (round (+ %average (* %stddev (random:normal))))))) + +(define (make-file-tree dir tree) + "Make file system TREE at DIR." + (let loop ((dir dir) + (tree tree)) + (define (scope file) + (string-append dir "/" file)) + + (match tree + (('directory name (body ...)) + (mkdir (scope name)) + (for-each (cute loop (scope name) <>) body)) + (('directory name (? integer? mode) (body ...)) + (mkdir (scope name)) + (for-each (cute loop (scope name) <>) body) + (chmod (scope name) mode)) + ((file) + (populate-file (scope file) (random-file-size))) + ((file (? integer? mode)) + (populate-file (scope file) (random-file-size)) + (chmod (scope file) mode)) + ((from '-> to) + (symlink to (scope from)))))) + +(define (delete-file-tree dir tree) + "Delete file TREE from DIR." + (let loop ((dir dir) + (tree tree)) + (define (scope file) + (string-append dir "/" file)) + + (match tree + (('directory name (body ...)) + (for-each (cute loop (scope name) <>) body) + (rmdir (scope name))) + (('directory name (? integer? mode) (body ...)) + (chmod (scope name) #o755) ; make sure it can be entered + (for-each (cute loop (scope name) <>) body) + (rmdir (scope name))) + ((from '-> _) + (delete-file (scope from))) + ((file _ ...) + (delete-file (scope file)))))) + +(define-syntax-rule (with-file-tree dir tree body ...) + (dynamic-wind + (lambda () + (make-file-tree dir 'tree)) + (lambda () + body ...) + (lambda () + (delete-file-tree dir 'tree)))) + +(define (file-tree-equal? input output) + "Return #t if the file trees at INPUT and OUTPUT are equal." + (define strip + (cute string-drop <> (string-length input))) + (define sibling + (compose (cut string-append output <>) strip)) + (define (file=? a b) + (and (eq? (stat:type (lstat a)) (stat:type (lstat b))) + (case (stat:type (lstat a)) + ((regular) + (equal? + (call-with-input-file a get-bytevector-all) + (call-with-input-file b get-bytevector-all))) + ((symlink) + (string=? (readlink a) (readlink b))) + (else + (error "what?" (lstat a)))))) + + (file-system-fold (const #t) + (lambda (name stat result) ; leaf + (and result + (file=? name (sibling name)))) + (lambda (name stat result) ; down + result) + (lambda (name stat result) ; up + result) + (const #f) ; skip + (lambda (name stat errno result) + (pk 'error name stat errno) + #f) + (> (stat:nlink (stat output)) 2) + input + lstat)) + +(define (make-random-bytevector n) + (let ((bv (make-bytevector n))) + (let loop ((i 0)) + (if (< i n) + (begin + (bytevector-u8-set! bv i (random 256)) + (loop (1+ i))) + bv)))) + +(define (populate-file file size) + (call-with-output-file file + (lambda (p) + (put-bytevector p (make-random-bytevector size))))) + (define (rm-rf dir) (file-system-fold (const #t) ; enter? (lambda (file stat result) ; leaf @@ -39,15 +151,18 @@ dir lstat)) +(define %test-dir + ;; An output directory under $top_builddir. + (string-append (dirname (search-path %load-path "configure")) + "/test-nar-" (number->string (getpid)))) + (test-begin "nar") (test-assert "write-file + restore-file" (let* ((input (string-append (dirname (search-path %load-path "guix.scm")) "/guix")) - (output (string-append (dirname input) - "/test-nar-" - (number->string (getpid)))) + (output %test-dir) (nar (string-append output ".nar"))) (dynamic-wind (lambda () #t) @@ -56,40 +171,40 @@ (cut write-file input <>)) (call-with-input-file nar (cut restore-file <> output)) - (let* ((strip (cute string-drop <> (string-length input))) - (sibling (compose (cut string-append output <>) strip)) - (file=? (lambda (a b) - (and (eq? (stat:type (lstat a)) (stat:type (lstat b))) - (case (stat:type (lstat a)) - ((regular) - (equal? - (call-with-input-file a get-bytevector-all) - (call-with-input-file b get-bytevector-all))) - ((symlink) - (string=? (readlink a) (readlink b))) - (else - (error "what?" (lstat a)))))))) - (file-system-fold (const #t) - (lambda (name stat result) ; leaf - (and result - (file=? name (sibling name)))) - (lambda (name stat result) ; down - result) - (lambda (name stat result) ; up - result) - (const #f) ; skip - (lambda (name stat errno result) - (pk 'error name stat errno) - #f) - (> (stat:nlink (stat output)) 2) - input - lstat))) + (file-tree-equal? input output)) (lambda () (false-if-exception (delete-file nar)) - (false-if-exception (rm-rf output)) - )))) + (false-if-exception (rm-rf output)))))) + +(test-assert "write-file + restore-file with symlinks" + (let ((input (string-append %test-dir ".input"))) + (mkdir input) + (dynamic-wind + (const #t) + (lambda () + (with-file-tree input + (directory "root" + (("reg") ("exe" #o777) ("sym" -> "reg"))) + (let* ((output %test-dir) + (nar (string-append output ".nar"))) + (dynamic-wind + (lambda () #t) + (lambda () + (call-with-output-file nar + (cut write-file input <>)) + (call-with-input-file nar + (cut restore-file <> output)) + (file-tree-equal? input output)) + (lambda () + (false-if-exception (delete-file nar))))))) + (lambda () + (rmdir input))))) (test-end "nar") (exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;;; Local Variables: +;;; eval: (put 'with-file-tree 'scheme-indent-function 2) +;;; End: -- cgit v1.2.3 From fe0cff14f6c5facee4192529f5c7b7a972f185ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 12 Apr 2013 17:30:27 +0200 Subject: substitute-binary: Implement `--substitute'. This allows build outputs to be transparently downloaded from http://hydra.gnu.org, for example. * config-daemon.ac: Check for `gzip', `bzip2', and `xz'. * guix/config.scm.in (%gzip, %bzip2, %xz): New variable. * guix/scripts/substitute-binary.scm (fetch): Return SIZE as a second value. (): Change `url' to `uri'. (make-narinfo): Rename to... (narinfo-maker): ... this. Handle relative URLs. (fetch-narinfo): Adjust accordingly. (filtered-port, decompressed-port): New procedures. (guix-substitute-binary): Implement the `--substitute' case. * tests/store.scm ("substitute query"): Use (%store-prefix) instead of (getenv "NIX_STORE_DIR"). ("substitute"): New test. --- tests/store.scm | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 54 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/store.scm b/tests/store.scm index c75b99c6a9..4ee20a9352 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -23,9 +23,11 @@ #:use-module (guix base32) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module (guix nar) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module (ice-9 match) + #:use-module (rnrs io ports) #:use-module (web uri) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -141,7 +143,7 @@ (call-with-output-file (string-append dir "/nix-cache-info") (lambda (p) (format p "StoreDir: ~a\nWantMassQuery: 0\n" - (getenv "NIX_STORE_DIR")))) + (%store-prefix)))) (call-with-output-file (string-append dir "/" (store-path-hash-part o) ".narinfo") (lambda (p) @@ -167,6 +169,57 @@ Deriver: ~a~%" (null? (substitutable-references s)) (equal? (substitutable-nar-size s) 1234))))))) +(test-assert "substitute" + (let* ((s (open-connection)) + (c (random-text)) ; contents of the output + (d (build-expression->derivation + s "substitute-me" (%current-system) + `(call-with-output-file %output + (lambda (p) + (exit 1) ; would actually fail + (display ,c p))) + '() + #:guile-for-build + (package-derivation s %bootstrap-guile (%current-system)))) + (o (derivation-path->output-path d)) + (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") + (compose uri-path string->uri)))) + ;; Create fake substituter data, to be read by `substitute-binary'. + (call-with-output-file (string-append dir "/nix-cache-info") + (lambda (p) + (format p "StoreDir: ~a\nWantMassQuery: 0\n" + (%store-prefix)))) + (call-with-output-file (string-append dir "/example.out") + (lambda (p) + (display c p))) + (call-with-output-file (string-append dir "/example.nar") + (lambda (p) + (write-file (string-append dir "/example.out") p))) + (call-with-output-file (string-append dir "/" (store-path-hash-part o) + ".narinfo") + (lambda (p) + (format p "StorePath: ~a +URL: ~a +Compression: none +NarSize: 1234 +NarHash: sha256:~a +References: +System: ~a +Deriver: ~a~%" + o ; StorePath + "example.nar" ; relative URL + (call-with-input-file (string-append dir "/example.nar") + (compose bytevector->nix-base32-string sha256 + get-bytevector-all)) + (%current-system) ; System + (basename d)))) ; Deriver + + ;; Make sure we use `substitute-binary'. + (set-build-options s #:use-substitutes? #t) + (and (has-substitutes? s o) + (build-derivations s (list d)) + (equal? c (call-with-input-file o get-string-all))))) + (test-end "store") -- cgit v1.2.3 From 77ffd691bfbb152cde94b60aa8df5135d39727c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 12 Apr 2013 18:40:22 +0200 Subject: tests: Remove temporary directory created by nar.scm. * tests/nar.scm ("write-file + restore-file with symlinks"): Add (rm-rf output). --- tests/nar.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/nar.scm b/tests/nar.scm index 4321cbda53..9bc5a1962e 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -196,7 +196,8 @@ (cut restore-file <> output)) (file-tree-equal? input output)) (lambda () - (false-if-exception (delete-file nar))))))) + (false-if-exception (delete-file nar)) + (false-if-exception (rm-rf output))))))) (lambda () (rmdir input))))) -- cgit v1.2.3 From 04fd96cac33fa7557e574e54575252564ba27111 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 14 Apr 2013 16:56:08 +0200 Subject: utils: Add `fold2'. * gnu/packages.scm (fold2): Remove. * guix/utils.scm (fold2): New procedure. Generalization of the above to one and two lists. * tests/utils.scm ("fold2, 1 list", "fold2, 2 lists"): New tests. --- tests/utils.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'tests') diff --git a/tests/utils.scm b/tests/utils.scm index bcdd120a74..fa7d7b03fd 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -64,6 +64,31 @@ ("nixpkgs" "1.0pre22125_a28fe19") ("gtk2" "2.38.0")))) +(test-equal "fold2, 1 list" + (list (reverse (iota 5)) + (map - (reverse (iota 5)))) + (call-with-values + (lambda () + (fold2 (lambda (i r1 r2) + (values (cons i r1) + (cons (- i) r2))) + '() '() + (iota 5))) + list)) + +(test-equal "fold2, 2 lists" + (list (reverse '((a . 0) (b . 1) (c . 2) (d . 3))) + (reverse '((a . 0) (b . -1) (c . -2) (d . -3)))) + (call-with-values + (lambda () + (fold2 (lambda (k v r1 r2) + (values (alist-cons k v r1) + (alist-cons k (- v) r2))) + '() '() + '(a b c d) + '(0 1 2 3))) + list)) + (test-assert "define-record-type*" (begin (define-record-type* foo make-foo -- cgit v1.2.3 From eba783b7b20cbf84dfd0a04bc19e3bebbc9a30fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 15 Apr 2013 23:42:27 +0200 Subject: substitute-binary: Add a local cache. * guix/scripts/substitute-binary.scm (%narinfo-cache-directory, %narinfo-ttl, %narinfo-negative-ttl): New variables. (with-atomic-file-output, object->fields, read-narinfo, write-narinfo, narinfo->string, string->narinfo, lookup-narinfo): New procedures. (fetch-narinfo): Adjust to use `read-narinfo'. (guix-substitute-binary): Ensure the existence of %NARINFO-CACHE-DIRECTORY. Use `lookup-narinfo' instead of `fetch-narinfo'. --- tests/store.scm | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'tests') diff --git a/tests/store.scm b/tests/store.scm index 4ee20a9352..677e39e75d 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -159,6 +159,12 @@ Deriver: ~a~%" (%current-system) ; System (basename d)))) ; Deriver + ;; Remove entry from the local cache. + (false-if-exception + (delete-file (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute-binary/" + (store-path-hash-part o)))) + ;; Make sure `substitute-binary' correctly communicates the above data. (set-build-options s #:use-substitutes? #t) (and (has-substitutes? s o) -- cgit v1.2.3 From dd36b51bf7cffa389726ad997465b14f7072944a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 17 Apr 2013 00:06:59 +0200 Subject: scripts: Report what will be substituted. * guix/derivations.scm (derivation-input-output-paths): New procedure. (derivation-prerequisites-to-build): New `use-substitutes?' keyword argument. Change two return the list of substitutable paths as a second argument. * guix/ui.scm (show-what-to-build): Turn `dry-run?' into a keyword argument. New `use-substitutes?' keyword argument. Use `fold2' and adjust to use both return values of `derivation-prerequisites-to-build'. Display what will/would be downloaded. * guix/scripts/build.scm (guix-build): Adjust accordingly. * guix/scripts/package.scm (guix-package): Likewise. * tests/derivations.scm ("derivation-prerequisites-to-build and substitutes"): New test. --- tests/derivations.scm | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) (limited to 'tests') diff --git a/tests/derivations.scm b/tests/derivations.scm index 6012e73216..a50c1af878 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -32,6 +32,7 @@ #:use-module (srfi srfi-64) #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) + #:use-module (web uri) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 ftw) @@ -398,6 +399,51 @@ ;; prerequisite to build because DRV itself is already built. (null? (derivation-prerequisites-to-build %store drv))))) +(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1)) +(test-assert "derivation-prerequisites-to-build and substitutes" + (let*-values (((store) + (open-connection)) + ((drv-path drv) + (build-expression->derivation store "prereq-subst" + (%current-system) + (random 1000) '())) + ((output) + (derivation-output-path + (assoc-ref (derivation-outputs drv) "out"))) + ((dir) + (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") + (compose uri-path string->uri)))) + ;; Create fake substituter data, to be read by `substitute-binary'. + (call-with-output-file (string-append dir "/nix-cache-info") + (lambda (p) + (format p "StoreDir: ~a\nWantMassQuery: 0\n" + (%store-prefix)))) + (call-with-output-file (string-append dir "/" (store-path-hash-part output) + ".narinfo") + (lambda (p) + (format p "StorePath: ~a +URL: ~a +Compression: none +NarSize: 1234 +References: +System: ~a +Deriver: ~a~%" + output ; StorePath + (string-append dir "/example.nar") ; URL + (%current-system) ; System + (basename drv-path)))) ; Deriver + + (let-values (((build download) + (derivation-prerequisites-to-build store drv)) + ((build* download*) + (derivation-prerequisites-to-build store drv + #:use-substitutes? #f))) + (pk build download build* download*) + (and (null? build) + (equal? download (list output)) + (null? download*) + (null? build*))))) + (test-assert "build-expression->derivation with expression returning #f" (let* ((builder '(begin (mkdir %output) -- cgit v1.2.3 From 6c1cd80d8fcba1c5cfbd872e714c0e5603c1a3e4 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Thu, 18 Apr 2013 15:22:40 +0000 Subject: tests: Use a new synopsis of GNU Hello. * tests/guix-package.sh: Use a new synopsis of GNU Hello, which was added in f50d2669e3e624365221cc81918ba55fdce94107. --- tests/guix-package.sh | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) (limited to 'tests') diff --git a/tests/guix-package.sh b/tests/guix-package.sh index f84893ba0b..7b101aa501 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -62,18 +62,19 @@ then # name and version string. installed="`guix package -p "$profile" --list-installed | cut -f1 | xargs echo | sort`" case "x$installed" in - "guile-bootstrap make-boot0") - true;; - "make-boot0 guile-bootstrap") - true;; - "*") + "guile-bootstrap make-boot0") + true;; + "make-boot0 guile-bootstrap") + true;; + "*") false;; esac test "`guix package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap" # Search. - test "`guix package -s "GNU Hello" | grep ^name:`" = "name: hello" + test "`guix package -s "An example GNU package" | grep ^name:`" = \ + "name: hello" test "`guix package -s "n0t4r341p4ck4g3"`" = "" # Remove a package. @@ -92,10 +93,10 @@ then # Move to the empty profile. for i in `seq 1 3` do - guix package --bootstrap --roll-back -p "$profile" - ! test -f "$profile/bin" - ! test -f "$profile/lib" - test "`readlink_base "$profile"`" = "$profile-0-link" + guix package --bootstrap --roll-back -p "$profile" + ! test -f "$profile/bin" + ! test -f "$profile/lib" + test "`readlink_base "$profile"`" = "$profile-0-link" done # Reinstall after roll-back to the empty profile. -- cgit v1.2.3 From d66c70967f9bd792acdd00036292dc0a7b858742 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 22 Apr 2013 23:07:13 +0200 Subject: packages: Add `package-field-location'. * guix/packages.scm (package-field-location): New procedure. * build-aux/sync-synopses.scm: Use it instead of `package-location'. * tests/packages.scm ("package-field-location"): New test. --- tests/packages.scm | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) (limited to 'tests') diff --git a/tests/packages.scm b/tests/packages.scm index c5d9d280ed..bf82aba858 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -52,6 +52,27 @@ (home-page #f) (license #f) extra-fields ...)) +(test-assert "package-field-location" + (let () + (define (goto port line column) + (unless (and (= (port-column port) (- column 1)) + (= (port-line port) (- line 1))) + (unless (eof-object? (get-char port)) + (goto port line column)))) + + (define read-at + (match-lambda + (($ file line column) + (call-with-input-file (search-path %load-path file) + (lambda (port) + (goto port line column) + (read port)))))) + + (and (equal? (read-at (package-field-location %bootstrap-guile 'name)) + (package-name %bootstrap-guile)) + (equal? (read-at (package-field-location %bootstrap-guile 'version)) + (package-version %bootstrap-guile))))) + (test-assert "package-transitive-inputs" (let* ((a (dummy-package "a")) (b (dummy-package "b" -- cgit v1.2.3 From f903dc056a5176033daca7a69d5b2c8376ff0677 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 24 Apr 2013 14:43:31 +0200 Subject: packages: Use `read' and source properties for `package-field-location'. * guix/packages.scm (package-field-location): Rewrite using `read' and source properties. Change to return #f upon failure. * tests/packages.scm ("package-field-location"): Check for #f upon failure. * build-aux/sync-synopses.scm: Adjust accordingly. --- tests/packages.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/packages.scm b/tests/packages.scm index bf82aba858..22985d6e9a 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -71,7 +71,8 @@ (and (equal? (read-at (package-field-location %bootstrap-guile 'name)) (package-name %bootstrap-guile)) (equal? (read-at (package-field-location %bootstrap-guile 'version)) - (package-version %bootstrap-guile))))) + (package-version %bootstrap-guile)) + (not (package-field-location %bootstrap-guile 'does-not-exist))))) (test-assert "package-transitive-inputs" (let* ((a (dummy-package "a")) -- cgit v1.2.3