From 16ac74033ae9f01e8be81c4f7f1857e13545bc2f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Nov 2019 23:06:49 +0100 Subject: tests: Test "guix build /gnu/store/….drv". MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/guix-build.sh: Add test for passing "guix build" a .drv. --- tests/guix-build.sh | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'tests') diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 52feda9d3a..62cdd5fe14 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -36,6 +36,12 @@ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' | \ guix build hello -d | \ grep -e '-hello-[0-9\.]\+\.drv$' +# Passing a .drv. +drv="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' -d`" +out="`guix build "$drv"`" +out2="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" +test "$out" = "$out2" + # Passing a URI. GUIX_DAEMON_SOCKET="file://$GUIX_STATE_DIRECTORY/daemon-socket/socket" \ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' -- cgit v1.2.3 From 9c9982dc0c8c38ce3821b154b7e92509c1564317 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 17 Nov 2019 23:10:34 +0100 Subject: guix build: Handle "guix build /….drv" correctly for non-existent derivations. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This lets the daemon substitute missing derivations, as in the example at , instead of failing with ENOENT. * guix/scripts/build.scm (options->things-to-build): In the 'derivation-path?' case, don't fail when 'read-derivation-from-file' raises to ENOENT; return the empty list in that case. (guix-build): Add non-existent '.drv' files to ITEMS. Pass ITEMS in addition to DRV to 'build-derivations'. * tests/guix-build.sh: Add test. --- guix/scripts/build.scm | 19 ++++++++++++++++--- tests/guix-build.sh | 7 +++++++ 2 files changed, 23 insertions(+), 3 deletions(-) (limited to 'tests') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 9ad7379bbe..ae78df9c5c 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -802,7 +802,15 @@ build---packages, gexps, derivations, and so on." (append-map (match-lambda (('argument . (? string? spec)) (cond ((derivation-path? spec) - (list (read-derivation-from-file spec))) + (catch 'system-error + (lambda () + (list (read-derivation-from-file spec))) + (lambda args + ;; Non-existent .drv files can be substituted down + ;; the road, so don't error out. + (if (= ENOENT (system-error-errno args)) + '() + (apply throw args))))) ((store-path? spec) ;; Nothing to do; maybe for --log-file. '()) @@ -934,7 +942,11 @@ needed." '()))) (items (filter-map (match-lambda (('argument . (? store-path? file)) - (and (not (derivation-path? file)) + ;; If FILE is a .drv that's not in + ;; store, keep it so that it can be + ;; substituted. + (and (or (not (derivation-path? file)) + (not (file-exists? file))) file)) (_ #f)) opts)) @@ -965,7 +977,8 @@ needed." (map (compose list derivation-file-name) drv) roots)) ((not (assoc-ref opts 'dry-run?)) - (and (build-derivations store drv mode) + (and (build-derivations store (append drv items) + mode) (for-each show-derivation-outputs drv) (for-each (cut register-root store <> <>) (map (lambda (drv) diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 62cdd5fe14..21b6af4395 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -42,6 +42,13 @@ out="`guix build "$drv"`" out2="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" test "$out" = "$out2" +# Passing the name of a .drv that doesn't exist. The daemon should try to +# substitute the .drv. Here we just look for the "cannot build missing +# derivation" error that indicates that the daemon did try to substitute the +# .drv. +guix build "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo.drv" 2>&1 \ + | grep "missing derivation" + # Passing a URI. GUIX_DAEMON_SOCKET="file://$GUIX_STATE_DIRECTORY/daemon-socket/socket" \ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' -- cgit v1.2.3 From a2e661e95f8ab2fcb7741198234395b367a794c1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Nov 2019 09:57:08 +0100 Subject: pack: Add "--derivation". * guix/scripts/pack.scm (%options, show-help): Add "--derivation". (guix-pack): Honor it. * tests/guix-pack.sh: Test it. * doc/guix.texi (Invoking guix pack): Document it. --- doc/guix.texi | 4 ++++ guix/scripts/pack.scm | 21 ++++++++++++++++----- tests/guix-pack.sh | 4 ++++ 3 files changed, 24 insertions(+), 5 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index ea8a8783d8..1f120b0501 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5253,6 +5253,10 @@ added to it or removed from it after extraction of the pack. One use case for this is the Guix self-contained binary tarball (@pxref{Binary Installation}). +@item --derivation +@itemx -d +Print the name of the derivation that builds the pack. + @item --bootstrap Use the bootstrap binaries to build the pack. This option is only useful to Guix developers. diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 920d6c01fe..89b3e389fc 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -800,6 +800,10 @@ last resort for relocation." (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (option '(#\d "derivation") #f #f + (lambda (opt name arg result) + (alist-cons 'derivation-only? #t result))) + (option '(#\f "format") #t #f (lambda (opt name arg result) (alist-cons 'format (string->symbol arg) result))) @@ -918,6 +922,8 @@ Create a bundle of PACKAGE.\n")) -r, --root=FILE make FILE a symlink to the result, and register it as a garbage collector root")) (display (G_ " + -d, --derivation return the derivation of the pack")) + (display (G_ " -v, --verbosity=LEVEL use the given verbosity LEVEL")) (display (G_ " --bootstrap use the bootstrap binaries to build the pack")) @@ -1002,6 +1008,7 @@ Create a bundle of PACKAGE.\n")) (assoc-ref opts 'system) #:graft? (assoc-ref opts 'graft?)))) (let* ((dry-run? (assoc-ref opts 'dry-run?)) + (derivation? (assoc-ref opts 'derivation-only?)) (relocatable? (assoc-ref opts 'relocatable?)) (proot? (eq? relocatable? 'proot)) (manifest (let ((manifest (manifest-from-args store opts))) @@ -1070,11 +1077,15 @@ Create a bundle of PACKAGE.\n")) #:archiver archiver))) (mbegin %store-monad - (show-what-to-build* (list drv) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? dry-run?) - (munless dry-run? + (munless derivation? + (show-what-to-build* (list drv) + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? dry-run?)) + (mwhen derivation? + (return (format #t "~a~%" + (derivation-file-name drv)))) + (munless (or derivation? dry-run?) (built-derivations (list drv)) (mwhen gc-root (register-root* (match (derivation->output-paths drv) diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index 0feae6d1e8..cf4e4ca4f9 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -36,6 +36,10 @@ export GUIX_BUILD_OPTIONS test_directory="`mktemp -d`" trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT +# Compute the derivation of a pack. +drv="`guix pack coreutils -d --no-grafts`" +guix gc -R "$drv" | grep "`guix build coreutils -d --no-grafts`" + # Build a tarball with no compression. guix pack --compression=none --bootstrap guile-bootstrap -- cgit v1.2.3 From d76df98fa59166c0c9f71ca41d664857d93e136d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Nov 2019 10:02:01 +0100 Subject: environment: Document that '--manifest' can be repeated. * tests/guix-environment.sh: Test 'guix environment' with two '-m' options. * doc/guix.texi (Invoking guix environment): Explain that '-m' can be passed multiple times. --- doc/guix.texi | 3 ++- tests/guix-environment.sh | 23 +++++++++++++++++++++++ 2 files changed, 25 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index 1fec43a228..0dc49c3cda 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4802,7 +4802,8 @@ As an example, @var{file} might contain a definition like this @item --manifest=@var{file} @itemx -m @var{file} Create an environment for the packages contained in the manifest object -returned by the Scheme code in @var{file}. +returned by the Scheme code in @var{file}. This option can be repeated +several times, in which case the manifests are concatenated. This is similar to the same-named option in @command{guix package} (@pxref{profile-manifest, @option{--manifest}}) and uses the same diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index fb1c1a022d..2faf38df06 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -84,6 +84,29 @@ echo "(use-modules (guix profiles) (gnu packages bootstrap)) guix environment --bootstrap --manifest=$tmpdir/manifest.scm --pure \ -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"' +# Make sure '--manifest' can be specified multiple times. +cat > "$tmpdir/manifest2.scm" <manifest + (list (package + (inherit %bootstrap-guile) + (name "eliug") + (build-system trivial-build-system) + (arguments + (quasiquote + (#:guile ,%bootstrap-guile + #:builder + (begin + (mkdir %output) + (mkdir (string-append %output "/eliug"))))))))) +EOF +guix environment --bootstrap -m "$tmpdir/manifest.scm" \ + -m "$tmpdir/manifest2.scm" --pure \ + -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile" && test -d "$GUIX_ENVIRONMENT/eliug"' + # Make sure '-r' works as expected. rm -f "$gcroot" expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \ -- cgit v1.2.3 From ce30a0eb7e21481815df379b4621aa48a13200bb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Nov 2019 12:07:02 +0100 Subject: profiles: Add 'concatenate-manifests'. * guix/profiles.scm (concatenate-manifests): New procedure. * tests/profiles.scm ("concatenate-manifests"): New test. --- guix/profiles.scm | 5 +++++ tests/profiles.scm | 5 +++++ 2 files changed, 10 insertions(+) (limited to 'tests') diff --git a/guix/profiles.scm b/guix/profiles.scm index cd3b21e390..f5e5cc33d6 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -92,6 +92,7 @@ manifest-pattern-version manifest-pattern-output + concatenate-manifests manifest-remove manifest-add manifest-lookup @@ -515,6 +516,10 @@ procedure is here for backward-compatibility and will eventually vanish." "Return the packages listed in MANIFEST." (sexp->manifest (read port))) +(define (concatenate-manifests lst) + "Concatenate the manifests listed in LST and return the resulting manifest." + (manifest (append-map manifest-entries lst))) + (define (entry-predicate pattern) "Return a procedure that returns #t when passed a manifest entry that matches NAME/OUTPUT/VERSION. OUTPUT and VERSION may be #f, in which case they diff --git a/tests/profiles.scm b/tests/profiles.scm index a4e28672b5..21c912a532 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -113,6 +113,11 @@ (manifest-matching-entries m (list p)) #f))) +(test-equal "concatenate-manifests" + (manifest (list guile-2.0.9 glibc)) + (concatenate-manifests (list (manifest (list guile-2.0.9)) + (manifest (list glibc))))) + (test-assert "manifest-remove" (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug))) (m1 (manifest-remove m0 -- cgit v1.2.3 From bf9206d8edb06cc4c62fe5559504cf1518c2de9e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Nov 2019 12:08:56 +0100 Subject: package: Allow multiple '--manifest' options. * guix/scripts/package.scm (manifest-action): Remove. (%actions): Remove it. (load-manifest): New procedure. (process-actions): Handle 'manifest' options. Define 'files' from 'manifest' options. Define 'manifest' based on FILES. Define 'trans' to represent the final transaction. * tests/guix-package.sh: Test it. * doc/guix.texi (Invoking guix package): Mention --- doc/guix.texi | 3 ++- guix/scripts/package.scm | 50 +++++++++++++++++++++++++----------------------- tests/guix-package.sh | 13 +++++++++++++ 3 files changed, 41 insertions(+), 25 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index 0dc49c3cda..7ef77015cc 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2830,7 +2830,8 @@ $ guix package --upgrade . --do-not-upgrade emacs @cindex profile declaration @cindex profile manifest Create a new generation of the profile from the manifest object -returned by the Scheme code in @var{file}. +returned by the Scheme code in @var{file}. This option can be repeated +several times, in which case the manifests are concatenated. This allows you to @emph{declare} the profile's contents rather than constructing it through a sequence of @code{--install} and similar diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index bcd03a1df9..eb578f7642 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -832,32 +832,17 @@ processed, #f otherwise." (unless dry-run? (delete-matching-generations store profile pattern))) -(define* (manifest-action store profile file opts - #:key dry-run?) - "Change PROFILE to contain the packages specified in FILE." - (let* ((user-module (make-user-module '((guix profiles) (gnu)))) - (manifest (load* file user-module)) - (bootstrap? (assoc-ref opts 'bootstrap?)) - (substitutes? (assoc-ref opts 'substitutes?)) - (allow-collisions? (assoc-ref opts 'allow-collisions?))) - (if dry-run? - (format #t (G_ "would install new manifest from '~a' with ~d entries~%") - file (length (manifest-entries manifest))) - (format #t (G_ "installing new manifest from '~a' with ~d entries~%") - file (length (manifest-entries manifest)))) - (build-and-use-profile store profile manifest - #:allow-collisions? allow-collisions? - #:bootstrap? bootstrap? - #:use-substitutes? substitutes? - #:dry-run? dry-run?))) +(define (load-manifest file) + "Load the user-profile manifest (Scheme code) from FILE and return it." + (let ((user-module (make-user-module '((guix profiles) (gnu))))) + (load* file user-module))) (define %actions ;; List of actions that may be processed. The car of each pair is the ;; action's symbol in the option list; the cdr is the action's procedure. `((roll-back? . ,roll-back-action) (switch-generation . ,switch-generation-action) - (delete-generations . ,delete-generations-action) - (manifest . ,manifest-action))) + (delete-generations . ,delete-generations-action))) (define (process-actions store opts) "Process any install/remove/upgrade action from OPTS." @@ -896,7 +881,13 @@ processed, #f otherwise." opts) ;; Then, process normal package removal/installation/upgrade. - (let* ((manifest (profile-manifest profile)) + (let* ((files (filter-map (match-lambda + (('manifest . file) file) + (_ #f)) + opts)) + (manifest (match files + (() (profile-manifest profile)) + (_ (concatenate-manifests (map load-manifest files))))) (step1 (options->removable opts manifest (manifest-transaction))) (step2 (options->installable opts manifest step1)) @@ -904,12 +895,23 @@ processed, #f otherwise." (inherit step2) (install (map transform-entry (manifest-transaction-install step2))))) - (new (manifest-perform-transaction manifest step3))) + (new (manifest-perform-transaction manifest step3)) + (trans (if (null? files) + step3 + (fold manifest-transaction-install-entry + step3 + (manifest-entries manifest))))) (warn-about-old-distro) - (unless (manifest-transaction-null? step3) - (show-manifest-transaction store manifest step3 + (unless (manifest-transaction-null? trans) + ;; When '--manifest' is used, display information about TRANS as if we + ;; were starting from an empty profile. + (show-manifest-transaction store + (if (null? files) + manifest + (make-manifest '())) + trans #:dry-run? dry-run?) (build-and-use-profile store profile new #:allow-collisions? allow-collisions? diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 7ad0699380..6d081d58be 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -394,6 +394,19 @@ guix package -I | grep guile test `guix package -I | wc -l` -eq 1 guix package --rollback --bootstrap +# Applying two manifests. +cat > "$module_dir/manifest2.scm"<manifest (list p)) +EOF +guix package --bootstrap \ + -m "$module_dir/manifest.scm" -m "$module_dir/manifest2.scm" +guix package -I | grep guile +guix package -I | grep eliug +test `guix package -I | wc -l` -eq 2 +guix package --rollback --bootstrap + # Applying a manifest file with inferior packages. cat > "$module_dir/manifest.scm"< Date: Wed, 20 Nov 2019 12:13:32 +0100 Subject: pack: Allow multiple '--manifest' options. * guix/scripts/pack.scm (guix-pack): Collect 'manifest' options, and concatenate the resulting manifests. * tests/guix-pack.sh: Test it. * doc/guix.texi (Invoking guix pack): Document it. --- doc/guix.texi | 3 ++- guix/scripts/pack.scm | 17 ++++++++++++----- tests/guix-pack.sh | 11 +++++++++++ 3 files changed, 25 insertions(+), 6 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index 7ef77015cc..7a004d2ee4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5178,7 +5178,8 @@ build} (@pxref{Additional Build Options, @code{--expression} in @item --manifest=@var{file} @itemx -m @var{file} Use the packages contained in the manifest object returned by the Scheme -code in @var{file}. +code in @var{file}. This option can be repeated several times, in which +case the manifests are concatenated. This has a similar purpose as the same-named option in @command{guix package} (@pxref{profile-manifest, @option{--manifest}}) and uses the diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 89b3e389fc..c8a52374bd 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -965,7 +965,10 @@ Create a bundle of PACKAGE.\n")) (list (transform store package) "out"))) (reverse (filter-map maybe-package-argument opts)))) - (manifest-file (assoc-ref opts 'manifest))) + (manifests (filter-map (match-lambda + (('manifest . file) file) + (_ #f)) + opts))) (define properties (if (assoc-ref opts 'save-provenance?) (lambda (package) @@ -979,11 +982,15 @@ Create a bundle of PACKAGE.\n")) (const '()))) (cond - ((and manifest-file (not (null? packages))) + ((and (not (null? manifests)) (not (null? packages))) (leave (G_ "both a manifest and a package list were given~%"))) - (manifest-file - (let ((user-module (make-user-module '((guix profiles) (gnu))))) - (load* manifest-file user-module))) + ((not (null? manifests)) + (concatenate-manifests + (map (lambda (file) + (let ((user-module (make-user-module + '((guix profiles) (gnu))))) + (load* file user-module))) + manifests))) (else (manifest (map (match-lambda diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index cf4e4ca4f9..7a0f3400c3 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -109,3 +109,14 @@ drv1="`guix pack -n guile 2>&1 | grep pack.*\.drv`" drv2="`guix pack -n --with-source=guile=$test_directory guile 2>&1 | grep pack.*\.drv`" test -n "$drv1" test "$drv1" != "$drv2" + +# Try '--manifest' options. +cat > "$test_directory/manifest1.scm" <manifest '("guile")) +EOF +cat > "$test_directory/manifest2.scm" <manifest '("emacs")) +EOF +drv="`guix pack -nd -m "$test_directory/manifest1.scm" -m "$test_directory/manifest2.scm"`" +guix gc -R "$drv" | grep `guix build guile -nd` +guix gc -R "$drv" | grep `guix build emacs -nd` -- cgit v1.2.3 From fde60bfb84dbfab7668cacd4a0d206d77affc789 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 23 Nov 2019 22:27:28 +0100 Subject: tests: Use (ice-9 threads). 'call-with-new-thread' as a core binding is deprecated in 2.2 and removed in 3.0. * tests/publish.scm: Use (ice-9 threads). --- tests/publish.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'tests') diff --git a/tests/publish.scm b/tests/publish.scm index 64a8ff3cae..204cfb4974 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -45,6 +45,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) + #:use-module (ice-9 threads) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 rdelim)) -- cgit v1.2.3 From 1d64afbdc0644a2be8bd2ad157085731e212ab74 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 24 Nov 2019 20:47:20 +0100 Subject: tests: Avoid (catch 'srfi-34 …) form. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/build-utils.scm ("wrap-script, raises condition"): Use 'guard' instead of "catch 'srfi-34". --- tests/build-utils.scm | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) (limited to 'tests') diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 61e6c44e63..ec442c267b 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -235,13 +235,11 @@ print('hello world')")) (lambda (port) (format port "This is not a script"))) (chmod script-file-name #o777) - (catch 'srfi-34 - (lambda () - (wrap-script script-file-name - #:guile "MYGUILE" - `("GUIX_FOO" prefix ("/some/path" - "/some/other/path")))) - (lambda (type obj) - (wrap-error? obj))))))) + (guard (c ((wrap-error? c) #t)) + (wrap-script script-file-name + #:guile "MYGUILE" + `("GUIX_FOO" prefix ("/some/path" + "/some/other/path"))) + #f))))) (test-end) -- cgit v1.2.3 From f5698dfb87df1132ca5c73a8ed7f75f63c07669f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 24 Nov 2019 20:48:11 +0100 Subject: tests: Avoid unnecessary use of 'mock'. * tests/build-utils.scm ("wrap-script, simple case"): Use the real 'which' instead of mocking it. --- tests/build-utils.scm | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'tests') diff --git a/tests/build-utils.scm b/tests/build-utils.scm index ec442c267b..47a57a984b 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -151,11 +151,12 @@ echo hello world")) (test-equal "wrap-script, simple case" (string-append (format #f "\ -#!GUILE --no-auto-compile +#!~a --no-auto-compile #!#; Guix wrapper #\\-~s #\\-~s " + (which "guile") '(begin (let ((current (getenv "GUIX_FOO"))) (setenv "GUIX_FOO" (if current @@ -175,11 +176,9 @@ echo hello world")) (lambda (port) (format port script-contents))) (chmod script-file-name #o777) - - (mock ((guix build utils) which (const "GUILE")) - (wrap-script script-file-name - `("GUIX_FOO" prefix ("/some/path" - "/some/other/path")))) + (wrap-script script-file-name + `("GUIX_FOO" prefix ("/some/path" + "/some/other/path"))) (let ((str (call-with-input-file script-file-name get-string-all))) (with-directory-excursion directory (delete-file "foo")) -- cgit v1.2.3 From 434138e2f26b28bb5cc83e62327aae8ed0902475 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 26 Nov 2019 12:30:45 +0100 Subject: substitute: Make '%allow-unauthenticated-substitutes?' public. * guix/scripts/substitute.scm (warn-about-missing-authentication): New procedure. (%allow-unauthenticated-substitutes?): Turn into a public parameter and use 'warn-about-missing-authentication'. (valid-narinfo?): Adjust accordingly. * tests/substitute.scm (call-with-narinfo): Likewise. --- guix/scripts/substitute.scm | 22 +++++++++++++++------- tests/substitute.scm | 6 ++---- 2 files changed, 17 insertions(+), 11 deletions(-) (limited to 'tests') diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 992b21d505..ba2fb291d8 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -86,6 +86,8 @@ read-narinfo write-narinfo + %allow-unauthenticated-substitutes? + substitute-urls guix-substitute)) @@ -118,15 +120,21 @@ (string-append %state-directory "/substitute/cache")) (string-append (cache-directory #:ensure? #f) "/substitute"))) +(define (warn-about-missing-authentication) + (warning (G_ "authentication and authorization of substitutes \ +disabled!~%")) + #t) + (define %allow-unauthenticated-substitutes? ;; Whether to allow unchecked substitutes. This is useful for testing ;; purposes, and should be avoided otherwise. - (and (and=> (getenv "GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES") - (cut string-ci=? <> "yes")) - (begin - (warning (G_ "authentication and authorization of substitutes \ -disabled!~%")) - #t))) + (make-parameter + (and=> (getenv "GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES") + (cut string-ci=? <> "yes")) + (lambda (value) + (when value + (warn-about-missing-authentication)) + value))) (define %narinfo-ttl ;; Number of seconds during which cached narinfo lookups are considered @@ -370,7 +378,7 @@ No authentication and authorization checks are performed here!" (define* (valid-narinfo? narinfo #:optional (acl (current-acl)) #:key verbose?) "Return #t if NARINFO's signature is not valid." - (or %allow-unauthenticated-substitutes? + (or (%allow-unauthenticated-substitutes?) (let ((hash (narinfo-sha256 narinfo)) (signature (narinfo-signature narinfo)) (uri (uri->string (first (narinfo-uris narinfo))))) diff --git a/tests/substitute.scm b/tests/substitute.scm index ff2be662be..a4246aff82 100644 --- a/tests/substitute.scm +++ b/tests/substitute.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Nikita Karetnikov -;;; Copyright © 2014, 2015, 2017, 2018 Ludovic Courtès +;;; Copyright © 2014, 2015, 2017, 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -169,9 +169,7 @@ a file for NARINFO." (cute write-file (string-append narinfo-directory "/example.out") <>)) - (set! (@@ (guix scripts substitute) - %allow-unauthenticated-substitutes?) - #f)) + (%allow-unauthenticated-substitutes? #f)) thunk (lambda () (when (file-exists? cache-directory) -- cgit v1.2.3 From dac7928d502d9ba4fc6a9621e5b2b15019d92d5b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 29 Nov 2019 15:31:04 +0100 Subject: tests: Fix race condition in profile locking test. Previously, there was a possibility that "guix install emacs" would grab the lock before "guix package -m $module_dir/manifest.scm". When that happened, the test would start building Emacs and all its dependencies, which could take a while and some disk space. This is a followup to b1fb663404894268b5ee92c040f12c52c0bee425. * tests/guix-package.sh: In profile locking test, emit "$module_dir/ready" from the manifest and wait for it to exist before running "guix install emacs". --- tests/guix-package.sh | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 6d081d58be..f9fb31033e 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -468,8 +468,10 @@ guix package --list-profiles | grep '\.guix-profile' # Make sure we can properly lock a profile. mkdir "$module_dir" -echo '(sleep 60)' > "$module_dir/manifest.scm" +echo "(open-output-file \"$module_dir/ready\") (sleep 60)" \ + > "$module_dir/manifest.scm" guix package -m "$module_dir/manifest.scm" -p "$module_dir/profile" & pid=$! +while [ ! -f "$module_dir/ready" ] ; do sleep 0.5 ; done if guix install emacs -p "$module_dir/profile"; then kill $pid; false; else true; fi kill $pid -- cgit v1.2.3 From 99c45877a984dd0148151b2e304afef6fb04f1a5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 30 Nov 2019 17:17:00 +0100 Subject: gexp: 'local-file' properly resolves non-literal relative file names. * guix/gexp.scm (local-file): Distinguish the case where FILE is a literal string and when it's not. Add a clause for when FILE is not a literal string. * tests/gexp.scm ("local-file, non-literal relative file name"): New test. * doc/guix.texi (G-Expressions): Update accordingly. --- doc/guix.texi | 11 +++++++---- guix/gexp.scm | 7 +++++++ tests/gexp.scm | 8 ++++++++ 3 files changed, 22 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index d188f06a43..661aa41785 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7684,10 +7684,13 @@ content is directly passed as a string. @deffn {Scheme Procedure} local-file @var{file} [@var{name}] @ [#:recursive? #f] [#:select? (const #t)] -Return an object representing local file @var{file} to add to the store; this -object can be used in a gexp. If @var{file} is a relative file name, it is looked -up relative to the source file where this form appears. @var{file} will be added to -the store under @var{name}--by default the base name of @var{file}. +Return an object representing local file @var{file} to add to the store; +this object can be used in a gexp. If @var{file} is a literal string +denoting a relative file name, it is looked up relative to the source +file where it appears; if @var{file} is not a literal string, it is +looked up relative to the current working directory at run time. +@var{file} will be added to the store under @var{name}--by default the +base name of @var{file}. When @var{recursive?} is true, the contents of @var{file} are added recursively; if @var{file} designates a flat file and @var{recursive?} is true, its contents are added, and its diff --git a/guix/gexp.scm b/guix/gexp.scm index b640c079e4..a96592ac76 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -320,9 +320,16 @@ It is implemented as a macro to capture the current source directory where it appears." (syntax-case s () ((_ file rest ...) + (string? (syntax->datum #'file)) + ;; FILE is a literal, so resolve it relative to the source directory. #'(%local-file file (delay (absolute-file-name file (current-source-directory))) rest ...)) + ((_ file rest ...) + ;; Resolve FILE relative to the current directory. + #'(%local-file file + (delay (absolute-file-name file (getcwd))) + rest ...)) ((_) #'(syntax-error "missing file name")) (id diff --git a/tests/gexp.scm b/tests/gexp.scm index 50d0948659..84c16422c2 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -170,6 +170,14 @@ (let ((file (local-file "../guix/base32.scm"))) (local-file-absolute-file-name file))))) +(test-equal "local-file, non-literal relative file name" + (canonicalize-path (search-path %load-path "guix/base32.scm")) + (let ((directory (dirname (search-path %load-path + "guix/build-system/gnu.scm")))) + (with-directory-excursion directory + (let ((file (local-file (string-copy "../base32.scm")))) + (local-file-absolute-file-name file))))) + (test-assertm "local-file, #:select?" (mlet* %store-monad ((select? -> (lambda (file stat) (member (basename file) -- cgit v1.2.3 From 2c5dd47ceffd61d155e64dcb1764ffaea0ffd546 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Tue, 26 Nov 2019 08:31:43 +0100 Subject: tests: lzlib: Do not fail if lzlib in not available. * tests/lzlib.scm: Use test-assert* for all test cases, so that there are no failures if lzlib is unavailable. --- tests/lzlib.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/lzlib.scm b/tests/lzlib.scm index 543622bb45..d8d0e6edf8 100644 --- a/tests/lzlib.scm +++ b/tests/lzlib.scm @@ -108,7 +108,7 @@ (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)" (compress-and-decompress (random-bytevector (1+ (* 1024 1024))))) -(test-assert "make-lzip-input-port/compressed" +(test-assert* "make-lzip-input-port/compressed" (let* ((len (pk 'len (+ 10 (random 4000 %seed)))) (data (random-bytevector len)) (compressed (make-lzip-input-port/compressed -- cgit v1.2.3