Subject: [bug#30572] [PATCH 1/7] tests: Add tests for "guix pack".

From: Chris Marusich <[email-masked]>
Date: Tue, 06 Mar 2018 06:53:51 +0100

[email-masked] (Ludovic Courtès) writes:

>> +# Use --dry-run because it takes too long to actually build everything.
>> +GUIX_BUILD_OPTIONS="--no-substitutes --dry-run"
>> +export GUIX_BUILD_OPTIONS
>> +
>> +# Build a tarball.
>> +guix pack coreutils
>
> It would be ideal if we could actually build something, but built
> something cheap.
>
> The way we do that in those tests is by:
>
>   1. Using the ‘guile-bootstrap’ package as an example, under the
>      assumption that it’s already available, does not require
>      networking, and is built in one or two seconds.
>
>   2. Using ‘--bootstrap’ or a similar option so that the derivations use
>      ‘guile-bootstrap’ instead of ‘guile-final’, for the same reason.
>
> See for instance tests/guix-package.sh.
>
> Would you be willing to try something along these lines?

That's a good idea!  I tried it (see attached patch).  Unfortunately,
even after adding a --bootstrap option, "guix pack" tries to build many
things, so tests/guix-pack.sh takes hours to run the first time you try
it (it ran for 2 hours on my laptop and then failed because gcc failed
to build for unrelated reasons):

--8<---------------cut here---------------start------------->8---
+ GUIX_BUILD_OPTIONS=--no-substitutes
+ export GUIX_BUILD_OPTIONS
+ guix pack --bootstrap guile-bootstrap
accepted connection from pid 25978, user marusich
The following derivations will be built:
   /home/marusich/guix-wip-docker/test-tmp/store/5306akcwzxpl00jq237i5np684j0vmzl-tarball-pack.tar.gz.drv
   /home/marusich/guix-wip-docker/test-tmp/store/cdvscfg50aw5jxnd259x1h9bp30lfkdj-module-import.drv
   /home/marusich/guix-wip-docker/test-tmp/store/wr7q9d2fzkw1fi6q8ms8fkx9ivxjkqqg-module-import-compiled.drv
   /home/marusich/guix-wip-docker/test-tmp/store/yirhq0bk23hs1ygx0b1ny3v56x9c9fji-tar-1.29.tar.xz.drv
   /home/marusich/guix-wip-docker/test-tmp/store/fwlyz9ll798kzb509zklkqbgf6px4sj9-lzip-1.19.drv
   /home/marusich/guix-wip-docker/test-tmp/store/dncnbczz63kq6zmdrr8vf5h5c2sb71pg-ed-1.14.2.drv
   /home/marusich/guix-wip-docker/test-tmp/store/9fnrsfhfa4sh8fm86s7451gm9lma3ys1-pkg-config-0.29.2.drv
   /home/marusich/guix-wip-docker/test-tmp/store/6vddknc0jvxl6nbqvimn6mdilvxavln4-m4-1.4.18.drv
   /home/marusich/guix-wip-docker/test-tmp/store/ww1wddpxfj4ynbi3gspdnfpi1w6zh19l-expat-2.2.5.drv
   /home/marusich/guix-wip-docker/test-tmp/store/77hapsriz2k7ix77gqgmsj5m2dxzshy3-gettext-minimal-0.19.8.1.drv
   /home/marusich/guix-wip-docker/test-tmp/store/kprlkrdl1bmxghi1q53vm4bc3cxfiw61-attr-2.4.47.drv
   /home/marusich/guix-wip-docker/test-tmp/store/93rzrq8dnl74rlfzvv1a4k1m553s7g57-libcap-2.25.drv
   /home/marusich/guix-wip-docker/test-tmp/store/d5kc96m4why9yvnlvyal8qb5ar6gi7sw-perl-5.26.1.drv
   /home/marusich/guix-wip-docker/test-tmp/store/w282an05cm2900wv8l7hk51rv1df3kl6-gmp-6.1.2.drv
   /home/marusich/guix-wip-docker/test-tmp/store/xk9l4cnqqc0jq611vm7i5gm5f2zh505n-acl-2.2.52.drv
   /home/marusich/guix-wip-docker/test-tmp/store/32m2qgabizs50hm70rjdc3zx4a64c1sx-libsigsegv-2.11.drv
   /home/marusich/guix-wip-docker/test-tmp/store/0jv6207vr9d8dd1j4ipiqbvgsxxwb9ax-m4-1.4.18.drv
   /home/marusich/guix-wip-docker/test-tmp/store/hdr6lkf7fwv7zgpryd9rnx2n9qqy017q-libatomic-ops-7.4.8.drv
   /home/marusich/guix-wip-docker/test-tmp/store/15kqh766smp6jy64is5zy49yix20l4h9-libltdl-2.4.6.drv
   /home/marusich/guix-wip-docker/test-tmp/store/2amv52bswrhvq82y6cx2dgbbaw1vnq32-libffi-3.2.1.drv
   /home/marusich/guix-wip-docker/test-tmp/store/4niik1n2j3f62xv01x5h6jwmzm0f3nvz-libgc-7.6.0.drv
   /home/marusich/guix-wip-docker/test-tmp/store/hy8c34s1q5a0af6jc61z4z3159c8gryq-gmp-6.1.2.drv
   /home/marusich/guix-wip-docker/test-tmp/store/illsqfj4c1zdkszwyyw8b9r593lx8xvx-libunistring-0.9.8.drv
   /home/marusich/guix-wip-docker/test-tmp/store/jz05x01mb6y7i3by3mwzj9bwqnmcvr6m-pkg-config-0.29.2.drv
   /home/marusich/guix-wip-docker/test-tmp/store/rfcacc8gajq6sqvx5166cxal3qqjdv48-perl-boot0-5.26.1.drv
   /home/marusich/guix-wip-docker/test-tmp/store/0sy6428wjldm79ksdmgif7ak6j63fsda-module-import.drv
   /home/marusich/guix-wip-docker/test-tmp/store/rglsxbjr8aplljbl87ibqwq32f0zbfz5-module-import-compiled.drv
   /home/marusich/guix-wip-docker/test-tmp/store/vgqjcfc86maww541pvkl8lzhbkayy427-gzip-1.8.drv
   /home/marusich/guix-wip-docker/test-tmp/store/1malkdjyhma8payi1q39gpas819drs7m-module-import.drv
   /home/marusich/guix-wip-docker/test-tmp/store/1n2b3c5drfdmc8ammc4fhhnz6wiqxlfg-tar-1.29.drv
   /home/marusich/guix-wip-docker/test-tmp/store/3rm7z6iwjk36ccw2q2cchn5cy25gpbw9-glibc-utf8-locales-2.26.105-g0890d5379c.drv
   /home/marusich/guix-wip-docker/test-tmp/store/9svg3a4sggjwjh7xjpra68mms3qrnzyy-bash-minimal-4.4.12.drv
   /home/marusich/guix-wip-docker/test-tmp/store/9y3vbqgvzgf3z0a8wrh6n710m2nca3k1-gcc-5.5.0.drv
   /home/marusich/guix-wip-docker/test-tmp/store/av9n8ds39jzxp13h6pzls4wlq62nd1ry-grep-3.1.drv
   /home/marusich/guix-wip-docker/test-tmp/store/c1rm58rv7xyhkw5jqw0hljzdwkx87vv4-guile-2.2.3.drv
   /home/marusich/guix-wip-docker/test-tmp/store/cc9nalqm463s7kwz9j093iaph45zmbm1-findutils-4.6.0.drv
   /home/marusich/guix-wip-docker/test-tmp/store/dhz1a4ascsmfypkd1fl782fj1wn75k04-gzip-1.8.drv
   /home/marusich/guix-wip-docker/test-tmp/store/gxgvm9d4x7n72pzfmr8bisq2j2jd5dw9-bzip2-1.0.6.drv
   /home/marusich/guix-wip-docker/test-tmp/store/ixysd07gjzcfi3l7x61n7k4mbyi2mgzl-gawk-4.1.4.drv
   /home/marusich/guix-wip-docker/test-tmp/store/plfrsghh3kk0kjjwsl9qh7mh4ppm4s7j-coreutils-8.28.drv
   /home/marusich/guix-wip-docker/test-tmp/store/plsnrf4f6mfyw5270f3f46hfq9agikxi-make-4.2.1.drv
   /home/marusich/guix-wip-docker/test-tmp/store/q6g6axx4i927mw8jx7kl8brjsxgkwgsp-ld-wrapper-0.drv
   /home/marusich/guix-wip-docker/test-tmp/store/v97fmq5lbcawz4z3ljic971djdif5ayh-xz-5.2.3.drv
   /home/marusich/guix-wip-docker/test-tmp/store/x34halk6yz9nmkd2wcipxgn6fmygdyn8-patch-2.7.5.drv
   /home/marusich/guix-wip-docker/test-tmp/store/xa3a93dyfv3pkkg79jmaz37lb4p57s96-diffutils-3.6.drv
   /home/marusich/guix-wip-docker/test-tmp/store/xyb0kwdmish8a299smx7hkq0fgrfn4qw-sed-4.4.drv
   /home/marusich/guix-wip-docker/test-tmp/store/z0z9f2cxk2za96i8fczq23mh3h70d4n9-file-5.32.drv
   /home/marusich/guix-wip-docker/test-tmp/store/z6ads1hjgrcj5jcaf7jinrh9bn2m7rmk-module-import-compiled.drv
   /home/marusich/guix-wip-docker/test-tmp/store/gqb0hng3ndhgi8ddxnwn1lbi58vpbawl-gzip-1.8.drv
   /home/marusich/guix-wip-docker/test-tmp/store/w9s9c0b8szkkx79qi910r7jjs1zwkzaw-tar-1.29.drv
--8<---------------cut here---------------end--------------->8---

It's quicker after the first time, but it's a hefty one-time cost.

I think so many things need to be built because "guix pack" creates the
pack using a gexp that uses packages.  For example, instead of executing
"tar" by looking it up in the current environment (e.g. via system*), it
builds the "tar" package and executes the resulting "tar" program in the
gexp that creates the pack.  Therefore, even though we do use
guile-bootstrap to run the gexp, Guix still need to build tar and all of
its dependencies, so the test takes hours to run.  Can we do better?

Maybe we could share the host's store with the test.  I don't think this
will help, though, since the package definitions used by the installed
Guix are often different than the package definitions in the Git
repository.  If we tried to do this, I think we'd probably just wind up
building tar etc. before running the test, instead of during the test.
The total time required to prepare and run the test probably wouldn't
change.

Maybe we could move tests like these to a "long-running" test target
(e.g., "make check-long-running").  I think this could work, but I would
much rather just write tests that run quickly.

Maybe we could rewrite "guix pack" so that it uses system* to run tar.
I think this might actually be a good idea, but I'm curious to know what
you think.  It's neat that one can write a program (like "guix pack")
whose runtime dependencies are built just-in-time by Guix.  However,
these runtime dependencies (e.g., tar) could theoretically be garbage
collected by Guix in-between invocations of "guix pack", and it clearly
makes the program a little more difficult to test.

Finally, maybe we could stick with running the tests in "dry-run" mode.
I'm in favor of this idea, but obviously I'm a little biased.  :-)

