From eddd4077a5292052d95443078ee4db9f34f2f0e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 12 Nov 2013 00:10:10 +0100 Subject: store: Add 'log-file' procedure. * guix/store.scm (log-file): New procedure. * tests/store.scm ("log-file, derivation", "log-file, output file name"): New tests. --- tests/store.scm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) (limited to 'tests') diff --git a/tests/store.scm b/tests/store.scm index b5e0cb0eab..430027c33b 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -140,6 +140,33 @@ (equal? (valid-derivers %store o) (list (derivation-file-name d)))))) +(test-assert "log-file, derivation" + (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) + (s (add-to-store %store "bash" #t "sha256" + (search-bootstrap-binary "bash" + (%current-system)))) + (d (derivation %store "the-thing" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text))) + #:inputs `((,b) (,s))))) + (and (build-derivations %store (list d)) + (file-exists? (pk (log-file %store (derivation-file-name d))))))) + +(test-assert "log-file, output file name" + (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) + (s (add-to-store %store "bash" #t "sha256" + (search-bootstrap-binary "bash" + (%current-system)))) + (d (derivation %store "the-thing" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text))) + #:inputs `((,b) (,s)))) + (o (derivation->output-path d))) + (and (build-derivations %store (list d)) + (file-exists? (pk (log-file %store o))) + (string=? (log-file %store (derivation-file-name d)) + (log-file %store o))))) + (test-assert "no substitutes" (let* ((s (open-connection)) (d1 (package-derivation s %bootstrap-guile (%current-system))) -- cgit v1.2.3 From bf4211523baf8ab1c853aac48ef0324f8f704510 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 12 Nov 2013 01:06:25 +0100 Subject: guix build: Add '--log-file'. * guix/scripts/build.scm (show-help): Add '--log-file'. (%options): Likewise. (guix-build): Set %FILE-PORT-NAME-CANONICALIZATION. Honor '--log-file'. * tests/guix-build.sh: Add '--log-file' tests. * doc/guix.texi (Invoking guix build): Document '--log-file'. --- tests/guix-build.sh | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'tests') diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 83de9f5285..e228b38616 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -36,6 +36,17 @@ guix build -e '(@@ (gnu packages base) %bootstrap-guile)' | \ guix build hello -d | \ grep -e '-hello-[0-9\.]\+\.drv$' +# Should all return valid log files. +drv="`guix build -d -e '(@@ (gnu packages base) %bootstrap-guile)'`" +out="`guix build -e '(@@ (gnu packages base) %bootstrap-guile)'`" +log="`guix build --log-file $drv`" +echo "$log" | grep log/.*guile.*drv +test -f "$log" +test "`guix build -e '(@@ (gnu packages base) %bootstrap-guile)' --log-file`" \ + = "$log" +test "`guix build --log-file guile-bootstrap`" = "$log" +test "`guix build --log-file $out`" = "$log" + # Should fail because the name/version combination could not be found. if guix build hello-0.0.1 -n; then false; else true; fi -- cgit v1.2.3 From 56b943de6e61f41d6ebd2dfa65ff886cdfd83759 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 12 Nov 2013 22:56:13 +0100 Subject: utils: Add 'string-replace-substring'. * guix/utils.scm (string-replace-substring): New procedure. Based on code by Mark H. Weaver. * tests/utils.scm ("string-replace-substring"): New test. --- tests/utils.scm | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'tests') diff --git a/tests/utils.scm b/tests/utils.scm index 4f6ecc514d..017d9170fa 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -82,6 +82,14 @@ (string-tokenize* "foo!bar!" "!") (string-tokenize* "foo+-+bar+-+baz" "+-+"))) +(test-equal "string-replace-substring" + '("foo BAR! baz" + "/gnu/store/chbouib" + "") + (list (string-replace-substring "foo bar baz" "bar" "BAR!") + (string-replace-substring "/nix/store/chbouib" "/nix/" "/gnu/") + (string-replace-substring "" "foo" "bar"))) + (test-equal "fold2, 1 list" (list (reverse (iota 5)) (map - (reverse (iota 5)))) -- cgit v1.2.3 From e387ab7c10b18427b97cd22526f1b135856a083e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 13 Nov 2013 00:25:57 +0100 Subject: derivations: Add 'map-derivation'. * guix/derivations.scm (map-derivation): New procedure. * tests/derivations.scm ("map-derivation"): New test. --- tests/derivations.scm | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) (limited to 'tests') diff --git a/tests/derivations.scm b/tests/derivations.scm index 273db22765..09cf81972c 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -26,6 +26,7 @@ #:use-module ((guix packages) #:select (package-derivation)) #:use-module ((gnu packages) #:select (search-bootstrap-binary)) #:use-module (gnu packages bootstrap) + #:use-module ((gnu packages guile) #:select (guile-1.8)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -690,6 +691,35 @@ Deriver: ~a~%" ((p2 . _) (stringderivation %store "original-drv1" + (%current-system) + #f ; systematically fail + '() + #:guile-for-build joke)) + (drv2 (build-expression->derivation %store "original-drv2" + (%current-system) + '(call-with-output-file %output + (lambda (p) + (display "hello" p))) + '())) + (drv3 (build-expression->derivation %store "drv-to-remap" + (%current-system) + '(let ((in (assoc-ref + %build-inputs "in"))) + (copy-file in %output)) + `(("in" ,drv1)) + #:guile-for-build joke)) + (drv4 (map-derivation %store drv3 `((,drv1 . ,drv2) + (,joke . ,good)))) + (out (derivation->output-path drv4))) + (and (build-derivations %store (list (pk 'remapped drv4))) + (call-with-input-file out get-string-all)))) + (test-end) -- cgit v1.2.3 From 9336e5b5e7b05e636b147aba2c97357620711c2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 12 Nov 2013 23:36:29 +0100 Subject: store: Make 'direct-store-path?' public. * guix/store.scm (direct-store-path?): New procedure. * guix/derivations.scm (derivation)[direct-store-path?]: Remove. * tests/store.scm ("direct-store-path?"): New test. --- tests/store.scm | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'tests') diff --git a/tests/store.scm b/tests/store.scm index 430027c33b..741803884d 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -65,6 +65,15 @@ (string-append (%store-prefix) "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) +(test-assert "direct-store-path?" + (and (direct-store-path? + (string-append (%store-prefix) + "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")) + (not (direct-store-path? + (string-append + (%store-prefix) + "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile"))))) + (test-skip (if %store 0 10)) (test-assert "dead-paths" -- cgit v1.2.3 From f80594cc41d7ad491f14a73d594228bacafdc871 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 12 Nov 2013 23:44:47 +0100 Subject: packages: Suitably cope with indirect store paths as package sources. * guix/packages.scm (package-source-derivation): Don't let indirect store paths pass through. * tests/packages.scm ("package-source-derivation, indirect store path"): New test. --- tests/packages.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'tests') diff --git a/tests/packages.scm b/tests/packages.scm index 7c5dd9f4e1..b499c380ce 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -122,6 +122,17 @@ (package-source package)))) (string=? file source))) +(test-assert "package-source-derivation, indirect store path" + (let* ((dir (add-to-store %store "guix-build" #t "sha256" + (dirname (search-path %load-path + "guix/build/utils.scm")))) + (package (package (inherit (dummy-package "p")) + (source (string-append dir "/utils.scm")))) + (source (package-source-derivation %store + (package-source package)))) + (and (direct-store-path? source) + (string-suffix? "utils.scm" source)))) + (test-equal "package-source-derivation, snippet" "OK" (let* ((file (search-bootstrap-binary "guile-2.0.7.tar.xz" -- cgit v1.2.3 From a716e36de915a275e4eab42b73cf0a2affc4aa33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 13 Nov 2013 11:22:07 +0100 Subject: derivations: Allow 'map-derivations' to replace sources. * guix/derivations.scm (map-derivation)[input->output-paths]: Allow non-derivation inputs. Allow replacements to be store files. Replace in SOURCES too. * tests/derivations.scm ("map-derivation, sources"): New test. --- tests/derivations.scm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) (limited to 'tests') diff --git a/tests/derivations.scm b/tests/derivations.scm index 09cf81972c..a4e073bf07 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -720,6 +720,28 @@ Deriver: ~a~%" (and (build-derivations %store (list (pk 'remapped drv4))) (call-with-input-file out get-string-all)))) +(test-equal "map-derivation, sources" + "hello" + (let* ((script1 (add-text-to-store %store "fail.sh" "exit 1")) + (script2 (add-text-to-store %store "hi.sh" "echo -n hello > $out")) + (bash-full (package-derivation %store (@ (gnu packages bash) bash))) + (drv1 (derivation %store "drv-to-remap" + + ;; XXX: This wouldn't work in practice, but if + ;; we append "/bin/bash" then we can't replace + ;; it with the bootstrap bash, which is a + ;; single file. + (derivation->output-path bash-full) + + `("-e" ,script1) + #:inputs `((,bash-full) (,script1)))) + (drv2 (map-derivation %store drv1 + `((,bash-full . ,%bash) + (,script1 . ,script2)))) + (out (derivation->output-path drv2))) + (and (build-derivations %store (list (pk 'remapped* drv2))) + (call-with-input-file out get-string-all)))) + (test-end) -- cgit v1.2.3 From ac5de156ae5de8cb61870469863fb862b6a1205e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 18 Nov 2013 23:08:20 +0100 Subject: guix build: '-e' can be passed a monadic thunk. * guix/ui.scm (read/eval): New procedure. (read/eval-package-expression): Use it. * guix/scripts/build.scm (derivations-from-package-expressions): Rename to... (derivation-from-expression): ... this. Accept procedures, under the assumption that they are monadic thunk. (show-help): Adjust accordingly. (guix-build): Ditto. * tests/guix-build.sh: Add test. * doc/guix.texi (Invoking guix build): Augment description of '-e'. --- tests/guix-build.sh | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'tests') diff --git a/tests/guix-build.sh b/tests/guix-build.sh index e228b38616..391e7b9da3 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -72,3 +72,11 @@ if guix build -n time-3.2; # FAIL, version not found then false; else true; fi if guix build -n something-that-will-never-exist; # FAIL then false; else true; fi + +# Invoking a monadic procedure. +guix build -e "(begin + (use-modules (guix monads) (guix utils)) + (lambda () + (derivation-expression \"test\" (%current-system) + '(mkdir %output) '())))" \ + --dry-run -- cgit v1.2.3 From 0b8749b7bdd68c9b28cf3d520b9a3a9cc1a5bddb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 18 Nov 2013 23:56:07 +0100 Subject: packages: 'package-field-location' returns a relative file name. * guix/packages.scm (package-field-location): Set %FILE-PORT-NAME-CANONICALIZATION. * tests/packages.scm ("package-field-location, relative file name"): New test. --- tests/packages.scm | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'tests') diff --git a/tests/packages.scm b/tests/packages.scm index b499c380ce..7de3fc2156 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -81,6 +81,12 @@ (list version `(version ,version)))) (not (package-field-location %bootstrap-guile 'does-not-exist))))) +;; Make sure we don't change the file name to an absolute file name. +(test-equal "package-field-location, relative file name" + (location-file (package-location %bootstrap-guile)) + (with-fluids ((%file-port-name-canonicalization 'absolute)) + (location-file (package-field-location %bootstrap-guile 'version)))) + (test-assert "package-transitive-inputs" (let* ((a (dummy-package "a")) (b (dummy-package "b" -- cgit v1.2.3