code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
#
# 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 archive' command-line utility.
#

guix archive --version

archive="t-archive-$$"
archive_alt="t-archive-alt-$$"
tmpdir="t-archive-dir-$$"
rm -f "$archive" "$archive_alt"
rm -rf "$tmpdir"

trap 'rm -f "$archive" "$archive_alt"; rm -rf "$tmpdir"' EXIT

guix archive --export guile-bootstrap > "$archive"
guix archive --export guile-bootstrap:out > "$archive_alt"
cmp "$archive" "$archive_alt"

guix archive --export							\
    -e '(@ (gnu packages bootstrap) %bootstrap-guile)' > "$archive_alt"
cmp "$archive" "$archive_alt"

guix archive --export `guix build guile-bootstrap` > "$archive_alt"
cmp "$archive" "$archive_alt"

# Check the exit value upon import.
guix archive --import < "$archive"

if guix archive something-that-does-not-exist
then false; else true; fi

# This one must not be listed as missing.
guix build guile-bootstrap > "$archive"
guix archive --missing < "$archive"
test "`guix archive --missing < "$archive"`" = ""

# Two out of three should be listed as missing.
echo "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" >> "$archive"
echo "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bar" >> "$archive"
guix archive --missing < "$archive" > "$archive_alt"
echo "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" > "$archive"
echo "$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bar" >> "$archive"
cmp "$archive" "$archive_alt"

# This is not a valid store file name, so an error.
echo something invalid > "$archive"
if guix archive --missing < "$archive"
then false; else true; fi