-- 
Chris
From 72e672e795fe8f4d67f7e1805ba8b88c874f3fb1 Mon Sep 17 00:00:00 2001
From: Chris Marusich <[email-masked]>
Date: Tue, 20 Feb 2018 02:17:54 +0100
Subject: [PATCH 1/7] tests: Add tests for "guix pack".

* guix/scripts/pack.scm (%options): Add the --bootstrap option.
  (show-help): Document it.
  (guix-pack): Honor it.
* doc/guix.texi (Invoking guix pack): 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) <inputs>: Add util-linux.
---
 Makefile.am                         |  1 +
 doc/guix.texi                       |  4 +++
 gnu/packages/package-management.scm |  2 ++
 guix/scripts/pack.scm               | 51 ++++++++++++++++++++------------
 tests/guix-pack.sh                  | 59 +++++++++++++++++++++++++++++++++++++
 5 files changed, 98 insertions(+), 19 deletions(-)
 create mode 100644 tests/guix-pack.sh

diff --git a/Makefile.am b/Makefile.am
index e2c940ca8..c4c37e327 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -372,6 +372,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 fb2834942..1d06f6a87 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2894,6 +2894,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 Guile 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 32a7a30e7..5e11eaedd 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 59dd117ed..460e9f2f2 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -33,6 +33,7 @@
   #:use-module (guix derivations)
   #:use-module (guix scripts build)
   #:use-module (gnu packages)
