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

[Chris Marusich <cmmarusich@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 648 bytes --]

Chris Marusich <cmmarusich@gmail.com> writes:

> Chris Marusich <cmmarusich@gmail.com> writes:
>
>> Sure thing.  I'll include this change when pushing to origin.
>
> For the record, here's a new version of the patch with the two suggested
> improvements (put "warning:" in the warning message, and redirect
> superfluous output to /dev/null).

And here is another version that (1) uses the existing
%bootstrap-coreutils&co package, and (2) skips the test when no network
connection is available.

Let me know if you think this is good, and I'll go ahead and push the
entire patch series.  Thank you for your feedback!

-- 
Chris

[-- Attachment #1.2: 0001-tests-Add-tests-for-guix-pack.patch --]
[-- Type: text/x-patch, Size: 12610 bytes --]

From 4385831672436b2339f7a5da9f45f429dc3178dc Mon Sep 17 00:00:00 2001
From: Chris Marusich <cmmarusich@gmail.com>
Date: Sun, 11 Mar 2018 01:13:01 +0100
Subject: [PATCH 1/6] 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) <inputs>: 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                  | 80 +++++++++++++++++++++++++++++++++++++
 5 files changed, 135 insertions(+), 18 deletions(-)
 create mode 100644 tests/guix-pack.sh

diff --git a/Makefile.am b/Makefile.am
index 6556799e6..637c934ed 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 d3a7908f9..792539a12 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 ng0@*
@@ -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 709cdfd0f..a90ba7a21 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..0ec1ef4d2 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
+;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; 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 000000000..681faf80a
--- /dev/null
+++ b/tests/guix-pack.sh
@@ -0,0 +1,80 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
+#
+# 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.
+#
+
+# 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`"
+
+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 extract and use it.
+    test_directory="`mktemp -d`"
+    trap 'rm -rf "$test_directory"' EXIT
+    cd "$test_directory"
+    tar -xf "$the_pack"
+    unshare -r chroot . /opt/gnu/bin/guile --version
+    cd -
+else
+    echo "warning: skipping pack 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
-- 
2.15.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]