# Check '--extract'.
guile -c "(use-modules (guix serialization))
  (call-with-output-file \"$archive\"
    (lambda (port)
      (write-file \"$(guix build guile-bootstrap)\" port)))"
guix archive -x "$tmpdir" < "$archive"
test -x "$tmpdir/bin/guile"
test -d "$tmpdir/lib/guile"

if echo foo | guix archive --authorize
then false; else true; fi


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
#
# 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 authenticate' command-line utility.
#

guix authenticate --version

sig="t-signature-$$"
hash="t-hash-$$"
rm -f "$sig" "$hash"

trap 'rm -f "$sig" "$hash"' EXIT

# A hexadecimal string as long as a sha256 hash.
echo "2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb" \
    > "$hash"

guix authenticate rsautl -sign				\
    -inkey "$abs_top_srcdir/tests/signing-key.sec"	\
    -in "$hash" > "$sig"
test -f "$sig"

hash2="`guix authenticate rsautl -verify		\
          -inkey $abs_top_srcdir/tests/signing-key.pub	\
          -pubin -in $sig`"
test "$hash2" = `cat "$hash"`

# Same thing in a pipeline, using the command line syntax that Nix/Crypto.pm
# uses.
hash2="`						\
  cat "$hash"						\
  | guix authenticate rsautl -sign			\
    -inkey "$abs_top_srcdir/tests/signing-key.sec"	\
  | guix authenticate rsautl -verify			\
          -inkey $abs_top_srcdir/tests/signing-key.pub	\
          -pubin`"
test "$hash2" = `cat "$hash"`

# Detect corrupt signatures.
if guix authenticate rsautl -verify				\
          -inkey "$abs_top_srcdir/tests/signing-key.pub"	\
          -pubin -in /dev/null
then false
else true
fi

# Detect invalid signatures.
# The signature has (payload (data ... (hash sha256 #...#))).  We proceed by
# modifying this hash.
sed -i "$sig"											\
    -e's|#[A-Z0-9]\{64\}#|#0000000000000000000000000000000000000000000000000000000000000000#|g'
if guix authenticate rsautl -verify				\
          -inkey "$abs_top_srcdir/tests/signing-key.pub"	\
          -pubin -in "$sig"
then false
else true
fi

# Test for <http://bugs.gnu.org/17312>: make sure 'guix authenticate' produces
# valid signatures when run in the C locale.
echo "5eff0b55c9c5f5e87b4e34cd60a2d5654ca1eb78c7b3c67c3179fed1cff07b4c" \
    > "$hash"

LC_ALL=C
export LC_ALL

guix authenticate rsautl -sign				\
    -inkey "$abs_top_srcdir/tests/signing-key.sec"	\
    -in "$hash" > "$sig"

guix authenticate rsautl -verify			\
        -inkey "$abs_top_srcdir/tests/signing-key.pub"	\
        -pubin -in "$sig"
hash2="`guix authenticate rsautl -verify		\
          -inkey $abs_top_srcdir/tests/signing-key.pub	\
          -pubin -in $sig`"
test "$hash2" = `cat "$hash"`

license: mit


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
#
# 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 build' command-line utility.
#

guix build --version

# Should fail.
if guix build -e +;
then false; else true; fi

# Source-less packages are accepted; they just return nothing.
guix build -e '(@ (gnu packages bootstrap) %bootstrap-glibc)' -S
test "`guix build -e '(@ (gnu packages bootstrap) %bootstrap-glibc)' -S`" = ""

# Should pass.
guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' |	\
    grep -e '-guile-'
guix build hello -d |				\
    grep -e '-hello-[0-9\.]\+\.drv$'

# Passing a URI.
GUIX_DAEMON_SOCKET="file://$NIX_STATE_DIR/daemon-socket/socket"	\
guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'

( if GUIX_DAEMON_SOCKET="weird://uri"					\
     guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)';	\
  then exit 1; fi )

# Check --sources option with its arguments
module_dir="t-guix-build-$$"
mkdir "$module_dir"
trap "rm -rf $module_dir" EXIT

cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
  #:use-module (guix tests)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system trivial))

(define-public foo
  (package
    (name "foo")
    (version "42")
    (source (origin
              (method url-fetch)
              (uri "http://www.example.com/foo.tar.gz")
              (sha256
               (base32
                "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"))))
    (build-system trivial-build-system)
    (inputs
     (quasiquote (("bar" ,bar))))
    (home-page "www.example.com")
    (synopsis "Dummy package")
    (description "foo is a dummy package for testing.")
    (license #f)))

(define-public bar
  (package
    (name "bar")
    (version "9001")
    (source (origin
              (method url-fetch)
              (uri "http://www.example.com/bar.tar.gz")
              (sha256
               (base32
                "yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy"))))
    (build-system trivial-build-system)
    (inputs
     (quasiquote
      (("data" ,(origin
                 (method url-fetch)
                 (uri "http://www.example.com/bar.dat")
                 (sha256
                  (base32
                   "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz")))))))
    (home-page "www.example.com")
    (synopsis "Dummy package")
    (description "bar is a dummy package for testing.")
    (license #f)))

(define-public baz
  (dummy-package "baz" (replacement foo)))

(define-public superseded
  (deprecated-package "superseded" bar))

EOF

GUIX_PACKAGE_PATH="$module_dir"
export GUIX_PACKAGE_PATH

# foo.tar.gz
guix build -d -S foo
guix build -d -S foo | grep -e 'foo\.tar\.gz'

# 'baz' has a replacement so we should be getting the replacement's source.
(unset GUIX_BUILD_OPTIONS;
 test "`guix build -d -S baz`" = "`guix build -d -S foo`")

guix build -d --sources=package foo
guix build -d --sources=package foo | grep -e 'foo\.tar\.gz'

# bar.tar.gz and bar.dat
guix build -d --sources bar
test `guix build -d --sources bar \
      | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \
      | wc -l` -eq 2

# bar.tar.gz and bar.dat
guix build -d --sources=all bar
test `guix build -d --sources bar \
      | grep -e 'bar\.tar\.gz' -e 'bar\.dat' \
      | wc -l` -eq 2

# Should include foo.tar.gz, bar.tar.gz, and bar.dat
guix build -d --sources=transitive foo
test `guix build -d --sources=transitive foo \
      | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \
      | wc -l` -eq 3

# Unbound variables.
cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
  #:use-module (guix tests)
  #:use-module (guix build-system trivial))

(define-public foo
  (dummy-package "package-with-something-wrong"
    (build-system trivial-build-system)
    (inputs (quasiquote (("sed" ,sed))))))  ;unbound variable
EOF

if guix build package-with-something-wrong -n; then false; else true; fi
guix build package-with-something-wrong -n 2> "$module_dir/err" || true
grep "unbound" "$module_dir/err"		     # actual error
grep "forget.*(gnu packages base)" "$module_dir/err" # hint
rm -f "$module_dir"/*

# Should all return valid log files.
drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
log="`guix build --log-file $drv`"
echo "$log" | grep log/.*guile.*drv
test -f "$log"
test "`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' --log-file`" \
    = "$log"
test "`guix build --log-file guile-bootstrap`" = "$log"
test "`guix build --log-file $out`" = "$log"

# Should fail because the name/version combination could not be found.
if guix build hello-0.0.1 -n; then false; else true; fi

# Keep a symlink to the result, registered as a root.
result="t-result-$$"
guix build -r "$result"					\
    -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
test -x "$result/bin/guile"

# Should fail, because $result already exists.
if guix build -r "$result" -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
then false; else true; fi

rm -f "$result"

# Cross building.
guix build coreutils --target=mips64el-linux-gnu --dry-run --no-substitutes

# Replacements.
drv1=`guix build guix --with-input=guile@2.0=guile@2.2 -d`
drv2=`guix build guix -d`
test "$drv1" != "$drv2"

drv1=`guix build guile -d`
drv2=`guix build guile --with-input=gimp=ruby -d`
test "$drv1" = "$drv2"

if guix build guile --with-input=libunistring=something-really-silly
then false; else true; fi

# Deprecated/superseded packages.
test "`guix build superseded -d`" = "`guix build bar -d`"

# Parsing package names and versions.
guix build -n time		# PASS
guix build -n time@1.9		# PASS, version found
if guix build -n time@3.2;	# FAIL, version not found
then false; else true; fi
if guix build -n something-that-will-never-exist; # FAIL
then false; else true; fi

# Invoking a monadic procedure.
guix build -e "(begin
                 (use-modules (guix gexp))
                 (lambda ()
                   (gexp->derivation \"test\"
                                     (gexp (mkdir (ungexp output))))))" \
   --dry-run

# Running a gexp.
guix build -e '#~(mkdir #$output)' -d
guix build -e '#~(mkdir #$output)' -d | grep 'gexp\.drv'

# Same with a file-like object.
guix build -e '(computed-file "foo" #~(mkdir #$output))' -d
guix build -e '(computed-file "foo" #~(mkdir #$output))' -d | grep 'foo\.drv'

# Building from a package file.
cat > "$module_dir/package.scm"<<EOF
(use-modules (gnu))
(use-package-modules bootstrap)

%bootstrap-guile
EOF
guix build --file="$module_dir/package.scm"

# Building from a monadic procedure file.
cat > "$module_dir/proc.scm"<<EOF
(use-modules (guix gexp))
(lambda ()
  (gexp->derivation "test"
                    (gexp (mkdir (ungexp output)))))
EOF
guix build --file="$module_dir/proc.scm" --dry-run

# Building from a gexp file.
cat > "$module_dir/gexp.scm"<<EOF
(use-modules (guix gexp))

(gexp (mkdir (ungexp output)))
EOF
guix build --file="$module_dir/gexp.scm" -d
guix build --file="$module_dir/gexp.scm" -d | grep 'gexp\.drv'

# Using 'GUIX_BUILD_OPTIONS'.
GUIX_BUILD_OPTIONS="--dry-run --no-grafts"
export GUIX_BUILD_OPTIONS

guix build emacs

GUIX_BUILD_OPTIONS="--something-completely-crazy"
if guix build emacs;
then false; else true; fi


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
#
# 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 daemon and its interaction with 'guix substitute'.
#

set -e

guix-daemon --version
guix build --version

drv="`guix build emacs -d`"
out="`guile -c '								\
  (use-modules (guix) (guix grafts) (gnu packages emacs))			\
  (define store (open-connection))						\
  (%graft? #f)
  (display (derivation->output-path (package-derivation store emacs)))'`"

hash_part="`basename $out | cut -c 1-32`"
narinfo="$hash_part.narinfo"
substitute_dir="`echo $GUIX_BINARY_SUBSTITUTE_URL | sed -'es,file://,,g'`"

cat > "$substitute_dir/nix-cache-info"<<EOF
StoreDir: `dirname $drv`
WantMassQuery: 0
EOF

cat > "$substitute_dir/$narinfo"<<EOF
StorePath: $out
URL: /nowhere/example.nar
Compression: none
NarSize: 1234
References:
System: `guile -c '(use-modules (guix)) (display (%current-system))'`
Deriver: $drv
EOF

# Remove the cached narinfo.
rm -f "$XDG_CACHE_HOME/guix/substitute/$hash_part"

# Make sure we see the substitute.
guile -c "
  (use-modules (guix))
  (define store (open-connection))
  (set-build-options store #:use-substitutes? #t
                     #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))
  (exit (has-substitutes? store \"$out\"))"

# Now, run guix-daemon --no-substitutes.
socket="$NIX_STATE_DIR/alternate-socket"
guix-daemon --no-substitutes --listen="$socket" --disable-chroot &
daemon_pid=$!
trap 'kill $daemon_pid' EXIT

# Make sure we DON'T see the substitute.
guile -c "
  (use-modules (guix))
  (define store (open-connection \"$socket\"))

  ;; This setting MUST NOT override the daemon's --no-substitutes.
  (set-build-options store #:use-substitutes? #t
                     #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\"))

  (exit (not (has-substitutes? store \"$out\")))"

kill "$daemon_pid"

# Pass several '--listen' options, and make sure they are all honored.
guix-daemon --disable-chroot --listen="$socket" --listen="$socket-second" \
	    --listen="localhost" --listen="localhost:9876" &
daemon_pid=$!

for uri in "$socket" "$socket-second" \
		     "guix://localhost" "guix://localhost:9876"
do
    GUIX_DAEMON_SOCKET="$uri" guix build guile-bootstrap
done

kill "$daemon_pid"

# Check the failed build cache.

guix-daemon --no-substitutes --listen="$socket" --disable-chroot	\
  --cache-failures &
daemon_pid=$!

guile -c "
  (use-modules (guix) (guix grafts) (guix tests) (srfi srfi-34))
  (define store (open-connection-for-tests \"$socket\"))

  ;; Disable grafts to avoid building more than needed.
  (%graft? #f)

  (define (build-without-failing drv)
    (lambda (store)
      (guard (c ((nix-protocol-error? c) (values #t store)))
        (build-derivations store (list drv))
        (values #f store))))

  ;; Make sure failed builds are cached and can be removed from
  ;; the cache.
  (run-with-store store
    (mlet* %store-monad ((drv (gexp->derivation \"failure\"
                                                #~(begin
                                                    (ungexp output)
                                                     #f)))
                         (out -> (derivation->output-path drv))
                         (ok?    (build-without-failing drv)))
      ;; Note the mixture of monadic and direct style.  Don't try
      ;; this at home!
      (return (exit (and ok?
                         (equal? (query-failed-paths store) (list out))
                         (begin
                           (clear-failed-paths store (list out))
                           (null? (query-failed-paths store)))))))
    #:guile-for-build (%guile-for-build)) "

kill "$daemon_pid"

# Make sure the daemon's default 'build-cores' setting is honored.

guix-daemon --listen="$socket" --disable-chroot --cores=42 &
daemon_pid=$!

GUIX_DAEMON_SOCKET="$socket" \
guile -c '
  (use-modules (guix) (gnu packages) (guix tests))

  (with-store store
    (let* ((build  (add-text-to-store store "build.sh"
                                      "echo $NIX_BUILD_CORES > $out"))
           (bash   (add-to-store store "bash" #t "sha256"
                                 (search-bootstrap-binary "bash"
                                                          (%current-system))))
           (drv    (derivation store "the-thing" bash
                               `("-e" ,build)
                               #:inputs `((,bash) (,build))
                               #:env-vars `(("x" . ,(random-text))))))
      (and (build-derivations store (list drv))
           (exit
            (= 42 (pk (call-with-input-file (derivation->output-path drv)
                        read)))))))'

kill "$daemon_pid"

# Make sure the daemon's default 'timeout' and 'max-silent-time' settings are
# honored.

client_code='
  (use-modules (guix) (gnu packages) (guix tests) (srfi srfi-34))

  (with-store store
    (let* ((build  (add-text-to-store store "build.sh"
                                      "while true ; do : ; done"))
           (bash   (add-to-store store "bash" #t "sha256"
                                 (search-bootstrap-binary "bash"
                                                          (%current-system))))
           (drv    (derivation store "the-thing" bash
                               `("-e" ,build)
                               #:inputs `((,bash) (,build))
                               #:env-vars `(("x" . ,(random-text))))))
      (exit (guard (c ((nix-protocol-error? c)
                       (->bool
                        (string-contains (pk (nix-protocol-error-message c))
                                         "failed"))))
              (build-derivations store (list drv))
              #f))))'

for option in --max-silent-time=1 --timeout=1
do
    guix-daemon --listen="$socket" --disable-chroot "$option" &
    daemon_pid=$!

    GUIX_DAEMON_SOCKET="$socket" guile -c "$client_code"
    kill "$daemon_pid"
done

# Make sure garbage collection from a TCP connection does not work.

tcp_socket="127.0.0.1:9999"
guix-daemon --listen="$tcp_socket" &
daemon_pid=$!

GUIX_DAEMON_SOCKET="guix://$tcp_socket"
export GUIX_DAEMON_SOCKET

if guix gc; then false; else true; fi

unset GUIX_DAEMON_SOCKET
kill "$daemon_pid"

# Log compression.

guix-daemon --listen="$socket" --disable-chroot --debug --log-compression=gzip &
daemon_pid=$!

stamp="compressed-build-log-test-$$-`date +%H%M%S`"
client_code="
  (use-modules (guix) (gnu packages bootstrap))

  (with-store store
    (run-with-store store
      (mlet %store-monad ((drv (lower-object
				(computed-file \"compressed-log-test\"
					       #~(begin
						   (display \"$stamp\")
                                                   (newline)
						   (mkdir #\$output))
					       #:guile %bootstrap-guile))))
	(display (derivation-file-name drv))
	(newline)
	(return #t))))
"

GUIX_DAEMON_SOCKET="$socket"
export GUIX_DAEMON_SOCKET

drv=`guile -c "$client_code"`
guix build "$drv"

log=`guix build "$drv" --log-file`
test -f "$log"
case "$log" in
    *.gz) test "`gunzip -c < "$log"`" = "$stamp" ;;
    *)    false ;;
esac


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
#
# 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 'guix describe'.
#

guix describe --version

tmpfile="t-guix-describe-$$"
trap "rm -f $tmpfile" EXIT
rm -f "$tmpfile"

if [ -d "$abs_top_srcdir/.git" ]
then
    # Since we're in a Git checkout, we can at least check that these things
    # work.
    guix describe | grep -i "checkout"
    if git --version > /dev/null 2>&1
    then
	result="`guix describe | grep commit: | cut -d : -f 2-`"
	commit="`git log | head -1 | cut -c 7-`"
	test "x$result" = "x$commit"
    fi
    guix describe -f channels
    case "`guix describe -f channels | grep url`" in
	*"(url \"$abs_top_srcdir\")") true;;
	*) false;;
    esac
else
    exit 77
fi


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
#
# 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 download' command-line utility.
#

guix download --version

# Make sure it fails here.
if guix download http://does.not/exist
then false; else true; fi

if guix download unknown://some/where;
then false; else true; fi

if guix download /does-not-exist
then false; else true; fi

# This one should succeed.
guix download "file://$abs_top_srcdir/README"

# And this one, without the URI scheme.
guix download "$abs_top_srcdir/README"

# This one too, even if it cannot talk to the daemon.
output="t-download-$$"
trap 'rm -f "$output"' EXIT
GUIX_DAEMON_SOCKET="/nowhere" guix download -o "$output" \
		  "file://$abs_top_srcdir/README"
cmp "$output" "$abs_top_srcdir/README"

# This one should fail.
if guix download "file:///does-not-exist" "file://$abs_top_srcdir/README"
then false; else true; fi


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2015 David Thompson <davet@gnu.org>
#
# 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 'guix environment'.
#

set -e

guix environment --version

if ! guile -c '((@@ (guix scripts environment) assert-container-features))'
then
    # User containers are not supported; skip this test.
    exit 77
fi

tmpdir="t-guix-environment-$$"
trap 'rm -r "$tmpdir"' EXIT

mkdir "$tmpdir"

# Make sure the exit value is preserved.
if guix environment --container --ad-hoc --bootstrap guile-bootstrap \
        -- guile -c '(exit 42)'
then
    false
else
    test $? = 42
fi

# Make sure file-not-found errors in mounts are reported.
if guix environment --container --ad-hoc --bootstrap guile-bootstrap \
	--expose=/does-not-exist -- guile -c 1 2> "$tmpdir/error"
then
    false
else
    grep "/does-not-exist" "$tmpdir/error"
    grep "[Nn]o such file" "$tmpdir/error"
fi

# Make sure that the right directories are mapped.
mount_test_code="
(use-modules (ice-9 rdelim)
             (ice-9 match)
             (srfi srfi-1))

(define mappings
  (filter-map (lambda (line)
                (match (string-split line #\space)
                  ;; Empty line.
                  ((\"\") #f)
                  ;; Ignore the root file system.
                  ((_ \"/\" _ _ _ _)
                   #f)
                  ;; Ignore these types of file systems, except if they
                  ;; correspond to a parent file system.
                  ((_ mount (or \"tmpfs\" \"proc\" \"sysfs\" \"devtmpfs\"
                                \"devpts\" \"cgroup\" \"mqueue\") _ _ _)
                   (and (string-prefix? (getcwd) mount)
		        mount))
                  ((_ mount _ _ _ _)
                   mount)))
              (string-split (call-with-input-file \"/proc/mounts\" read-string)
                            #\newline)))

(for-each (lambda (mount)
            (display mount)
            (newline))
          mappings)"

guix environment --container --ad-hoc --bootstrap guile-bootstrap \
     -- guile -c "$mount_test_code" > $tmpdir/mounts

cat "$tmpdir/mounts"
test `wc -l < $tmpdir/mounts` -eq 4

current_dir="`cd $PWD; pwd -P`"
grep -e "$current_dir$" $tmpdir/mounts # current directory
grep $(guix build guile-bootstrap) $tmpdir/mounts
grep -e "$NIX_STORE_DIR/.*-bash" $tmpdir/mounts # bootstrap bash

rm $tmpdir/mounts

# Make sure 'GUIX_ENVIRONMENT' is linked to '~/.guix-profile' when requested
# within a container.
(
  linktest='(exit (string=? (getenv "GUIX_ENVIRONMENT")
(readlink (string-append (getenv "HOME") "/.guix-profile"))))'

  cd "$tmpdir" \
     && guix environment --bootstrap --container --link-profile \
             --ad-hoc guile-bootstrap --pure \
             -- guile -c "$linktest"
)

# Test that user can be mocked.
usertest='(exit (and (string=? (getenv "HOME") "/home/foognu")
                     (string=? (passwd:name (getpwuid 0)) "foognu")
                     (file-exists? "/home/foognu/umock")))'
touch "$tmpdir/umock"
HOME="$tmpdir" guix environment --bootstrap --container --user=foognu \
     --ad-hoc guile-bootstrap --pure \
     --share="$tmpdir/umock" \
     -- guile -c "$usertest"

# Check the exit code.

abnormal_exit_code="
(use-modules (system foreign))
;; Purposely make Guile crash with a segfault. :)
(pointer->string (make-pointer 123) 123)"

if guix environment --bootstrap --container \
	--ad-hoc guile-bootstrap -- guile -c "$abnormal_exit_code"
then false;
else
    test $? -gt 127
fi


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
#
# 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 'guix environment'.
#

set -e

guix environment --version

tmpdir="t-guix-environment-$$"
gcroot="t-guix-environment-gc-root-$$"
trap 'rm -r "$tmpdir"; rm -f "$gcroot"' EXIT

mkdir "$tmpdir"

# 'guix environment' launches /bin/sh if 'SHELL' is unset, so export 'SHELL'
# since we know it's valid (build environments lack /bin/sh.)
export SHELL

# Check the environment variables for the bootstrap Guile.
guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
     --search-paths > "$tmpdir/a"
guix environment --bootstrap --ad-hoc guile-bootstrap:out --pure \
     --search-paths > "$tmpdir/b"

# $PATH must appear in the search paths, and nothing else.
grep -E '^export PATH=.*profile/bin' "$tmpdir/a"
test "`wc -l < "$tmpdir/a"`" = 1

# Guile must be on $PATH.
test -x `sed -r 's/^export PATH="(.*)"/\1/' "$tmpdir/a"`/guile

cmp "$tmpdir/a" "$tmpdir/b"

# Make sure the exit value is preserved.
if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
        -- guile -c '(exit 42)'
then
    false
else
    test $? = 42
fi

# Make sure 'GUIX_ENVIRONMENT' points to the profile.
guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
     -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"'

# Make sure 'GUIX_ENVIRONMENT' points to the profile when building from a
# manifest.
echo "(use-modules (guix profiles) (gnu packages bootstrap))

(packages->manifest (list %bootstrap-guile))
" > $tmpdir/manifest.scm
guix environment --bootstrap --manifest=$tmpdir/manifest.scm --pure \
     -- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"'

# Make sure '-r' works as expected.
rm -f "$gcroot"
expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \
             -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT'`"
guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
     -- guile -c 1
test `readlink "$gcroot"` = "$expected"

# Make sure '-r' is idempotent.
guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
     -- guile -c 1
test `readlink "$gcroot"` = "$expected"
rm "$gcroot"

# Same with an absolute file name.
guix environment --bootstrap -r "$PWD/$gcroot" --ad-hoc guile-bootstrap \
     -- guile -c 1
test `readlink "$gcroot"` = "$expected"

case "`uname -m`" in
    x86_64)
	# On x86_64, we should be able to create a 32-bit environment.
	guix environment --bootstrap --ad-hoc guile-bootstrap --pure	\
	     -- guile -c '(exit (string-prefix? "x86_64" %host-type))'
	guix environment --bootstrap --ad-hoc guile-bootstrap --pure	\
	     -s i686-linux						\
	     -- guile -c '(exit (string-prefix? "i686" %host-type))'
	;;
    *)
	echo "nothing to do" >&2
	;;
esac

# Same as above, but with deprecated -E flag.
if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
        -E "guile -c '(exit 42)'"
then
    false
else
    test $? = 42
fi

# Make sure we can build the environment of 'guix'.  There may be collisions
# in its profile (e.g., for 'gzip'), but we have to accept them.
guix environment guix --bootstrap -n

if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
then
    # Compute the build environment for the initial GNU Make.
    guix environment --bootstrap --no-substitutes --search-paths --pure \
         -e '(@@ (gnu packages commencement) gnu-make-boot0)' > "$tmpdir/a"

    # Make sure bootstrap binaries are in the profile.
    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`

    # Make sure the bootstrap binaries are all listed where they belong.
    grep -E "^export PATH=\"$profile/bin\""         "$tmpdir/a"
    grep -E "^export CPATH=\"$profile/include\""    "$tmpdir/a"
    grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
    for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0
    do
	guix gc --references "$profile" | grep "$dep"
    done

    # 'make-boot0' itself must not be listed.
    if guix gc --references "$profile" | grep make-boot0
    then false; else true; fi

    # Make sure that the shell spawned with '--exec' sees the same environment
    # as returned by '--search-paths'.
    guix environment --bootstrap --no-substitutes --pure \
         -e '(@@ (gnu packages commencement) gnu-make-boot0)' \
         -- /bin/sh -c 'echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b"
    ( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c"
    cmp "$tmpdir/b" "$tmpdir/c"

    rm "$tmpdir"/*

    # Compute the build environment for the initial GNU Findutils.
    guix environment --bootstrap --no-substitutes --search-paths --pure \
         -e '(@@ (gnu packages commencement) findutils-boot0)' > "$tmpdir/a"
    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`

    # Make sure the bootstrap binaries are all listed where they belong.
    grep -E "^export PATH=\"$profile/bin\""         "$tmpdir/a"
    grep -E "^export CPATH=\"$profile/include\""    "$tmpdir/a"
    grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
    for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 \
				    make-boot0
    do
	guix gc --references "$profile" | grep "$dep"
    done

    # The following test assumes 'make-boot0' has a "debug" output.
    make_boot0_debug="`guix build -e '(@@ (gnu packages commencement) gnu-make-boot0)' | grep -e -debug`"
    test "x$make_boot0_debug" != "x"

    # Make sure the "debug" output is not listed.
    if guix gc --references "$profile" | grep "$make_boot0_debug"
    then false; else true; fi

    # Compute the build environment for the initial GNU Make, but add in the
    # bootstrap Guile as an ad-hoc addition.
    guix environment --bootstrap --no-substitutes --search-paths --pure	\
         -e '(@@ (gnu packages commencement) gnu-make-boot0)'		\
         --ad-hoc guile-bootstrap > "$tmpdir/a"
    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`

    # Make sure the bootstrap binaries are all listed where they belong.
    grep -E "^export PATH=\"$profile/bin\""         "$tmpdir/a"
    grep -E "^export CPATH=\"$profile/include\""    "$tmpdir/a"
    grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
    for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0 \
				    guile-bootstrap
    do
	guix gc --references "$profile" | grep "$dep"
    done

    # Make sure a package list with plain package objects and package+output
    # tuples can be used with -e.
    expr_list_test_code="
(list (@@ (gnu packages commencement) gnu-make-boot0)
      (list (@ (gnu packages bootstrap) %bootstrap-guile) \"out\"))"

    guix environment --bootstrap --ad-hoc --no-substitutes --search-paths \
         --pure -e "$expr_list_test_code" > "$tmpdir/a"
    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`

    for dep in make-boot0 guile-bootstrap
    do
	guix gc --references "$profile" | grep "$dep"
    done
fi


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2013, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
#
# 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 gc' command-line utility.
#

guix gc --version

trap "rm -f guix-gc-root" EXIT
rm -f guix-gc-root

# Below we are using 'drv' and 'out' to contain store file names.  If 'drv'
# and 'out' are environment variables, 'list-runtime-roots' will "see" them
# and thus prevent $drv and $out from being garbage-collected.  Using 'unset'
# allows us to make sure these are truly local shell variables and not
# environments variables.
unset drv
unset out

# For some operations, passing extra arguments is an error.
for option in "" "-C 500M" "--verify" "--optimize"
do
    if guix gc $option whatever; then false; else true; fi
done

# This should fail.
if guix gc --verify=foo; then false; else true; fi

# Check the references of a .drv.
drv="`guix build guile-bootstrap -d`"
out="`guix build guile-bootstrap`"
test -f "$drv" && test -d "$out"

guix gc --references "$drv" | grep -e -bash
guix gc --references "$out"
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"

guix gc --list-dead | grep "$drv"
guix gc --delete "$drv"
! test -f "$drv"

# Add a .drv, register it as a root.
drv="`guix build --root=guix-gc-root lsh -d`"
test -f "$drv" && test -L guix-gc-root

guix gc --list-live | grep "$drv"
if guix gc --delete "$drv";
then false; else true; fi

rm guix-gc-root
guix gc --list-dead | grep "$drv"
guix gc --delete "$drv"
! test -f "$drv"

# Try a random collection.
guix gc -C 1KiB

# Check trivial error cases.
if guix gc --delete /dev/null;
then false; else true; fi

# Bug #19757
out="`guix build guile-bootstrap`"
test -d "$out"

guix gc --delete "$out"

! test -d "$out"

out="`guix build guile-bootstrap`"
test -d "$out"

guix gc --delete "$out/"

! test -d "$out"

out="`guix build guile-bootstrap`"
test -d "$out"

guix gc --delete "$out/bin/guile"


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
#
# 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 graph' command-line utility.
#

tmpfile1="t-guix-graph1-$$"
tmpfile2="t-guix-graph2-$$"
trap 'rm -f "$tmpfile1" "$tmpfile2"' EXIT

guix graph --version

for package in guile-bootstrap coreutils python
do
    for graph in package bag-emerged bag bag-with-origins
    do
	guix graph -t "$graph" "$package" | grep "$package"
    done
done

guix build guile-bootstrap
guix graph -t references guile-bootstrap | grep guile-bootstrap

guix graph -e '(@ (gnu packages bootstrap) %bootstrap-guile)' \
    | grep guile-bootstrap

if guix graph -e +; then false; else true; fi

# Try passing store file names.

guix graph -t references guile-bootstrap > "$tmpfile1"
guix graph -t references `guix build guile-bootstrap` > "$tmpfile2"
cmp "$tmpfile1" "$tmpfile2"

# XXX: Filter the file names in the graph to work around the fact that we get
# a mixture of relative and absolute file names.
guix graph -t derivation coreutils > "$tmpfile1"
guix graph -t derivation `guix build -d coreutils` > "$tmpfile2"
cmp "$tmpfile1" "$tmpfile2"


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
#
# 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 hash' command-line utility.
#

guix hash --version

tmpdir="guix-hash-$$"
trap 'rm -rf "$tmpdir"' EXIT

test `guix hash /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
test `echo -n | guix hash -` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
test `guix hash -f nix-base32 /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
test `guix hash -f hex /dev/null` = e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855
test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfeswmrw6csxbkq

mkdir "$tmpdir"
echo -n executable > "$tmpdir/exe"
chmod +x "$tmpdir/exe"
( cd "$tmpdir" ; ln -s exe symlink )
mkdir "$tmpdir/subdir"

test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p

# Without '-r', this should fail.
if guix hash "$tmpdir"
then false; else true; fi

# This should fail because /dev/null is a character device, which
# the archive format doesn't support.
if guix hash -r /dev/null
then false; else true; fi

# Adding a .git directory
mkdir "$tmpdir/.git"
touch "$tmpdir/.git/foo"

# ...changes the hash
test `guix hash -r $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59

# ...but remains the same when using `-x'
test `guix hash -r $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p

# Without '-r', this should fail.
if guix hash "$tmpdir"
then false; else true; fi


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2014 Cyril Roelandt <tipecaml@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 lint' command-line utility.
#

guix lint --version

module_dir="t-guix-lint-$$"
mkdir "$module_dir"
trap "rm -rf $module_dir" EXIT

cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
  #:use-module (guix packages)
  #:use-module (gnu packages base))

(define-public dummy
  (package (inherit hello)
    (name "dummy")
    (version "42")
    (synopsis "dummy package")
    (description "dummy package. Only used for testing purposes.")))
EOF

GUIX_PACKAGE_PATH="$module_dir"
export GUIX_PACKAGE_PATH

grep_warning ()
{
    res=`echo "$1" | grep -E -c "(synopsis|description) should"`
    echo $res
}

# Three issues with the dummy package:
# 1) the synopsis starts with the package name;
# 2) the synopsis starts with a lower-case letter;
# 3) the description has a single space following the end-of-sentence period.

out=`guix lint -c synopsis,description dummy 2>&1`
if [ `grep_warning "$out"` -ne 3 ]
then false; else true; fi

out=`guix lint -c synopsis dummy 2>&1`
if [ `grep_warning "$out"` -ne 2 ]
then false; else true; fi

out=`guix lint -c description dummy 2>&1`
if [ `grep_warning "$out"` -ne 1 ]
then false; else true; fi

out=`guix lint -c description,synopsis dummy 2>&1`
if [ `grep_warning "$out"` -ne 3 ]
then false; else true; fi

if guix lint -c synopsis,invalid-checker dummy 2>&1 | \
   grep -q 'invalid-checker: invalid checker'
then true; else false; fi

# Make sure specifying multiple packages works.
guix lint -c inputs-should-be-native dummy dummy@42 dummy


code:
# 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

# FIXME: Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa,
# '--bootstrap' is mostly ineffective since 'guix pack' produces derivations
# that refer to guile-sqlite3 and libgcrypt.  For now we just skip the test.
exit 77

# 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).  Check that '-e' works as well.
out1="`guix pack --bootstrap guile-bootstrap`"
out2="`guix pack --bootstrap -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
test -n "$out1"
test "$out1" = "$out2"

# Build a tarball with a symlink.
the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"

# Try to extract it.  Note: we cannot test whether /opt/gnu/bin/guile itself
# exists because /opt/gnu/bin may be an absolute symlink to a store item that
# has been GC'd.
test_directory="`mktemp -d`"
trap 'rm -rf "$test_directory"' EXIT
cd "$test_directory"
tar -xf "$the_pack"
test -L opt/gnu/bin

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

# Likewise, 'guix pack -R' requires a full-blown toolchain (because
# 'glibc-bootstrap' lacks 'libc.a'), hence '--dry-run'.
guix pack -R --dry-run --bootstrap -S /mybin=bin guile-bootstrap

# Make sure package transformation options are honored.
mkdir -p "$test_directory"
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"


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
#
# 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 package' command-line utility.  This test requires network
# access and is skipped when that is lacking.
#

guix package --version

readlink_base ()
{
    basename `readlink "$1"`
}

# Return true if a typical shebang in the store would exceed Linux's default
# static limit.
shebang_too_long ()
{
    test `echo $NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bootstrap-binaries-0/bin/bash | wc -c` \
	 -ge 128
}

if ! guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null \
	|| shebang_too_long
then
    # Skipping.
    exit 77
fi

profile="t-profile-$$"
profile_alt="t-profile-alt-$$"
rm -f "$profile"

trap 'rm -f "$profile" "$profile_alt" "$profile-"[0-9]* "$profile_alt-"[0-9]* ; rm -rf t-home-'"$$" EXIT

guix package --bootstrap -p "$profile" -i guile-bootstrap
test -L "$profile" && test -L "$profile-1-link"
! test -f "$profile-2-link"
test -f "$profile/bin/guile"

boot_make="(@@ (gnu packages commencement) gnu-make-boot0)"
boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`"
guix package --bootstrap -p "$profile" -i "$boot_make_drv"
test -L "$profile-2-link"
test -f "$profile/bin/make" && test -f "$profile/bin/guile"

# Check whether `--list-installed' works.
# XXX: Change the tests when `--install' properly extracts the package
# name and version string.
installed="`guix package -p "$profile" --list-installed | cut -f1 | xargs echo | sort`"
case "x$installed" in
    "guile-bootstrap make-boot0")
        true;;
    "make-boot0 guile-bootstrap")
        true;;
    "*")
        false;;
esac

test "`guix package -p "$profile" -I 'g.*e' | cut -f1`" = "guile-bootstrap"

# List generations.
test "`guix package -p "$profile" -l | cut -f1 | grep guile | head -n1`" \
     = "  guile-bootstrap"

# Exit with 1 when a generation does not exist.
if guix package -p "$profile" --list-generations=42;
then false; else true; fi
if guix package -p "$profile" --switch-generation=99;
then false; else true; fi

# Remove a package.
guix package --bootstrap -p "$profile" -r "guile-bootstrap"
test -L "$profile-3-link"
test -f "$profile/bin/make" && ! test -f "$profile/bin/guile"

# Roll back.
guix package --roll-back -p "$profile"
test "`readlink_base "$profile"`" = "$profile-2-link"
test -x "$profile/bin/guile" && test -x "$profile/bin/make"
guix package --roll-back -p "$profile"
test "`readlink_base "$profile"`" = "$profile-1-link"
test -x "$profile/bin/guile" && ! test -x "$profile/bin/make"

# Switch to the rolled generation and switch back.
guix package -p "$profile" --switch-generation=2
test "`readlink_base "$profile"`" = "$profile-2-link"
guix package -p "$profile" --switch-generation=-1
test "`readlink_base "$profile"`" = "$profile-1-link"

# Move to the empty profile.
for i in `seq 1 3`
do
    guix package --bootstrap --roll-back -p "$profile"
    ! test -f "$profile/bin"
    ! test -f "$profile/lib"
    test "`readlink_base "$profile"`" = "$profile-0-link"
done

# Test that '--list-generations' does not output the zeroth generation.
test -z "`guix package -p "$profile" -l 0`"

# Reinstall after roll-back to the empty profile.
guix package --bootstrap -p "$profile" -e "$boot_make"
test "`readlink_base "$profile"`" = "$profile-1-link"
test -x "$profile/bin/guile" && ! test -x "$profile/bin/make"

# Check that the first generation is the current one.
test "`guix package -p "$profile" -l 1 | cut -f3 | head -n1`" = "(current)"

# Roll-back to generation 0, and install---all at once.
guix package --bootstrap -p "$profile" --roll-back -i guile-bootstrap
test "`readlink_base "$profile"`" = "$profile-1-link"
test -x "$profile/bin/guile" && ! test -x "$profile/bin/make"

# Install Make.
guix package --bootstrap -p "$profile" -e "$boot_make"
test "`readlink_base "$profile"`" = "$profile-2-link"
test -x "$profile/bin/guile" && test -x "$profile/bin/make"
grep "`guix build -e "$boot_make"`" "$profile/manifest"

# Make a "hole" in the list of generations, and make sure we can
# roll back and switch "over" it.
rm "$profile-1-link"
guix package --bootstrap -p "$profile" --roll-back
test "`readlink_base "$profile"`" = "$profile-0-link"
guix package -p "$profile" --switch-generation=+1
test "`readlink_base "$profile"`" = "$profile-2-link"

# Make sure LIBRARY_PATH gets listed by `--search-paths'.
guix package --bootstrap -p "$profile" -i guile-bootstrap -i gcc-bootstrap
guix package -p "$profile" --search-paths | grep LIBRARY_PATH

# Roll back so we can delete #3 below.
guix package -p "$profile" --switch-generation=2

# Delete the third generation and check that it was actually deleted.
guix package -p "$profile" --delete-generations=3
test -z "`guix package -p "$profile" -l 3`"

# Search path of combined profiles.  'LIBRARY_PATH' should show up only in the
# combination, not in the individual profiles.
rm "$profile"
guix package --bootstrap -p "$profile" -i guile-bootstrap
guix package --bootstrap -p "$profile_alt" -i gcc-bootstrap
if guix package -p "$profile" --search-paths | grep LIBRARY_PATH
then false; fi
guix package -p "$profile" -p "$profile_alt" --search-paths \
     | grep "LIBRARY_PATH.*$profile/lib.$profile_alt/lib"

#
# Try with the default profile.
#

XDG_CACHE_HOME="${XDG_CACHE_HOME:-$HOME/.cache}"
export XDG_CACHE_HOME
HOME="$PWD/t-home-$$"
export HOME

mkdir -p "$HOME"

# Get the canonical directory name so that 'guix package' recognizes it.
HOME="`cd $HOME; pwd -P`"

guix package --bootstrap -e "$boot_make"
test -f "$HOME/.guix-profile/bin/make"

guix package --bootstrap --roll-back
! test -f "$HOME/.guix-profile/bin/make"


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
#
# 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 package' command-line utility.
#

guix package --version

readlink_base ()
{
    basename `readlink "$1"`
}

module_dir="t-guix-package-$$"
profile="t-profile-$$"
tmpfile="t-guix-package-file-$$"
rm -f "$profile" "$tmpfile"

trap 'rm -f "$profile" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home-'"$$" EXIT

# Use `-e' with a non-package expression.
if guix package --bootstrap -e +;
then false; else true; fi

# Install a store item and make sure the version and output in the manifest
# are correct.
guix package --bootstrap -p "$profile" -i `guix build guile-bootstrap`
test "`guix package -A guile-bootstrap | cut -f 1-2`" \
     = "`guix package -p "$profile" -I | cut -f 1-2`"
test "`guix package -p "$profile" -I | cut -f 3`" = "out"
rm "$profile"

guix package --bootstrap -p "$profile" -i guile-bootstrap
test -L "$profile" && test -L "$profile-1-link"
test -f "$profile/bin/guile"

# Make sure the profile is a GC root.
guix gc --list-live | grep "`readlink "$profile-1-link"`"

# Installing the same package a second time does nothing.
guix package --bootstrap -p "$profile" -i guile-bootstrap
test -L "$profile" && test -L "$profile-1-link"
! test -f "$profile-2-link"
test -f "$profile/bin/guile"

# Collisions are properly flagged (in this case, 'g-wrap' propagates
# guile@2.2, which conflicts with guile@2.0.)
if guix package --bootstrap -n -p "$profile" -i g-wrap guile@2.0
then false; else true; fi

guix package --bootstrap -n -p "$profile" -i g-wrap guile@2.0 \
     --allow-collisions

# No search path env. var. here.
guix package -p "$profile" --search-paths
guix package -p "$profile" --search-paths | grep '^export PATH='
test "`guix package -p "$profile" --search-paths | wc -l`" = 1  # $PATH
( set -e; set -x;						\
  eval `guix package --search-paths=prefix -p "$PWD/$profile"`;	\
  test "`type -P guile`" = "$PWD/$profile/bin/guile" ;		\
  type -P rm )

# Exit with 1 when a generation does not exist.
if guix package -p "$profile" --delete-generations=42;
then false; else true; fi

# Exit with 0 when trying to delete the zeroth generation.
guix package -p "$profile" --delete-generations=0

# Make sure multiple arguments to -i works.
guix package --bootstrap -i guile gcc -p "$profile" -n

# Make sure the `:' syntax works.
guix package --bootstrap -i "glibc:debug" -p "$profile" -n

# Make sure nonexistent outputs are reported.
guix package --bootstrap -i "guile-bootstrap:out" -p "$profile" -n
if guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile" -n;
then false; else true; fi
if guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile";
then false; else true; fi

# Check whether `--list-available' returns something sensible.
guix package -p "$profile" -A 'gui.*e' | grep guile

# Check whether `--show' returns something sensible.
guix package --show=guile | grep "^name: guile"

# Ensure `--show' doesn't fail for packages with non-package inputs.
guix package --show=texlive

# Search.
LC_MESSAGES=C
export LC_MESSAGES
test "`guix package -s "An example GNU package" | grep ^name:`" = \
    "name: hello"
test -z "`guix package -s "n0t4r341p4ck4g3"`"

# Search with one and then two regexps.
# First we get printed circuit boards *and* board games.
guix package -s '\<board\>' > "$tmpfile"
grep '^name: pcb' "$tmpfile"
grep '^name: gnubg' "$tmpfile"

# Second we get only board games.
guix package -s '\<board\>' -s game > "$tmpfile"
grep -v '^name: pcb' "$tmpfile" > /dev/null
grep '^name: gnubg' "$tmpfile"

rm -f "$tmpfile"

# Make sure deprecated packages don't show up: <https://bugs.gnu.org/30566>.
mkdir "$module_dir"
cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
  #:use-module (guix packages)
  #:use-module (gnu packages base))

(define-public deprecated
  (deprecated-package "fileutils" coreutils))
EOF

guix build -L "$module_dir" -e '(@ (foo) deprecated)' -n
test "`guix package -L "$module_dir" -s ^fileutils$ | grep ^name:`" = ""

rm -rf "$module_dir"

# Make sure `--search' can display all the packages.
guix package --search="" > /dev/null

# There's no generation older than 12 months, so the following command should
# have no effect.
generation="`readlink_base "$profile"`"
if guix package -p "$profile" --delete-generations=12m;
then false; else true; fi
test "`readlink_base "$profile"`" = "$generation"

# The following command should not delete the current generation, even though
# it matches the given pattern (see <http://bugs.gnu.org/19978>.)  And since
# there's nothing else to delete, it should just fail.
guix package --list-generations -p "$profile"
if guix package --bootstrap -p "$profile" --delete-generations=1..
then false; else true; fi
test "`readlink_base "$profile"`" = "$generation"

# Make sure $profile is a GC root at this point.
real_profile="`readlink -f "$profile"`"
if guix gc -d "$real_profile"
then false; else true; fi
test -d "$real_profile"

# Now, let's remove all the symlinks to $real_profile, and make sure
# $real_profile is no longer a GC root.
rm "$profile" "$profile"-[0-9]-link
guix gc -d "$real_profile"
[ ! -d "$real_profile" ]

# Package transformations.

# Make sure we get the right version number when using '--with-source'.
mkdir "$module_dir"
emacs_tarball="$module_dir/emacs-42.5.9rc7.tar.gz"
touch "$emacs_tarball"
guix package -p "$profile" -i emacs --with-source="$emacs_tarball" -n \
     2> "$tmpfile"
grep -E 'emacs[[:blank:]]+42\.5\.9rc7[[:blank:]]+.*-emacs-42.5.9rc7' \
     "$tmpfile"
rm "$emacs_tarball" "$tmpfile"
rmdir "$module_dir"

# Profiles with a relative file name.  Make sure we don't create dangling
# symlinks--see bug report at
# <https://lists.gnu.org/archive/html/guix-devel/2018-07/msg00036.html>.
mkdir -p "$module_dir/foo"
( cd "$module_dir" ;						\
  guix package --bootstrap -i guile-bootstrap -p foo/prof )
test -f "$module_dir/foo/prof/bin/guile"
rm "$module_dir/foo"/*
rmdir "$module_dir/foo"
rmdir "$module_dir"

#
# Try with the default profile.
#

XDG_CACHE_HOME="${XDG_CACHE_HOME:-$HOME/.cache}"
export XDG_CACHE_HOME
HOME="$PWD/t-home-$$"
export HOME

mkdir -p "$HOME"

# Get the canonical directory name so that 'guix package' recognizes it.
HOME="`cd $HOME; pwd -P`"

guix package --bootstrap -i guile-bootstrap
test -L "$HOME/.guix-profile"
test -f "$HOME/.guix-profile/bin/guile"

# Move to the empty profile.
default_profile="`readlink "$HOME/.guix-profile"`"
for i in `seq 1 3`
do
    # Make sure the current generation is a GC root.
    profile_link="`readlink "$default_profile"`"
    guix gc --list-live | grep "`readlink "$profile_link"`"

    guix package --bootstrap --roll-back
    ! test -f "$HOME/.guix-profile/bin"
    ! test -f "$HOME/.guix-profile/lib"
    test "`readlink "$default_profile"`" = "`basename $default_profile-0-link`"
done

# Check whether '-p ~/.guix-profile' makes any difference.
# See <http://bugs.gnu.org/17939>.
if test -e "$HOME/.guix-profile-0-link"; then false; fi
if test -e "$HOME/.guix-profile-1-link"; then false; fi
guix package --bootstrap -p "$HOME/.guix-profile" -i guile-bootstrap
if test -e "$HOME/.guix-profile-1-link"; then false; fi
guix package --bootstrap --roll-back -p "$HOME/.guix-profile"
if test -e "$HOME/.guix-profile-0-link"; then false; fi

# Extraneous argument.
if guix package install foo-bar;
then false; else true; fi

# Make sure the "broken pipe" doesn't yield an error.
# Note: 'pipefail' is a Bash-specific option.
set -o pipefail || true
guix package -A g | head -1 2> "$HOME/err1"
guix package -I | head -1 2> "$HOME/err2"
test "`cat "$HOME/err1" "$HOME/err2"`" = ""

# Make sure '-L' extends the package module search path.
mkdir "$module_dir"

cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
  #:use-module (guix packages)
  #:use-module (gnu packages emacs))

(define-public x
  (package (inherit emacs)
    (name "emacs-foo-bar")
    (version "42")))
EOF

guix package -A emacs-foo-bar -L "$module_dir" | grep 42
guix package -i emacs-foo-bar@42 -n -L "$module_dir"

# Same thing using the 'GUIX_PACKAGE_PATH' environment variable.
GUIX_PACKAGE_PATH="$module_dir"
export GUIX_PACKAGE_PATH
guix package -A emacs-foo-bar | grep 42
guix package -i emacs-foo-bar@42 -n

# Make sure patches that live under $GUIX_PACKAGE_PATH are found.
cat > "$module_dir/emacs.patch"<<EOF
This is a fake patch.
EOF
cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
  #:use-module (guix packages)
  #:use-module (gnu packages)
  #:use-module (gnu packages emacs))

(define-public x
  (package (inherit emacs)
    (source (origin (inherit (package-source emacs))
              (patches (list (search-patch "emacs.patch")))))
    (name "emacs-foo-bar-patched")
    (version "42")))

(define-public y
  (package (inherit emacs)
    (name "super-non-portable-emacs")
    (supported-systems '("foobar64-hurd"))))
EOF
guix package -i emacs-foo-bar-patched -n

# Same when -L is used.
( unset GUIX_PACKAGE_PATH;					\
  guix package -L "$module_dir" -i emacs-foo-bar-patched -n )

# Make sure installing from a file works.
cat > "$module_dir/package.scm"<<EOF
(use-modules (gnu))
(use-package-modules bootstrap)

%bootstrap-guile
EOF
guix package --bootstrap --install-from-file="$module_dir/package.scm"

# This one should not show up in searches since it's no supported on the
# current system.
test "`guix package -A super-non-portable-emacs`" = ""
test "`guix package -s super-non-portable-emacs | grep ^systems:`" = "systems: "

# Don't upgrade packages marked for removal: <http://bugs.gnu.org/27262>.
guix package --bootstrap -p "$profile" -i guile-bootstrap

cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
  #:use-module (guix)
  #:use-module (gnu packages bootstrap))

(define-public x
  (package (inherit %bootstrap-guile) (version "42")))
EOF

guix package --bootstrap -p "$profile" -r guile-bootstrap -u guile
test ! -f "$profile/bin/guile"
guix package --bootstrap -p "$profile" --roll-back
test -f "$profile/bin/guile"
rm "$profile-2-link"

unset GUIX_PACKAGE_PATH

# Using 'GUIX_BUILD_OPTIONS'.
available="`guix package -A | sort`"
GUIX_BUILD_OPTIONS="--dry-run --no-grafts"
export GUIX_BUILD_OPTIONS

# Make sure $GUIX_BUILD_OPTIONS is not simply appended to the command-line,
# which would break 'guix package -A' and similar.
available2="`guix package -A | sort`"
test "$available2" = "$available"
guix package -I

# Restore '--no-grafts', which makes sure we don't end up building stuff when
# '--dry-run' is passed.
GUIX_BUILD_OPTIONS="--no-grafts"

# Applying a manifest file.
cat > "$module_dir/manifest.scm"<<EOF
(use-package-modules bootstrap)

(packages->manifest (list %bootstrap-guile))
EOF
guix package --bootstrap -m "$module_dir/manifest.scm"
guix package -I | grep guile
test `guix package -I | wc -l` -eq 1
guix package --rollback --bootstrap

# Applying a manifest file with inferior packages.
cat > "$module_dir/manifest.scm"<<EOF
(use-modules (guix inferior))

(define i
  (open-inferior "$abs_top_srcdir" #:command "scripts/guix"))

(let ((guile (car (lookup-inferior-packages i "guile-bootstrap"))))
  (packages->manifest (list guile)))
EOF
guix package --bootstrap -m "$module_dir/manifest.scm"
guix package -I | grep guile
test `guix package -I | wc -l` -eq 1

# Error reporting.
cat > "$module_dir/manifest.scm"<<EOF
(use-package-modules bootstrap)
(packages->manifest
  (list %bootstrap-guile
        wonderful-package-that-does-not-exist))
EOF
if guix package --bootstrap -n -m "$module_dir/manifest.scm" \
	2> "$module_dir/stderr"
then false
else
    cat "$module_dir/stderr"
    grep "manifest.scm:[1-3]:.*wonderful-package.*: unbound variable" \
	 "$module_dir/stderr"
fi


code:
# GNU Guix --- Functional package management for GNU
# Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
# 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 'guix system', mostly error reporting.
#

set -e

guix system --version

tmpfile="t-guix-system-$$"
errorfile="t-guix-system-error-$$"

# Note: This directory is chosen outside $builddir so that relative file name
# canonicalization doesn't mess up with 'current-source-directory', used by
# 'local-file' ('load' forces 'relative' for
# %FILE-PORT-NAME-CANONICALIZATION.)
tmpdir="${TMPDIR:-/tmp}/t-guix-system-$$"
mkdir "$tmpdir"

trap 'rm -f "$tmpfile" "$errorfile" "$tmpdir"/*; rmdir "$tmpdir"' EXIT

# Reporting of syntax errors.

cat > "$tmpfile"<<EOF
;; This is line 1, and the next one is line 2.
   (operating-system)
;; The 'T' is at column 3.
EOF

if guix system vm "$tmpfile" 2> "$errorfile"
then
    # This must not succeed.
    exit 1
else
    grep "$tmpfile:2:3:.*missing.* initializers" "$errorfile"
fi

cat > "$tmpfile"<<EOF
;; This is line 1, and the next one is line 2.
   (operating-system
;; This is line 3, and there is no closing paren!
EOF

if guix system vm "$tmpfile" 2> "$errorfile"
then
    # This must not succeed.
    exit 1
else
    grep "$tmpfile:4:1: missing closing paren" "$errorfile"
fi

# Reporting of module not found errors.

cat > "$tmpfile" <<EOF
;; Line 1.
(use-modules (gnu))
  (use-service-modules openssh)
EOF

if guix system build "$tmpfile" -n 2> "$errorfile"
then false
else
    grep "$tmpfile:3:2: .*module .*openssh.*not found" "$errorfile"
    grep "Try.*use-service-modules ssh" "$errorfile"
fi

cat > "$tmpfile" <<EOF
;; Line 1.
(use-modules (gnu))
  (use-package-modules qemu)
EOF

if guix system build "$tmpfile" -n 2> "$errorfile"
then false
else
    grep "$tmpfile:3:2: .*module .*qemu.*not found" "$errorfile"
    grep "Try.*use-package-modules virtualization" "$errorfile"
fi

# Reporting of unbound variables.

cat > "$tmpfile" <<EOF
(use-modules (gnu))                                   ; 1
(use-service-modules networking)                      ; 2

(operating-system                                     ; 4
  (host-name "antelope")                              ; 5
  (timezone "Europe/Paris")                           ; 6
  (locale "en_US.UTF-8")                              ; 7

  (bootloader (GRUB-config (device "/dev/sdX")))      ; 9
  (file-systems (cons (file-system
                        (device (file-system-label "root"))
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems)))
EOF

if guix system build "$tmpfile" -n 2> "$errorfile"
then false
else
    if test "`guile -c '(display (effective-version))'`" = 2.2
    then
	# FIXME: With Guile 2.2.0 the error is reported on line 4.
	# See <http://bugs.gnu.org/26107>.
	grep "$tmpfile:[49]:[0-9]\+:.*GRUB-config.*[Uu]nbound variable" "$errorfile"
    else
	grep "$tmpfile:9:[0-9]\+:.*GRUB-config.*[Uu]nbound variable" "$errorfile"
    fi
fi

OS_BASE='
  (host-name "antelope")
  (timezone "Europe/Paris")
  (locale "en_US.UTF-8")

  (bootloader (bootloader-configuration
               (bootloader grub-bootloader)
               (device "/dev/sdX")))
  (file-systems (cons (file-system
                        (device (file-system-label "root"))
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))
'

# Reporting of duplicate service identifiers.

cat > "$tmpfile" <<EOF
(use-modules (gnu))
(use-service-modules networking)

(operating-system
  $OS_BASE
  (services (cons* (dhcp-client-service)
                   (dhcp-client-service) ;twice!
                   %base-services)))
EOF

if guix system vm "$tmpfile" 2> "$errorfile"
then
    # This must not succeed.
    exit 1
else
    grep "service 'networking'.*more than once" "$errorfile"
fi

# Reporting unmet shepherd requirements.

cat > "$tmpfile" <<EOF
(use-modules (gnu) (gnu services shepherd))
(use-service-modules networking)

(define buggy-service-type
  (shepherd-service-type
    'buggy
    (lambda _
      (shepherd-service
        (provision '(buggy!))
        (requirement '(does-not-exist))
        (start #t)))))

(operating-system
  $OS_BASE
  (services (cons (service buggy-service-type #t)
                  %base-services)))
EOF

if guix system build "$tmpfile" 2> "$errorfile"
then
    exit 1
else
    grep "service 'buggy!'.*'does-not-exist'.*not provided" "$errorfile"
fi

# Reporting inconsistent user accounts.

make_user_config ()
{
    cat > "$tmpfile" <<EOF
(use-modules (gnu))
(use-service-modules networking)

(operating-system
  (host-name "antelope")
  (timezone "Europe/Paris")
  (locale "en_US.UTF-8")

  (bootloader (bootloader-configuration
                (bootloader grub-bootloader)
                (device "/dev/sdX")))
  (file-systems (cons (file-system
                        (device (file-system-label "root"))
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))
  (users (list (user-account
                 (name "dave")
                 (home-directory "/home/dave")
                 (group "$1")
                 (supplementary-groups '("$2"))))))
EOF
}

make_user_config "users" "wheel"
guix system build "$tmpfile" -n       # succeeds

guix system build "$tmpfile" -d	      # succeeds
guix system build "$tmpfile" -d | grep '\.drv$'

guix system vm "$tmpfile" -d	      # succeeds
guix system vm "$tmpfile" -d | grep '\.drv$'

# Make sure the behavior is deterministic (<https://bugs.gnu.org/32652>).
drv1="`guix system vm "$tmpfile" -d`"
drv2="`guix system vm "$tmpfile" -d`"
test "$drv1" = "$drv2"
drv1="`guix system disk-image --file-system-type=iso9660 "$tmpfile" -d`"
drv2="`guix system disk-image --file-system-type=iso9660 "$tmpfile" -d`"
test "$drv1" = "$drv2"

make_user_config "group-that-does-not-exist" "users"
if guix system build "$tmpfile" -n 2> "$errorfile"
then false
else grep "primary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi

make_user_config "users" "group-that-does-not-exist"
if guix system build "$tmpfile" -n 2> "$errorfile"
then false
else grep "supplementary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi

# Try 'local-file' and relative file name resolution.

cat > "$tmpdir/config.scm"<<EOF
(use-modules (gnu))
(use-service-modules networking)

(operating-system
  $OS_BASE
  (services (cons (tor-service (local-file "my-torrc"))
                  %base-services)))
EOF

cat > "$tmpdir/my-torrc"<<EOF
# This is an example file.
EOF

# In both cases 'my-torrc' should be properly resolved.
guix system build "$tmpdir/config.scm" -n
(cd "$tmpdir"; guix system build "config.scm" -n)

# Searching.
guix system search tor | grep "^name: tor"
guix system search tor | grep "^shepherdnames: 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


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; 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/>.

(define-module (test-hackage)
  #:use-module (guix import cabal)
  #:use-module (guix import hackage)
  #:use-module (guix tests)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match))

(define test-cabal-1
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal
  build-depends:
    HTTP       >= 4000.2.5 && < 4000.3,
    mtl        >= 2.0      && < 3
")

(define test-cabal-2
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
executable cabal {
build-depends:
  HTTP       >= 4000.2.5 && < 4000.3,
  mtl        >= 2.0      && < 3
}
")

;; Check compiler implementation test with and without spaces.
(define test-cabal-3
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if impl(ghc >= 7.2 && < 7.6)
    Build-depends: ghc-a
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
  if impl(ghc == 7.8)
    Build-depends:
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
")

;; Check "-any", "-none" when name is different.
(define test-cabal-4
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if impl(ghcjs -any)
    Build-depends: ghc-a
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
  if impl(ghc == 7.8)
    Build-depends:
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
")

;; Check "-any", "-none".
(define test-cabal-5
  "name: foo
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
library
  if impl(ghc == 7.8)
    Build-depends:
      HTTP       >= 4000.2.5 && < 4000.3,
  if impl(ghc -any)
    Build-depends: mtl        >= 2.0      && < 3
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
")

;; Check "custom-setup".
(define test-cabal-6
  "name: foo
build-type: Custom
version: 1.0.0
homepage: http://test.org
synopsis: synopsis
description: description
license: BSD3
custom-setup
  setup-depends: base >= 4.7 && < 5,
                 Cabal >= 1.24,
                 haskell-gi == 0.21.*
library
  if impl(ghc>=7.2&&<7.6)
    Build-depends: ghc-b
  if impl(ghc == 7.8)
    Build-depends:
      HTTP       >= 4000.2.5 && < 4000.3,
      mtl        >= 2.0      && < 3
")

;; A fragment of a real Cabal file with minor modification to check precedence
;; of 'and' over 'or', missing final newline, spaces between keywords and
;; parentheses and between key and column.
(define test-read-cabal-1
  "name: test-me
library
  -- Choose which library versions to use.
  if flag(base4point8)
    Build-depends: base >= 4.8 && < 5
  else
    if flag(base4)
      Build-depends: base >= 4 && < 4.8
    else
      if flag(base3)
        Build-depends: base >= 3 && < 4
      else
        Build-depends: base < 3
  if flag(base4point8) || flag (base4) && flag(base3)
    Build-depends: random
  Build-depends : containers

  -- Modules that are always built.
  Exposed-Modules:
    Test.QuickCheck.Exception")

(test-begin "hackage")

(define* (eval-test-with-cabal test-cabal #:key (cabal-environment '()))
  (mock
   ((guix import hackage) hackage-fetch
    (lambda (name-version)
      (call-with-input-string test-cabal
        read-cabal)))
   (match (hackage->guix-package "foo" #:cabal-environment cabal-environment)
     (('package
        ('name "ghc-foo")
        ('version "1.0.0")
        ('source
         ('origin
           ('method 'url-fetch)
           ('uri ('string-append
                  "https://hackage.haskell.org/package/foo/foo-"
                  'version
                  ".tar.gz"))
           ('sha256
            ('base32
             (? string? hash)))))
        ('build-system 'haskell-build-system)
        ('inputs
         ('quasiquote
          (("ghc-http" ('unquote 'ghc-http))
           ("ghc-mtl" ('unquote 'ghc-mtl)))))
        ('home-page "http://test.org")
        ('synopsis (? string?))
        ('description (? string?))
        ('license 'bsd-3))
      #t)
     (x
      (pk 'fail x #f)))))

(test-assert "hackage->guix-package test 1"
  (eval-test-with-cabal test-cabal-1))

(test-assert "hackage->guix-package test 2"
  (eval-test-with-cabal test-cabal-2))

(test-assert "hackage->guix-package test 3"
  (eval-test-with-cabal test-cabal-3
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(test-assert "hackage->guix-package test 4"
  (eval-test-with-cabal test-cabal-4
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(test-assert "hackage->guix-package test 5"
  (eval-test-with-cabal test-cabal-5
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(test-assert "hackage->guix-package test 6"
  (eval-test-with-cabal test-cabal-6
                        #:cabal-environment '(("impl" . "ghc-7.8"))))

(test-assert "read-cabal test 1"
  (match (call-with-input-string test-read-cabal-1 read-cabal)
    ((("name" ("test-me"))
      ('section 'library
               (('if ('flag "base4point8")
                    (("build-depends" ("base >= 4.8 && < 5")))
                    (('if ('flag "base4")
                         (("build-depends" ("base >= 4 && < 4.8")))
                         (('if ('flag "base3")
                              (("build-depends" ("base >= 3 && < 4")))
                              (("build-depends" ("base < 3"))))))))
                ('if ('or ('flag "base4point8")
                          ('and ('flag "base4") ('flag "base3")))
                    (("build-depends" ("random")))
                    ())
                ("build-depends" ("containers"))
                ("exposed-modules" ("Test.QuickCheck.Exception")))))
     #t)
    (x (pk 'fail x #f))))

(test-end "hackage")


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@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/>.

(define-module (test-import-utils)
  #:use-module (guix tests)
  #:use-module (guix import utils)
  #:use-module ((guix licenses) #:prefix license:)
  #:use-module (guix packages)
  #:use-module (guix build-system)
  #:use-module (srfi srfi-64))

(test-begin "import-utils")

(test-equal "beautify-description: use double spacing"
  "This is a package.  It is great.  Trust me Mr.  Hendrix."
  (beautify-description
   "This is a package. It is great. Trust me Mr. Hendrix."))

(test-equal "beautify-description: transform fragment into sentence"
  "This package provides a function to establish world peace"
  (beautify-description "A function to establish world peace"))

(test-equal "license->symbol"
  'license:lgpl2.0
  (license->symbol license:lgpl2.0))

(test-assert "alist->package with simple source"
  (let* ((meta '(("name" . "hello")
                 ("version" . "2.10")
                 ("source" .
                  ;; Use a 'file://' URI so that we don't cause a download.
                  ,(string-append "file://"
                                  (search-path %load-path "guix.scm")))
                 ("build-system" . "gnu")
                 ("home-page" . "https://gnu.org")
                 ("synopsis" . "Say hi")
                 ("description" . "This package says hi.")
                 ("license" . "GPL-3.0+")))
         (pkg (alist->package meta)))
    (and (package? pkg)
         (license:license? (package-license pkg))
         (build-system? (package-build-system pkg))
         (origin? (package-source pkg)))))

(test-assert "alist->package with explicit source"
  (let* ((meta '(("name" . "hello")
                 ("version" . "2.10")
                 ("source" . (("method" . "url-fetch")
                              ("uri"    . "mirror://gnu/hello/hello-2.10.tar.gz")
                              ("sha256" .
                               (("base32" .
                                 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
                 ("build-system" . "gnu")
                 ("home-page" . "https://gnu.org")
                 ("synopsis" . "Say hi")
                 ("description" . "This package says hi.")
                 ("license" . "GPL-3.0+")))
         (pkg (alist->package meta)))
    (and (package? pkg)
         (license:license? (package-license pkg))
         (build-system? (package-build-system pkg))
         (origin? (package-source pkg))
         (equal? (origin-sha256 (package-source pkg))
                 (base32 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))

(test-equal "alist->package with false license"  ;<https://bugs.gnu.org/30470>
  'license-is-false
  (let* ((meta '(("name" . "hello")
                 ("version" . "2.10")
                 ("source" . (("method" . "url-fetch")
                              ("uri"    . "mirror://gnu/hello/hello-2.10.tar.gz")
                              ("sha256" .
                               (("base32" .
                                 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
                 ("build-system" . "gnu")
                 ("home-page" . "https://gnu.org")
                 ("synopsis" . "Say hi")
                 ("description" . "This package says hi.")
                 ("license" . #f))))
    ;; Note: Use 'or' because comparing with #f otherwise succeeds when
    ;; there's an exception instead of an actual #f.
    (or (package-license (alist->package meta))
        'license-is-false)))

(test-end "import-utils")


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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/>.

(define-module (test-inferior)
  #:use-module (guix tests)
  #:use-module (guix inferior)
  #:use-module (guix packages)
  #:use-module (guix store)
  #:use-module (guix profiles)
  #:use-module (guix derivations)
  #:use-module (gnu packages)
  #:use-module (gnu packages bootstrap)
  #:use-module (gnu packages guile)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match))

(define %top-srcdir
  (dirname (search-path %load-path "guix.scm")))

(define %top-builddir
  (dirname (search-path %load-compiled-path "guix.go")))

(define %store
  (open-connection-for-tests))

(define (manifest-entry->list entry)
  (list (manifest-entry-name entry)
        (manifest-entry-version entry)
        (manifest-entry-output entry)
        (manifest-entry-search-paths entry)
        (map manifest-entry->list (manifest-entry-dependencies entry))))

(test-begin "inferior")

(test-equal "open-inferior"
  '(42 #t)
  (let ((inferior (open-inferior %top-builddir
                                 #:command "scripts/guix")))
    (and (inferior? inferior)
         (let ((a (inferior-eval '(apply * '(6 7)) inferior))
               (b (inferior-eval '(@ (gnu packages base) coreutils)
                                 inferior)))
           (close-inferior inferior)
           (list a (inferior-object? b))))))

(test-equal "inferior-packages"
  (take (sort (fold-packages (lambda (package lst)
                               (cons (list (package-name package)
                                           (package-version package)
                                           (package-home-page package)
                                           (package-location package))
                                     lst))
                             '())
              (lambda (x y)
                (string<? (car x) (car y))))
        10)
  (let* ((inferior (open-inferior %top-builddir
                                  #:command "scripts/guix"))
         (packages (inferior-packages inferior)))
    (and (every string? (map inferior-package-synopsis packages))
         (let ()
           (define result
             (take (sort (map (lambda (package)
                                (list (inferior-package-name package)
                                      (inferior-package-version package)
                                      (inferior-package-home-page package)
                                      (inferior-package-location package)))
                              packages)
                         (lambda (x y)
                           (string<? (car x) (car y))))
                   10))
           (close-inferior inferior)
           result))))

(test-equal "lookup-inferior-packages"
  (let ((->list (lambda (package)
                  (list (package-name package)
                        (package-version package)
                        (package-location package)))))
    (list (map ->list (find-packages-by-name "guile" #f))
          (map ->list (find-packages-by-name "guile" "2.2"))))
  (let* ((inferior (open-inferior %top-builddir
                                  #:command "scripts/guix"))
         (->list   (lambda (package)
                     (list (inferior-package-name package)
                           (inferior-package-version package)
                           (inferior-package-location package))))
         (lst1     (map ->list
                        (lookup-inferior-packages inferior "guile")))
         (lst2     (map ->list
                        (lookup-inferior-packages inferior
                                                  "guile" "2.2"))))
    (close-inferior inferior)
    (list lst1 lst2)))

(test-assert "lookup-inferior-packages and eq?-ness"
  (let* ((inferior (open-inferior %top-builddir
                                  #:command "scripts/guix"))
         (lst1     (lookup-inferior-packages inferior "guile"))
         (lst2     (lookup-inferior-packages inferior "guile")))
    (close-inferior inferior)
    (every eq? lst1 lst2)))

(test-equal "inferior-package-inputs"
  (let ((->list (match-lambda
                  ((label (? package? package) . rest)
                   `(,label
                     (package ,(package-name package)
                              ,(package-version package)
                              ,(package-location package))
                     ,@rest)))))
    (list (map ->list (package-inputs guile-2.2))
          (map ->list (package-native-inputs guile-2.2))
          (map ->list (package-propagated-inputs guile-2.2))))
  (let* ((inferior (open-inferior %top-builddir
                                  #:command "scripts/guix"))
         (guile    (first (lookup-inferior-packages inferior "guile")))
         (->list   (match-lambda
                     ((label (? inferior-package? package) . rest)
                      `(,label
                        (package ,(inferior-package-name package)
                                 ,(inferior-package-version package)
                                 ,(inferior-package-location package))
                        ,@rest))))
         (result   (list (map ->list (inferior-package-inputs guile))
                         (map ->list
                              (inferior-package-native-inputs guile))
                         (map ->list
                              (inferior-package-propagated-inputs
                               guile)))))
    (close-inferior inferior)
    result))

(test-equal "inferior-package-search-paths"
  (package-native-search-paths guile-2.2)
  (let* ((inferior (open-inferior %top-builddir
                                  #:command "scripts/guix"))
         (guile    (first (lookup-inferior-packages inferior "guile")))
         (result   (inferior-package-native-search-paths guile)))
    (close-inferior inferior)
    result))

(test-equal "inferior-package-derivation"
  (map derivation-file-name
       (list (package-derivation %store %bootstrap-guile "x86_64-linux")
             (package-derivation %store %bootstrap-guile "armhf-linux")))
  (let* ((inferior (open-inferior %top-builddir
                                  #:command "scripts/guix"))
         (packages (inferior-packages inferior))
         (guile    (find (lambda (package)
                           (string=? (package-name %bootstrap-guile)
                                     (inferior-package-name package)))
                         packages)))
    (map derivation-file-name
         (list (inferior-package-derivation %store guile "x86_64-linux")
               (inferior-package-derivation %store guile "armhf-linux")))))

(test-equal "inferior-package->manifest-entry"
  (manifest-entry->list (package->manifest-entry
                         (first (find-best-packages-by-name "guile" #f))))
  (let* ((inferior (open-inferior %top-builddir
                                  #:command "scripts/guix"))
         (guile    (first (lookup-inferior-packages inferior "guile")))
         (entry    (inferior-package->manifest-entry guile)))
    (close-inferior inferior)
    (manifest-entry->list entry)))

(test-equal "packages->manifest"
  (map manifest-entry->list
       (manifest-entries (packages->manifest
                          (find-best-packages-by-name "guile" #f))))
  (let* ((inferior (open-inferior %top-builddir
                                  #:command "scripts/guix"))
         (guile    (first (lookup-inferior-packages inferior "guile")))
         (manifest (packages->manifest (list guile))))
    (close-inferior inferior)
    (map manifest-entry->list (manifest-entries manifest))))

(test-end "inferior")