+  #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages compression)
   #:autoload   (gnu packages base) (tar)
   #:autoload   (gnu packages package-management) (guix)
@@ -325,6 +326,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 +356,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 Guile to build the pack"))
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
@@ -393,28 +399,35 @@ 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
-          ;; Set the build options before we do anything else.
-          (set-build-options-from-command-line store opts)
-
+    (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?))
+           (bootstrap? (assoc-ref opts 'bootstrap?)))
+      (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)))))
           (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
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
new file mode 100644
index 000000000..a754324d1
--- /dev/null
+++ b/tests/guix-pack.sh
@@ -0,0 +1,59 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Chris Marusich <[email-masked]>
+#
+# 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 <http://www.gnu.org/licenses/>.
+
+#
+# Test the `guix pack' command-line utility.
+#
+
+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.
+guix pack --bootstrap guile-bootstrap
+
+# Build a tarball with a symlink.
+the_pack="$(guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap)"
+
+is_available () {
+    # Use the "type" shell builtin to see if the program is on PATH.
+    type "$1"
+}
+
+if is_available chroot && is_available unshare; then
+    # Verify we can extract and use it.
+    test_directory="$(mktemp -d)"
+    trap 'rm -rf "$test_directory"' EXIT
+    cd "$test_directory"
+    tar -xf "$the_pack"
+    unshare -mrf chroot . /opt/gnu/bin/guile --version
+    cd -
+else
+    echo "chroot/unshare not available, skipping verification of pack contents"
+fi
+
+# Build a Docker image.
+guix pack --bootstrap -f docker guile-bootstrap
+
+# Build a Docker image with a symlink.
+guix pack --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
+
+# Build a tarball pack of cross-compiled software.
+guix pack --bootstrap --target=arm-unknown-linux-gnueabihf guile-bootstrap
-- 
2.15.1