From c1cd155aa8afa17e60491c85e8f226f99257d395 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 22 Mar 2018 12:51:23 +0100 Subject: publish: Add test for non-GET queries. * tests/publish.scm ("non-GET query"): New test. --- tests/publish.scm | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'tests') diff --git a/tests/publish.scm b/tests/publish.scm index 8c88a8c93d..a4a52a4efe 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -483,4 +483,12 @@ FileSize: ~a~%" (let ((uri (publish-uri "/log/does-not-exist"))) (response-code (http-get uri)))) +(test-equal "non-GET query" + '(200 404) + (let ((path (string-append "/" (store-path-hash-part %item) + ".narinfo"))) + (map response-code + (list (http-get (publish-uri path)) + (http-post (publish-uri path)))))) + (test-end "publish") -- cgit v1.2.3 From 04d2a16c4ffd2f3ddfbaf3848093424228e7d918 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 22 Mar 2018 12:54:31 +0100 Subject: publish: Always build a new derivation for the "/log/NAME" test. Fixes . Reported by Martin Castillo . * tests/publish.scm ("/log/NAME"): Use #$(random-text) in the builder. --- tests/publish.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/publish.scm b/tests/publish.scm index a4a52a4efe..1ed8308076 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -464,7 +464,7 @@ FileSize: ~a~%" (lambda (port) (display "Hello, build log!" (current-error-port)) - (display "" port))))))) + (display #$(random-text) port))))))) (build-derivations %store (list drv)) (let* ((response (http-get (publish-uri (string-append "/log/" -- cgit v1.2.3 From 1ae16033f34cebe802023922436883867010850f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 23 Mar 2018 18:21:28 +0100 Subject: gexp: 'gexp->script' and 'gexp->file' have a new #:module-path parameter. * guix/gexp.scm (load-path-expression): Add 'path' optional parameter. (gexp->script): Add #:module-path and honor it. (gexp->file): Likewise. * tests/gexp.scm ("gexp->script #:module-path"): New test. * doc/guix.texi (G-Expressions): Update accordingly. --- doc/guix.texi | 10 +++++++--- guix/gexp.scm | 35 +++++++++++++++++++++++------------ tests/gexp.scm | 34 +++++++++++++++++++++++++++++++++- 3 files changed, 63 insertions(+), 16 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index 7617d7fe16..b765bcd112 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5150,9 +5150,11 @@ is a list of additional arguments to pass to @code{gexp->derivation}. This is the declarative counterpart of @code{gexp->derivation}. @end deffn -@deffn {Monadic Procedure} gexp->script @var{name} @var{exp} +@deffn {Monadic Procedure} gexp->script @var{name} @var{exp} @ + [#:guile (default-guile)] [#:module-path %load-path] Return an executable script @var{name} that runs @var{exp} using @var{guile}, with @var{exp}'s imported modules in its search path. +Look up @var{exp}'s modules in @var{module-path}. The example below builds a script that simply invokes the @command{ls} command: @@ -5186,11 +5188,13 @@ This is the declarative counterpart of @code{gexp->script}. @end deffn @deffn {Monadic Procedure} gexp->file @var{name} @var{exp} @ - [#:set-load-path? #t] + [#:set-load-path? #t] [#:module-path %load-path] @ + [#:guile (default-guile)] Return a derivation that builds a file @var{name} containing @var{exp}. When @var{set-load-path?} is true, emit code in the resulting file to set @code{%load-path} and @code{%load-compiled-path} to honor -@var{exp}'s imported modules. +@var{exp}'s imported modules. Look up @var{exp}'s modules in +@var{module-path}. The resulting file holds references to all the dependencies of @var{exp} or a subset thereof. diff --git a/guix/gexp.scm b/guix/gexp.scm index 8dea022e04..4a2e5a682e 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; ;;; This file is part of GNU Guix. @@ -1116,11 +1116,14 @@ they can refer to each other." (module-ref (resolve-interface '(gnu packages guile)) 'guile-2.2)) -(define (load-path-expression modules) +(define* (load-path-expression modules #:optional (path %load-path)) "Return as a monadic value a gexp that sets '%load-path' and -'%load-compiled-path' to point to MODULES, a list of module names." - (mlet %store-monad ((modules (imported-modules modules)) - (compiled (compiled-modules modules))) +'%load-compiled-path' to point to MODULES, a list of module names. MODULES +are searched for in PATH." + (mlet %store-monad ((modules (imported-modules modules + #:module-path path)) + (compiled (compiled-modules modules + #:module-path path))) (return (gexp (eval-when (expand load eval) (set! %load-path (cons (ungexp modules) %load-path)) @@ -1129,11 +1132,13 @@ they can refer to each other." %load-compiled-path))))))) (define* (gexp->script name exp - #:key (guile (default-guile))) + #:key (guile (default-guile)) + (module-path %load-path)) "Return an executable script NAME that runs EXP using GUILE, with EXP's -imported modules in its search path." +imported modules in its search path. Look up EXP's modules in MODULE-PATH." (mlet %store-monad ((set-load-path - (load-path-expression (gexp-modules exp)))) + (load-path-expression (gexp-modules exp) + module-path))) (gexp->derivation name (gexp (call-with-output-file (ungexp output) @@ -1148,12 +1153,16 @@ imported modules in its search path." (write '(ungexp set-load-path) port) (write '(ungexp exp) port) - (chmod port #o555))))))) + (chmod port #o555)))) + #:module-path module-path))) -(define* (gexp->file name exp #:key (set-load-path? #t)) +(define* (gexp->file name exp #:key + (set-load-path? #t) + (module-path %load-path)) "Return a derivation that builds a file NAME containing EXP. When SET-LOAD-PATH? is true, emit code in the resulting file to set '%load-path' -and '%load-compiled-path' to honor EXP's imported modules." +and '%load-compiled-path' to honor EXP's imported modules. Lookup EXP's +modules in MODULE-PATH." (match (if set-load-path? (gexp-modules exp) '()) (() ;zero modules (gexp->derivation name @@ -1164,13 +1173,15 @@ and '%load-compiled-path' to honor EXP's imported modules." #:local-build? #t #:substitutable? #f)) ((modules ...) - (mlet %store-monad ((set-load-path (load-path-expression modules))) + (mlet %store-monad ((set-load-path (load-path-expression modules + module-path))) (gexp->derivation name (gexp (call-with-output-file (ungexp output) (lambda (port) (write '(ungexp set-load-path) port) (write '(ungexp exp) port)))) + #:module-path module-path #:local-build? #t #:substitutable? #f))))) diff --git a/tests/gexp.scm b/tests/gexp.scm index 5873abdd41..a0198b13a0 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +25,7 @@ #:use-module (guix packages) #:use-module (guix tests) #:use-module ((guix build utils) #:select (with-directory-excursion)) + #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages bootstrap) @@ -853,6 +854,37 @@ (return (and (zero? (close-pipe pipe)) (= (expt n 2) (string->number str))))))) +(test-assertm "gexp->script #:module-path" + (call-with-temporary-directory + (lambda (directory) + (define str + "Fake (guix base32) module!") + + (mkdir (string-append directory "/guix")) + (call-with-output-file (string-append directory "/guix/base32.scm") + (lambda (port) + (write `(begin (define-module (guix base32)) + (define-public %fake! ,str)) + port))) + + (mlet* %store-monad ((exp -> (with-imported-modules '((guix base32)) + (gexp (begin + (use-modules (guix base32)) + (write (list %load-path + %fake!)))))) + (drv (gexp->script "guile-thing" exp + #:guile %bootstrap-guile + #:module-path (list directory))) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv)))) + (let* ((pipe (open-input-pipe out)) + (data (read pipe))) + (return (and (zero? (close-pipe pipe)) + (match data + ((load-path str*) + (and (string=? str* str) + (not (member directory load-path)))))))))))) + (test-assertm "program-file" (let* ((n (random (expt 2 50))) (exp (with-imported-modules '((guix build utils)) -- cgit v1.2.3 From 427ec19e8887b8036690734564a86496000e12a6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 23 Mar 2018 18:35:32 +0100 Subject: gexp: 'program-file' has a new #:module-path parameter. * guix/gexp.scm (): Add 'path' field. (program-file): Add #:module-path parameter and honor it. (program-file-compiler): Honor the 'path' field. * tests/gexp.scm ("program-file #:module-path"): New test. * doc/guix.texi (G-Expressions): Update. --- doc/guix.texi | 4 ++-- guix/gexp.scm | 16 ++++++++++------ tests/gexp.scm | 27 +++++++++++++++++++++++++++ 3 files changed, 39 insertions(+), 8 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index b765bcd112..7304d589d4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5179,10 +5179,10 @@ executable file @file{/gnu/store/@dots{}-list-files} along these lines: @end deffn @deffn {Scheme Procedure} program-file @var{name} @var{exp} @ - [#:guile #f] + [#:guile #f] [#:module-path %load-path] Return an object representing the executable store item @var{name} that runs @var{gexp}. @var{guile} is the Guile package used to execute that -script. +script. Imported modules of @var{gexp} are looked up in @var{module-path}. This is the declarative counterpart of @code{gexp->script}. @end deffn diff --git a/guix/gexp.scm b/guix/gexp.scm index 4a2e5a682e..b47965d9eb 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -60,6 +60,7 @@ program-file-name program-file-gexp program-file-guile + program-file-module-path scheme-file scheme-file? @@ -380,25 +381,28 @@ This is the declarative counterpart of 'gexp->derivation'." (apply gexp->derivation name gexp options))))) (define-record-type - (%program-file name gexp guile) + (%program-file name gexp guile path) program-file? (name program-file-name) ;string (gexp program-file-gexp) ;gexp - (guile program-file-guile)) ;package + (guile program-file-guile) ;package + (path program-file-module-path)) ;list of strings -(define* (program-file name gexp #:key (guile #f)) +(define* (program-file name gexp #:key (guile #f) (module-path %load-path)) "Return an object representing the executable store item NAME that runs -GEXP. GUILE is the Guile package used to execute that script. +GEXP. GUILE is the Guile package used to execute that script. Imported +modules of GEXP are looked up in MODULE-PATH. This is the declarative counterpart of 'gexp->script'." - (%program-file name gexp guile)) + (%program-file name gexp guile module-path)) (define-gexp-compiler (program-file-compiler (file ) system target) ;; Compile FILE by returning a derivation that builds the script. (match file - (($ name gexp guile) + (($ name gexp guile module-path) (gexp->script name gexp + #:module-path module-path #:guile (or guile (default-guile)))))) (define-record-type diff --git a/tests/gexp.scm b/tests/gexp.scm index a0198b13a0..2f8940e2c6 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -902,6 +902,33 @@ (return (and (zero? (close-pipe pipe)) (= n (string->number str))))))))) +(test-assertm "program-file #:module-path" + (call-with-temporary-directory + (lambda (directory) + (define text (random-text)) + + (call-with-output-file (string-append directory "/stupid-module.scm") + (lambda (port) + (write `(begin (define-module (stupid-module)) + (define-public %stupid-thing ,text)) + port))) + + (let* ((exp (with-imported-modules '((stupid-module)) + (gexp (begin + (use-modules (stupid-module)) + (display %stupid-thing))))) + (file (program-file "program" exp + #:guile %bootstrap-guile + #:module-path (list directory)))) + (mlet* %store-monad ((drv (lower-object file)) + (out -> (derivation->output-path drv))) + (mbegin %store-monad + (built-derivations (list drv)) + (let* ((pipe (open-input-pipe out)) + (str (get-string-all pipe))) + (return (and (zero? (close-pipe pipe)) + (string=? text str)))))))))) + (test-assertm "scheme-file" (let* ((text (plain-file "foo" "Hello, world!")) (scheme (scheme-file "bar" #~(list "foo" #$text)))) -- cgit v1.2.3 From 272c07096251ea3dae237fd016fc5d66fe25e147 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Sun, 11 Mar 2018 01:13:01 +0100 Subject: tests: Add tests for "guix pack". * guix/scripts/pack.scm (bootstrap-xz): New variable. (%options) <--bootstrap>: New option. (show-help): Document the new --bootstrap option. (guix-pack): When --bootstrap is specified, use the bootstrap Guile, tar, and xz to build the pack, and do not use any profile hooks or locales. * doc/guix.texi (Invoking guix pull): Document the new --bootstrap option. * tests/guix-pack.sh: New file. * Makefile.am (SH_TESTS): Add guix-pack.sh. * gnu/packages/package-management.scm (guix) : Add util-linux. --- Makefile.am | 1 + doc/guix.texi | 6 ++- gnu/packages/package-management.scm | 2 + guix/scripts/pack.scm | 64 ++++++++++++++++++++-------- tests/guix-pack.sh | 83 +++++++++++++++++++++++++++++++++++++ 5 files changed, 138 insertions(+), 18 deletions(-) create mode 100644 tests/guix-pack.sh (limited to 'tests') diff --git a/Makefile.am b/Makefile.am index 0c653b54e4..feb99490d3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -374,6 +374,7 @@ SH_TESTS = \ tests/guix-download.sh \ tests/guix-gc.sh \ tests/guix-hash.sh \ + tests/guix-pack.sh \ tests/guix-package.sh \ tests/guix-package-net.sh \ tests/guix-system.sh \ diff --git a/doc/guix.texi b/doc/guix.texi index 482fa463cf..9744704ea7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -23,7 +23,7 @@ Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@* Copyright @copyright{} 2015, 2016, 2017 Leo Famulari@* Copyright @copyright{} 2015, 2016, 2017, 2018 Ricardo Wurmus@* Copyright @copyright{} 2016 Ben Woodcroft@* -Copyright @copyright{} 2016, 2017 Chris Marusich@* +Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@* Copyright @copyright{} 2016, 2017, 2018 Efraim Flashner@* Copyright @copyright{} 2016 John Darrington@* Copyright @copyright{} 2016, 2017 Nils Gillmann@* @@ -2899,6 +2899,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 --bootstrap +Use the bootstrap binaries to build the pack. This option is only +useful to Guix developers. @end table In addition, @command{guix pack} supports all the common build options diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index 709cdfd0f7..a90ba7a21a 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -257,6 +257,8 @@ ;; Many tests rely on the 'guile-bootstrap' package, which is why we ;; have it here. ("boot-guile" ,(bootstrap-guile-origin (%current-system))) + ;; Some of the tests use "unshare" when it is available. + ("util-linux" ,util-linux) ,@(if (and (not (%current-target-system)) (string=? (%current-system) "x86_64-linux")) `(("boot-guile/i686" ,(bootstrap-guile-origin "i686-linux"))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 59dd117edb..0ec1ef4d24 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2017 Efraim Flashner ;;; Copyright © 2017 Ricardo Wurmus ;;; Copyright © 2018 Konrad Hinsen +;;; Copyright © 2018 Chris Marusich ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +34,9 @@ #:use-module (guix derivations) #:use-module (guix scripts build) #:use-module (gnu packages) + #:use-module (gnu packages bootstrap) #:use-module (gnu packages compression) + #:use-module (gnu packages guile) #:autoload (gnu packages base) (tar) #:autoload (gnu packages package-management) (guix) #:autoload (gnu packages gnupg) (libgcrypt) @@ -67,6 +70,11 @@ #~(#+(file-append bzip2 "/bin/bzip2") "-9")) (compressor "none" "" #f))) +;; This one is only for use in this module, so don't put it in %compressors. +(define bootstrap-xz + (compressor "bootstrap-xz" ".xz" + #~(#+(file-append %bootstrap-coreutils&co "/bin/xz") "-e -T0"))) + (define (lookup-compressor name) "Return the compressor object called NAME. Error out if it could not be found." @@ -325,6 +333,9 @@ the image." (option '("localstatedir") #f #f (lambda (opt name arg result) (alist-cons 'localstatedir? #t result))) + (option '("bootstrap") #f #f + (lambda (opt name arg result) + (alist-cons 'bootstrap? #t result))) (append %transformation-options %standard-build-options))) @@ -352,6 +363,8 @@ Create a bundle of PACKAGE.\n")) -m, --manifest=FILE create a pack with the manifest from FILE")) (display (G_ " --localstatedir include /var/guix in the resulting pack")) + (display (G_ " + --bootstrap use the bootstrap binaries to build the pack")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -393,28 +406,43 @@ Create a bundle of PACKAGE.\n")) (else (packages->manifest packages))))) (with-error-handling - (parameterize ((%graft? (assoc-ref opts 'graft?))) - (let* ((dry-run? (assoc-ref opts 'dry-run?)) - (manifest (manifest-from-args opts)) - (pack-format (assoc-ref opts 'format)) - (name (string-append (symbol->string pack-format) - "-pack")) - (target (assoc-ref opts 'target)) - (compressor (assoc-ref opts 'compressor)) - (symlinks (assoc-ref opts 'symlinks)) - (build-image (match (assq-ref %formats pack-format) - ((? procedure? proc) proc) - (#f - (leave (G_ "~a: unknown pack format") - format)))) - (localstatedir? (assoc-ref opts 'localstatedir?))) - (with-store store + (let* ((dry-run? (assoc-ref opts 'dry-run?)) + (manifest (manifest-from-args opts)) + (pack-format (assoc-ref opts 'format)) + (name (string-append (symbol->string pack-format) + "-pack")) + (target (assoc-ref opts 'target)) + (bootstrap? (assoc-ref opts 'bootstrap?)) + (compressor (if bootstrap? + bootstrap-xz + (assoc-ref opts 'compressor))) + (tar (if bootstrap? + %bootstrap-coreutils&co + tar)) + (symlinks (assoc-ref opts 'symlinks)) + (build-image (match (assq-ref %formats pack-format) + ((? procedure? proc) proc) + (#f + (leave (G_ "~a: unknown pack format") + format)))) + (localstatedir? (assoc-ref opts 'localstatedir?))) + (with-store store + (parameterize ((%graft? (assoc-ref opts 'graft?)) + (%guile-for-build (package-derivation + store + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + (canonical-package guile-2.2))))) ;; Set the build options before we do anything else. (set-build-options-from-command-line store opts) (run-with-store store (mlet* %store-monad ((profile (profile-derivation manifest + #:hooks (if bootstrap? + '() + %default-profile-hooks) + #:locales? (not bootstrap?) #:target target)) (drv (build-image name profile #:target @@ -424,7 +452,9 @@ Create a bundle of PACKAGE.\n")) #:symlinks symlinks #:localstatedir? - localstatedir?))) + localstatedir? + #:tar + tar))) (mbegin %store-monad (show-what-to-build* (list drv) #:use-substitutes? diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh new file mode 100644 index 0000000000..1b63b957be --- /dev/null +++ b/tests/guix-pack.sh @@ -0,0 +1,83 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2018 Chris Marusich +# +# 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 . + +# +# Test the `guix pack' command-line utility. +# + +# A network connection is required to build %bootstrap-coreutils&co, +# which is required to run these tests with the --bootstrap option. +if ! guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null; then + exit 77 +fi + +guix pack --version + +# Use --no-substitutes because we need to verify we can do this ourselves. +GUIX_BUILD_OPTIONS="--no-substitutes" +export GUIX_BUILD_OPTIONS + +# Build a tarball with no compression. +guix pack --compression=none --bootstrap guile-bootstrap + +# Build a tarball (with compression). +guix pack --bootstrap guile-bootstrap + +# Build a tarball with a symlink. +the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`" + +# Try to extract it. +test_directory="`mktemp -d`" +trap 'rm -rf "$test_directory"' EXIT +cd "$test_directory" +tar -xf "$the_pack" +test -x opt/gnu/bin/guile + +is_available () { + # Use the "type" shell builtin to see if the program is on PATH. + type "$1" > /dev/null +} + +if is_available chroot && is_available unshare; then + # Verify we can use what we built. + unshare -r chroot . /opt/gnu/bin/guile --version + cd - +else + echo "warning: skipped some verification because chroot or unshare is unavailable" >&2 +fi + +# For the tests that build Docker images below, we currently have to use +# --dry-run because if we don't, there are only two possible cases: +# +# Case 1: We do not use --bootstrap, and the build takes hours to finish +# because it needs to build tar etc. +# +# Case 2: We use --bootstrap, and the build fails because the bootstrap +# Guile cannot dlopen shared libraries. Not to mention the fact +# that we would still have to build many non-bootstrap inputs +# (e.g., guile-json) in order to create the Docker image. + +# Build a Docker image. +guix pack --dry-run --bootstrap -f docker guile-bootstrap + +# Build a Docker image with a symlink. +guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap + +# Build a tarball pack of cross-compiled software. Use coreutils because +# guile-bootstrap is not intended to be cross-compiled. +guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils -- cgit v1.2.3 From 8e88f6fa8236a1fe66912957ecacae348355ec15 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Thu, 15 Mar 2018 05:09:15 +0100 Subject: tests: Add tests for "guix system disk-image" et al. * tests/guix-system.sh: Add test cases that exercise (1) all of the example files in gnu/system/examples, and (2) all of the "image" creation commands: vm, vm-image, disk-image, and docker-image. --- tests/guix-system.sh | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) (limited to 'tests') diff --git a/tests/guix-system.sh b/tests/guix-system.sh index ed8563c8aa..211c26f43d 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -1,6 +1,7 @@ # GNU Guix --- Functional package management for GNU # Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès # Copyright © 2017 Tobias Geerinckx-Rice +# Copyright © 2018 Chris Marusich # # This file is part of GNU Guix. # @@ -267,3 +268,19 @@ guix system build "$tmpdir/config.scm" -n # Searching. guix system search tor | grep "^name: tor" guix system search anonym network | grep "^name: tor" + +# Below, use -n (--dry-run) for the tests because if we actually tried to +# build these images, the commands would take hours to run in the worst case. + +# Verify that the examples can be built. +for example in gnu/system/examples/*; do + guix system -n disk-image $example +done + +# Verify that the disk image types can be built. +guix system -n vm gnu/system/examples/vm-image.tmpl +guix system -n vm-image gnu/system/examples/vm-image.tmpl +# This invocation was taken care of in the loop above: +# guix system -n disk-image gnu/system/examples/bare-bones.tmpl +guix system -n disk-image --file-system-type=iso9660 gnu/system/examples/bare-bones.tmpl +guix system -n docker-image gnu/system/examples/docker-image.tmpl -- cgit v1.2.3 From b06a70e05dc6252a3ecb28db5898de7ebc110973 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 27 Mar 2018 14:00:48 +0200 Subject: graph: Add "module" node type. * guix/scripts/graph.scm (module-from-package) (source-module-dependencies*): New procedures. (%module-node-type): New variable. (%node-types): Add it. * guix/modules.scm (source-module-dependencies): Export. * tests/graph.scm ("module graph"): New test. * doc/guix.texi (Invoking guix graph): Document it. --- doc/guix.texi | 9 +++++++++ guix/modules.scm | 3 ++- guix/scripts/graph.scm | 38 ++++++++++++++++++++++++++++++++++++-- tests/graph.scm | 20 +++++++++++++++++++- 4 files changed, 66 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index 49b3dd10d7..2204285516 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6997,6 +6997,15 @@ name instead of a package name, as in: @example guix graph -t derivation `guix system build -d my-config.scm` @end example + +@item module +This is the graph of @dfn{package modules} (@pxref{Package Modules}). +For example, the following command shows the graph for the package +module that defines the @code{guile} package: + +@example +guix graph -t module guile | dot -Tpdf > module-graph.pdf +@end example @end table All the types above correspond to @emph{build-time dependencies}. The diff --git a/guix/modules.scm b/guix/modules.scm index 6c602eda48..bf656bb241 100644 --- a/guix/modules.scm +++ b/guix/modules.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +29,7 @@ file-name->module-name module-name->file-name + source-module-dependencies source-module-closure live-module-closure guix-module-name?)) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 78f09f181b..346ca4ea88 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,9 +27,11 @@ #:use-module (guix gexp) #:use-module (guix derivations) #:use-module (guix memoization) + #:use-module (guix modules) #:use-module ((guix build-system gnu) #:select (standard-packages)) #:use-module (gnu packages) #:use-module (guix sets) + #:use-module ((guix utils) #:select (location-file)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -44,6 +46,7 @@ %derivation-node-type %reference-node-type %referrer-node-type + %module-node-type %node-types guix-graph)) @@ -330,6 +333,36 @@ substitutes." (label store-path-package-name) (edges non-derivation-referrers))) + +;;; +;;; Scheme modules. +;;; + +(define (module-from-package package) + (file-name->module-name (location-file (package-location package)))) + +(define (source-module-dependencies* module) + "Like 'source-module-dependencies' but filter out modules that are not +package modules, while attempting to retain user package modules." + (remove (match-lambda + (('guix _ ...) #t) + (('system _ ...) #t) + (('language _ ...) #t) + (('ice-9 _ ...) #t) + (('srfi _ ...) #t) + (_ #f)) + (source-module-dependencies module))) + +(define %module-node-type + ;; Show the graph of package modules. + (node-type + (name "module") + (description "the graph of package modules") + (convert (lift1 (compose list module-from-package) %store-monad)) + (identifier (lift1 identity %store-monad)) + (label object->string) + (edges (lift1 source-module-dependencies* %store-monad)))) + ;;; ;;; List of node types. @@ -344,7 +377,8 @@ substitutes." %bag-emerged-node-type %derivation-node-type %reference-node-type - %referrer-node-type)) + %referrer-node-type + %module-node-type)) (define (lookup-node-type name) "Return the node type called NAME. Raise an error if it is not found." diff --git a/tests/graph.scm b/tests/graph.scm index 00fd37243c..5faa19298a 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -271,6 +271,24 @@ edges." (list txt out)) (equal? edges `((,txt ,out))))))))))) +(test-assert "module graph" + (let-values (((backend nodes+edges) (make-recording-backend))) + (run-with-store %store + (export-graph '((gnu packages guile)) 'port + #:node-type %module-node-type + #:backend backend)) + + (let-values (((nodes edges) (nodes+edges))) + (and (member '(gnu packages guile) + (match nodes + (((ids labels) ...) ids))) + (->bool (and (member (list '(gnu packages guile) + '(gnu packages libunistring)) + edges) + (member (list '(gnu packages guile) + '(gnu packages bdw-gc)) + edges))))))) + (test-assert "node-edges" (run-with-store %store (let ((packages (fold-packages cons '()))) -- cgit v1.2.3 From 8980eea5ab6f89e7649d9abf0be2a9d49156f7d2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 27 Mar 2018 14:16:19 +0200 Subject: guix gc: Add '--derivers'. * guix/scripts/gc.scm (show-help, %options): Add '--derivers'. (guix-gc): Handle 'list-derivers'. * tests/guix-gc.sh: Add test. * doc/guix.texi (Invoking guix gc): Document it. --- doc/guix.texi | 18 ++++++++++++++++++ guix/scripts/gc.scm | 10 +++++++++- tests/guix-gc.sh | 5 ++++- 3 files changed, 31 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index 2204285516..c37a87d5a1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2642,6 +2642,24 @@ of these, recursively. In other words, the returned list is the of an element. @xref{Invoking guix graph}, for a tool to visualize the graph of references. +@item --derivers +@cindex derivation +Return the derivation(s) leading to the given store items +(@pxref{Derivations}). + +For example, this command: + +@example +guix gc --derivers `guix package -I ^emacs$ | cut -f4` +@end example + +@noindent +returns the @file{.drv} file(s) leading to the @code{emacs} package +installed in your profile. + +Note that there may be zero matching @file{.drv} files, for instance +because these files have been garbage-collected. There can also be more +than one matching @file{.drv} due to fixed-output derivations. @end table Lastly, the following options allow you to check the integrity of the diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index a31d2236b0..e4ed7227ff 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -61,6 +61,8 @@ Invoke the garbage collector.\n")) -R, --requisites list the requisites of PATHS")) (display (G_ " --referrers list the referrers of PATHS")) + (display (G_ " + --derivers list the derivers of PATHS")) (newline) (display (G_ " --verify[=OPTS] verify the integrity of the store; OPTS is a @@ -153,6 +155,10 @@ Invoke the garbage collector.\n")) (lambda (opt name arg result) (alist-cons 'action 'list-referrers (alist-delete 'action result)))) + (option '("derivers") #f #f + (lambda (opt name arg result) + (alist-cons 'action 'list-derivers + (alist-delete 'action result)))) (option '("list-failures") #f #f (lambda (opt name arg result) (alist-cons 'action 'list-failures @@ -241,6 +247,8 @@ Invoke the garbage collector.\n")) (requisites store (list item))))) ((list-referrers) (list-relatives referrers)) + ((list-derivers) + (list-relatives valid-derivers)) ((optimize) (assert-no-extra-arguments) (optimize-store store)) diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh index efbc7e759c..ef2d9543b7 100644 --- a/tests/guix-gc.sh +++ b/tests/guix-gc.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2013, 2015, 2017 Ludovic Courtès +# Copyright © 2013, 2015, 2017, 2018 Ludovic Courtès # # This file is part of GNU Guix. # @@ -54,6 +54,9 @@ guix gc --references "$out/bin/guile" if guix gc --references /dev/null; then false; else true; fi +# Check derivers. +guix gc --derivers "$out" | grep "$drv" + # Add then reclaim a .drv file. drv="`guix build idutils -d`" test -f "$drv" -- cgit v1.2.3