diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/containers.scm | 8 | ||||
| -rw-r--r-- | tests/guix-archive.sh | 9 | ||||
| -rw-r--r-- | tests/guix-authenticate.sh | 52 | ||||
| -rw-r--r-- | tests/guix-build-branch.sh | 3 | ||||
| -rw-r--r-- | tests/guix-build.sh | 33 | ||||
| -rw-r--r-- | tests/guix-daemon.sh | 2 | ||||
| -rw-r--r-- | tests/guix-download.sh | 12 | ||||
| -rw-r--r-- | tests/guix-environment-container.sh | 25 | ||||
| -rw-r--r-- | tests/guix-environment.sh | 8 | ||||
| -rw-r--r-- | tests/guix-gc.sh | 13 | ||||
| -rw-r--r-- | tests/guix-git-authenticate.sh | 5 | ||||
| -rw-r--r-- | tests/guix-graph.sh | 7 | ||||
| -rw-r--r-- | tests/guix-hash.sh | 12 | ||||
| -rw-r--r-- | tests/guix-lint.sh | 18 | ||||
| -rw-r--r-- | tests/guix-pack-relocatable.sh | 3 | ||||
| -rw-r--r-- | tests/guix-pack.sh | 3 | ||||
| -rw-r--r-- | tests/guix-package-aliases.sh | 20 | ||||
| -rw-r--r-- | tests/guix-package-net.sh | 9 | ||||
| -rw-r--r-- | tests/guix-package.sh | 66 | ||||
| -rw-r--r-- | tests/guix-repl.sh | 4 | ||||
| -rw-r--r-- | tests/guix-system.sh | 23 | ||||
| -rw-r--r-- | tests/opam.scm | 139 | ||||
| -rw-r--r-- | tests/openpgp.scm | 12 | ||||
| -rw-r--r-- | tests/packages.scm | 172 | ||||
| -rw-r--r-- | tests/scripts-build.scm | 26 | ||||
| -rw-r--r-- | tests/store.scm | 44 |
26 files changed, 476 insertions, 252 deletions
diff --git a/tests/containers.scm b/tests/containers.scm index 7b63e5c108..608902c41a 100644 --- a/tests/containers.scm +++ b/tests/containers.scm @@ -134,6 +134,14 @@ (primitive-exit 0))))) (skip-if-unsupported) +(test-assert "call-with-container, mnt namespace, root permissions" + (zero? + (call-with-container '() + (lambda () + (assert-exit (= #o755 (stat:perms (lstat "/"))))) + #:namespaces '(user mnt)))) + +(skip-if-unsupported) (test-assert "container-excursion" (call-with-temporary-directory (lambda (root) diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh index 4c5eea05cf..e796c62f9a 100644 --- a/tests/guix-archive.sh +++ b/tests/guix-archive.sh @@ -44,8 +44,7 @@ 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 +! guix archive something-that-does-not-exist # This one must not be listed as missing. guix build guile-bootstrap > "$archive" @@ -62,8 +61,7 @@ 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 +! guix archive --missing < "$archive" # Check '--extract'. guile -c "(use-modules (guix serialization)) @@ -79,5 +77,4 @@ guix archive -t < "$archive" | grep "^D /share/guile" guix archive -t < "$archive" | grep "^x /bin/guile" guix archive -t < "$archive" | grep "^r /share/guile.*/boot-9\.scm" -if echo foo | guix archive --authorize -then false; else true; fi +! echo foo | guix archive --authorize diff --git a/tests/guix-authenticate.sh b/tests/guix-authenticate.sh index 773443453d..3a05b232c1 100644 --- a/tests/guix-authenticate.sh +++ b/tests/guix-authenticate.sh @@ -28,33 +28,47 @@ rm -f "$sig" "$hash" trap 'rm -f "$sig" "$hash"' EXIT +key="$abs_top_srcdir/tests/signing-key.sec" +key_len="`echo -n $key | wc -c`" + # A hexadecimal string as long as a sha256 hash. hash="2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb" +hash_len="`echo -n $hash | wc -c`" -guix authenticate sign \ - "$abs_top_srcdir/tests/signing-key.sec" \ - "$hash" > "$sig" +echo "sign $key_len:$key $hash_len:$hash" | guix authenticate > "$sig" test -f "$sig" +case "$(cat $sig)" in + "0 "*) ;; + *) echo "broken signature: $(cat $sig)" + exit 42;; +esac + +# Remove the leading "0". +sed -i "$sig" -e's/^0 //g' -hash2="`guix authenticate verify "$sig"`" -test "$hash2" = "$hash" +hash2="$(echo verify $(cat "$sig") | guix authenticate)" +test "$(echo $hash2 | cut -d : -f 2)" = "$hash" # Detect corrupt signatures. -if guix authenticate verify /dev/null -then false -else true -fi +code="$(echo "verify 5:wrong" | guix authenticate | cut -f1 -d ' ')" +test "$code" -ne 0 # 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 verify "$sig" -then false -else true -fi +code="$(echo "verify $(cat $sig)" | guix authenticate | cut -f1 -d ' ')" +test "$code" -ne 0 +# Make sure byte strings are correctly encoded. The hash string below is +# "café" repeated 8 times. Libgcrypt would normally choose to write it as a +# string rather than a hex sequence. We want that string to be Latin-1 +# encoded independently of the current locale: <https://bugs.gnu.org/43421>. +hash="636166e9636166e9636166e9636166e9636166e9636166e9636166e9636166e9" +latin1_cafe="caf$(printf '\351')" +echo "sign 21:tests/signing-key.sec 64:$hash" | guix authenticate \ + | LC_ALL=C grep "hash sha256 \"$latin1_cafe" # Test for <http://bugs.gnu.org/17312>: make sure 'guix authenticate' produces # valid signatures when run in the C locale. @@ -63,9 +77,11 @@ hash="5eff0b55c9c5f5e87b4e34cd60a2d5654ca1eb78c7b3c67c3179fed1cff07b4c" LC_ALL=C export LC_ALL -guix authenticate sign "$abs_top_srcdir/tests/signing-key.sec" "$hash" \ - > "$sig" +echo "sign $key_len:$key $hash_len:$hash" | guix authenticate > "$sig" + +# Remove the leading "0". +sed -i "$sig" -e's/^0 //g' -guix authenticate verify "$sig" -hash2="`guix authenticate verify "$sig"`" -test "$hash2" = "$hash" +echo "verify $(cat $sig)" | guix authenticate +hash2="$(echo "verify $(cat $sig)" | guix authenticate | cut -f2 -d ' ')" +test "$(echo $hash2 | cut -d : -f 2)" = "$hash" diff --git a/tests/guix-build-branch.sh b/tests/guix-build-branch.sh index c5b07e07c6..79aa06a58f 100644 --- a/tests/guix-build-branch.sh +++ b/tests/guix-build-branch.sh @@ -58,5 +58,4 @@ guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-8fe64e8 # this is the tag ID test "$v0_1_0_drv" != "$latest_drv" test "$v0_1_0_drv" != "$orig_drv" -if guix build guix --with-commit=guile-gcrypt=000 -d -then false; else true; fi +! guix build guix --with-commit=guile-gcrypt=000 -d diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 6c08857358..6dbb53206e 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -24,8 +24,7 @@ guix build --version # Should fail. -if guix build -e +; -then false; else true; fi +! guix build -e + # Source-less packages are accepted; they just return nothing. guix build -e '(@ (gnu packages bootstrap) %bootstrap-glibc)' -S @@ -178,7 +177,7 @@ cat > "$module_dir/foo.scm" <<EOF (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 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 @@ -222,7 +221,7 @@ 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 +! guix build hello-0.0.1 -n # Keep a symlink to the result, registered as a root. result="t-result-$$" @@ -231,8 +230,7 @@ guix build -r "$result" \ 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 +! guix build -r "$result" -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' rm -f "$result" @@ -259,8 +257,18 @@ 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 +# See <https://bugs.gnu.org/42156>. +drv1=`guix build glib -d` +drv2=`guix build glib -d --with-input=libreoffice=inkscape` +test "$drv1" = "$drv2" + +# Rewriting implicit inputs. +drv1=`guix build hello -d` +drv2=`guix build hello -d --with-input=gcc=gcc-toolchain` +test "$drv1" != "$drv2" +guix gc -R "$drv2" | grep `guix build -d gcc-toolchain` + +! guix build guile --with-input=libunistring=something-really-silly # Deprecated/superseded packages. test "`guix build superseded -d`" = "`guix build bar -d`" @@ -268,10 +276,8 @@ 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 +! guix build -n time@3.2 # FAIL, version not found +! guix build -n something-that-will-never-exist # FAIL # Invoking a monadic procedure. guix build -e "(begin @@ -343,5 +349,4 @@ export GUIX_BUILD_OPTIONS guix build emacs GUIX_BUILD_OPTIONS="--something-completely-crazy" -if guix build emacs; -then false; else true; fi +! guix build emacs diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index b58500966b..330ad68835 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -224,7 +224,7 @@ daemon_pid=$! GUIX_DAEMON_SOCKET="guix://$tcp_socket" export GUIX_DAEMON_SOCKET -if guix gc; then false; else true; fi +! guix gc unset GUIX_DAEMON_SOCKET kill "$daemon_pid" diff --git a/tests/guix-download.sh b/tests/guix-download.sh index 30f55fbe2b..5475d43e60 100644 --- a/tests/guix-download.sh +++ b/tests/guix-download.sh @@ -23,14 +23,11 @@ guix download --version # Make sure it fails here. -if guix download http://does.not/exist -then false; else true; fi +! guix download http://does.not/exist -if guix download unknown://some/where; -then false; else true; fi +! guix download unknown://some/where; -if guix download /does-not-exist -then false; else true; fi +! guix download /does-not-exist # This one should succeed. guix download "file://$abs_top_srcdir/README" @@ -46,5 +43,4 @@ GUIX_DAEMON_SOCKET="/nowhere" guix download -o "$output" \ 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 +! guix download "file:///does-not-exist" "file://$abs_top_srcdir/README" diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index 45264d4978..f2d15c8d0c 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -44,6 +44,21 @@ else test $? = 42 fi +# Make sure "localhost" resolves. +guix environment --container --ad-hoc --bootstrap guile-bootstrap \ + -- guile -c '(exit (pair? (getaddrinfo "localhost" "80")))' + +# We should get ECONNREFUSED, not ENETUNREACH, which would indicate that "lo" +# is down. +guix environment --container --ad-hoc --bootstrap guile-bootstrap \ + -- guile -c "(exit (= ECONNREFUSED + (catch 'system-error + (lambda () + (let ((sock (socket AF_INET SOCK_STREAM 0))) + (connect sock AF_INET INADDR_LOOPBACK 12345))) + (lambda args + (pk 'errno (system-error-errno args))))))" + # Make sure '--preserve' is honored. result="`FOOBAR=42; export FOOBAR; guix environment -C --ad-hoc --bootstrap \ guile-bootstrap -E ^FOO -- guile -c '(display (getenv \"FOOBAR\"))'`" @@ -127,11 +142,15 @@ grep -e "$NIX_STORE_DIR/.*-bash" $tmpdir/mounts # bootstrap bash rm $tmpdir/mounts -# Make sure 'GUIX_ENVIRONMENT' is linked to '~/.guix-profile' when requested +# Make sure 'GUIX_ENVIRONMENT' is set to '~/.guix-profile' when requested # within a container. ( - linktest='(exit (string=? (getenv "GUIX_ENVIRONMENT") -(readlink (string-append (getenv "HOME") "/.guix-profile"))))' + linktest=' +(exit (and (string=? (getenv "GUIX_ENVIRONMENT") + (string-append (getenv "HOME") "/.guix-profile")) + (string-prefix? "'"$NIX_STORE_DIR"'" + (readlink (string-append (getenv "HOME") + "/.guix-profile")))))' cd "$tmpdir" \ && guix environment --bootstrap --container --link-profile \ diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh index 2faf38df06..f8be48f0c0 100644 --- a/tests/guix-environment.sh +++ b/tests/guix-environment.sh @@ -60,7 +60,7 @@ guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ grep '^PATH=' "$tmpdir/a" grep '^GUIX_TEST_ABC=' "$tmpdir/a" grep '^GUIX_TEST_DEF=' "$tmpdir/a" -if grep '^GUIX_TEST_XYZ=' "$tmpdir/a"; then false; else true; fi +! grep '^GUIX_TEST_XYZ=' "$tmpdir/a" # Make sure the exit value is preserved. if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \ @@ -194,8 +194,7 @@ then done # 'make-boot0' itself must not be listed. - if guix gc --references "$profile" | grep make-boot0 - then false; else true; fi + ! guix gc --references "$profile" | grep make-boot0 # Make sure that the shell spawned with '--exec' sees the same environment # as returned by '--search-paths'. @@ -212,8 +211,7 @@ then 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 + ! guix gc --references "$profile" | grep "$make_boot0_debug" # Compute the build environment for the initial GNU Make, but add in the # bootstrap Guile as an ad-hoc addition. diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh index 8284287730..f40619876d 100644 --- a/tests/guix-gc.sh +++ b/tests/guix-gc.sh @@ -36,11 +36,11 @@ unset out # For some operations, passing extra arguments is an error. for option in "" "-C 500M" "--verify" "--optimize" "--list-roots" do - if guix gc $option whatever; then false; else true; fi + ! guix gc $option whatever done # This should fail. -if guix gc --verify=foo; then false; else true; fi +! guix gc --verify=foo # Check the references of a .drv. drv="`guix build guile-bootstrap -d`" @@ -51,8 +51,7 @@ 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 +! guix gc --references /dev/null; # Check derivers. guix gc --derivers "$out" | grep "$drv" @@ -72,8 +71,7 @@ test -f "$drv" && test -L guix-gc-root guix gc --list-roots | grep "$PWD/guix-gc-root" guix gc --list-live | grep "$drv" -if guix gc --delete "$drv"; -then false; else true; fi +! guix gc --delete "$drv"; rm guix-gc-root guix gc --list-dead | grep "$drv" @@ -84,8 +82,7 @@ guix gc --delete "$drv" guix gc -C 1KiB # Check trivial error cases. -if guix gc --delete /dev/null; -then false; else true; fi +! guix gc --delete /dev/null; # Bug #19757 out="`guix build guile-bootstrap`" diff --git a/tests/guix-git-authenticate.sh b/tests/guix-git-authenticate.sh index 1c76e240b5..8ebbea398b 100644 --- a/tests/guix-git-authenticate.sh +++ b/tests/guix-git-authenticate.sh @@ -46,9 +46,8 @@ v1_0_0_signer="3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5" # civodul v1_0_1_commit="d68de958b60426798ed62797ff7c96c327a672ac" # This should fail because these commits lack '.guix-authorizations'. -if guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \ - --cache-key="$cache_key" --end="$v1_0_1_commit"; -then false; else true; fi +! guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \ + --cache-key="$cache_key" --end="$v1_0_1_commit" # This should work thanks to '--historical-authorizations'. guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \ diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh index ccb4933c88..666660ab4b 100644 --- a/tests/guix-graph.sh +++ b/tests/guix-graph.sh @@ -60,7 +60,7 @@ 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 +! guix graph -e + # Try passing store file names. @@ -77,14 +77,13 @@ cmp "$tmpfile1" "$tmpfile2" # Try package transformation options. guix graph git | grep 'label = "openssl' guix graph git --with-input=openssl=libressl | grep 'label = "libressl' -if guix graph git --with-input=openssl=libressl | grep 'label = "openssl' -then false; else true; fi +! guix graph git --with-input=openssl=libressl | grep 'label = "openssl' # Try --load-path guix graph -L $module_dir dummy | grep 'label = "dummy' # Displaying shortest paths (or lack thereof). -if guix graph --path emacs vim; then false; else true; fi +! guix graph --path emacs vim path="\ emacs diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh index 3538b9aeda..346355539f 100644 --- a/tests/guix-hash.sh +++ b/tests/guix-hash.sh @@ -34,8 +34,7 @@ test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfes test `guix hash -H sha512 -f hex /dev/null` = cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e test `guix hash -H sha1 -f base64 /dev/null` = "2jmj7l5rSw0yVb/vlWAYkK/YBwk=" -if guix hash -H abcd1234 /dev/null; -then false; else true; fi +! guix hash -H abcd1234 /dev/null mkdir "$tmpdir" echo -n executable > "$tmpdir/exe" @@ -46,13 +45,11 @@ mkdir "$tmpdir/subdir" test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p # Without '-r', this should fail. -if guix hash "$tmpdir" -then false; else true; fi +! guix hash "$tmpdir" # 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 +! guix hash -r /dev/null # Adding a .git directory mkdir "$tmpdir/.git" @@ -65,6 +62,5 @@ test `guix hash -r $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m test `guix hash -r $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p # Without '-r', this should fail. -if guix hash "$tmpdir" -then false; else true; fi +! guix hash "$tmpdir" diff --git a/tests/guix-lint.sh b/tests/guix-lint.sh index ebe79efb84..fdf548fbf1 100644 --- a/tests/guix-lint.sh +++ b/tests/guix-lint.sh @@ -58,24 +58,19 @@ grep_warning () # 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 +test `grep_warning "$out"` -eq 3 out=`guix lint -c synopsis dummy 2>&1` -if [ `grep_warning "$out"` -ne 2 ] -then false; else true; fi +test `grep_warning "$out"` -eq 2 out=`guix lint -c description dummy 2>&1` -if [ `grep_warning "$out"` -ne 1 ] -then false; else true; fi +test `grep_warning "$out"` -eq 1 out=`guix lint -c description,synopsis dummy 2>&1` -if [ `grep_warning "$out"` -ne 3 ] -then false; else true; fi +test `grep_warning "$out"` -eq 3 -if guix lint -c synopsis,invalid-checker dummy 2>&1 | \ +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 @@ -85,8 +80,7 @@ guix lint -c inputs-should-be-native dummy dummy@42 dummy unset GUIX_PACKAGE_PATH out=`guix lint -L $module_dir -c synopsis,description dummy 2>&1` -if [ `grep_warning "$out"` -ne 3 ] -then false; else true; fi +test `grep_warning "$out"` -eq 3 # Make sure specifying multiple packages works. guix lint -L $module_dir -c inputs-should-be-native dummy dummy@42 dummy diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh index b8d36a02c6..a960ecd209 100644 --- a/tests/guix-pack-relocatable.sh +++ b/tests/guix-pack-relocatable.sh @@ -77,8 +77,7 @@ then grep 'GNU sed' "$test_directory/output" # Check whether the exit code is preserved. - if run_without_store "$test_directory/Bin/sed" --does-not-exist; - then false; else true; fi + ! run_without_store "$test_directory/Bin/sed" --does-not-exist chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/* else diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index 39b64791e2..0339221ac2 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -45,8 +45,7 @@ guix gc -R "$drv" | grep "`guix build coreutils -d --no-grafts`" drv="`guix pack idutils -d --no-grafts --target=arm-linux-gnueabihf`" guix gc -R "$drv" | \ grep "`guix build idutils --target=arm-linux-gnueabihf -d --no-grafts`" -if guix gc -R "$drv" | grep "`guix build idutils -d --no-grafts`"; -then false; else true; fi +! guix gc -R "$drv" | grep "`guix build idutils -d --no-grafts`" # Build a tarball with no compression. guix pack --compression=none --bootstrap guile-bootstrap diff --git a/tests/guix-package-aliases.sh b/tests/guix-package-aliases.sh index e24bff3a56..311838b768 100644 --- a/tests/guix-package-aliases.sh +++ b/tests/guix-package-aliases.sh @@ -36,26 +36,28 @@ guix install --bootstrap guile-bootstrap -p "$profile" test -x "$profile/bin/guile" # Make sure '-r' isn't passed as-is to 'guix package'. -if guix install -r guile-bootstrap -p "$profile" --bootstrap -then false; else true; fi +! guix install -r guile-bootstrap -p "$profile" --bootstrap test -x "$profile/bin/guile" +# Use a package transformation option and make sure it's recorded. +guix install --bootstrap guile-bootstrap -p "$profile" \ + --with-input=libreoffice=inkscape +test -x "$profile/bin/guile" +grep "libreoffice=inkscape" "$profile/manifest" + guix upgrade --version guix upgrade -n guix upgrade gui.e -n -if guix upgrade foo bar -n; -then false; else true; fi +! guix upgrade foo bar -n; guix remove --version guix remove --bootstrap guile-bootstrap -p "$profile" ! test -x "$profile/bin/guile" test `guix package -p "$profile" -I | wc -l` -eq 0 -if guix remove -p "$profile" this-is-not-installed --bootstrap -then false; else true; fi +! guix remove -p "$profile" this-is-not-installed --bootstrap -if guix remove -i guile-bootstrap -p "$profile" --bootstrap -then false; else true; fi +! guix remove -i guile-bootstrap -p "$profile" --bootstrap guix search '\<board\>' game | grep '^name: gnubg' @@ -64,7 +66,7 @@ guix show guile guix show python@3 | grep "^name: python" # "python@2" exists but is deprecated; make sure it doesn't show up. -if guix show python@2; then false; else true; fi +! guix show python@2 # Specifying multiple packages. output="`guix show sed grep | grep ^name:`" diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh index 3876701fa2..6d21c6cff6 100644 --- a/tests/guix-package-net.sh +++ b/tests/guix-package-net.sh @@ -95,10 +95,8 @@ 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 +! guix package -p "$profile" --list-generations=42 +! guix package -p "$profile" --switch-generation=99 # Remove a package. guix package --bootstrap -p "$profile" -r "guile-bootstrap" @@ -174,8 +172,7 @@ test -z "`guix package -p "$profile" -l 3`" 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" --search-paths | grep LIBRARY_PATH guix package -p "$profile" -p "$profile_alt" --search-paths \ | grep "LIBRARY_PATH.*$profile/lib.$profile_alt/lib" diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 1f955257be..3e5fa71d20 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> # # This file is part of GNU Guix. @@ -36,8 +36,7 @@ rm -f "$profile" "$tmpfile" trap 'rm -f "$profile" "$profile.lock" "$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 +! guix package --bootstrap -e + # Install a store item and make sure the version and output in the manifest # are correct. @@ -62,8 +61,7 @@ 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 guix package --bootstrap -n -p "$profile" -i g-wrap guile@2.0 \ --allow-collisions @@ -78,8 +76,7 @@ test "`guix package -p "$profile" --search-paths | wc -l`" = 1 # $PATH 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 +! guix package -p "$profile" --delete-generations=42 # Exit with 0 when trying to delete the zeroth generation. guix package -p "$profile" --delete-generations=0 @@ -92,15 +89,12 @@ 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 +! guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile" -n +! guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile" # Make sure we get an error when trying to remove something that's not # installed. -if guix package --bootstrap -r something-not-installed -p "$profile"; -then false; else true; fi +! guix package --bootstrap -r something-not-installed -p "$profile" # Check whether `--list-available' returns something sensible. guix package -p "$profile" -A 'gui.*e' | grep guile @@ -112,8 +106,8 @@ guix package --show=guile | grep "^name: guile" guix package --show=texlive # Fail for non-existent packages or package/version pairs. -if guix package --show=does-not-exist; then false; else true; fi -if guix package --show=emacs@42; then false; else true; fi +! guix package --show=does-not-exist +! guix package --show=emacs@42 # Search. LC_MESSAGES=C @@ -157,22 +151,19 @@ 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 +! guix package -p "$profile" --delete-generations=12m 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 +! guix package --bootstrap -p "$profile" --delete-generations=1.. 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 +! guix gc -d "$real_profile" test -d "$real_profile" # Now, let's remove all the symlinks to $real_profile, and make sure @@ -193,6 +184,21 @@ grep -E 'emacs[[:blank:]]+42\.5\.9rc7' "$tmpfile" rm "$emacs_tarball" "$tmpfile" rmdir "$module_dir" +# Install with package transformations. +guix install --bootstrap -p "$profile" sed --with-input=sed=guile-bootstrap +grep "sed=guile-bootstrap" "$profile/manifest" +test "$(readlink -f "$profile/bin/guile")" \ + = "$(guix build guile-bootstrap)/bin/guile" +test ! -f "$profile/bin/sed" + +# Make sure the package transformation is preserved. +guix package --bootstrap -p "$profile" -u +grep "sed=guile-bootstrap" "$profile/manifest" +test "$(readlink -f "$profile/bin/guile")" \ + = "$(guix build guile-bootstrap)/bin/guile" +test ! -f "$profile/bin/sed" +rm "$profile" "$profile"-[0-9]-link + # 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>. @@ -238,16 +244,15 @@ 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 +! test -e "$HOME/.guix-profile-0-link" +! test -e "$HOME/.guix-profile-1-link" guix package --bootstrap -p "$HOME/.guix-profile" -i guile-bootstrap -if test -e "$HOME/.guix-profile-1-link"; then false; fi +! test -e "$HOME/.guix-profile-1-link" guix package --bootstrap --roll-back -p "$HOME/.guix-profile" -if test -e "$HOME/.guix-profile-0-link"; then false; fi +! test -e "$HOME/.guix-profile-0-link" # Extraneous argument. -if guix package install foo-bar; -then false; else true; fi +! guix package install foo-bar # Make sure the "broken pipe" doesn't yield an error. # Note: 'pipefail' is a Bash-specific option. @@ -267,7 +272,7 @@ cat > "$module_dir/foo.scm"<<EOF (define-public x (package (inherit emacs) (name "emacs-foo-bar") - (version "42"))) + (version "42.77.0"))) EOF guix package -A emacs-foo-bar -L "$module_dir" | grep 42 @@ -308,7 +313,7 @@ cat > "$module_dir/foo.scm"<<EOF (source (origin (inherit (package-source emacs)) (patches (list (search-patch "emacs.patch"))))) (name "emacs-foo-bar-patched") - (version "42"))) + (version "42.42.42"))) (define-public y (package (inherit emacs) @@ -336,8 +341,7 @@ cat > "$module_dir/package.scm"<<EOF (define my-package coreutils) ;returns *unspecified* EOF -if guix package --bootstrap --install-from-file="$module_dir/package.scm" -then false; else true; fi +! guix package --bootstrap --install-from-file="$module_dir/package.scm" rm "$module_dir/package.scm" diff --git a/tests/guix-repl.sh b/tests/guix-repl.sh index e1c2b8241f..d4ebb5f6c6 100644 --- a/tests/guix-repl.sh +++ b/tests/guix-repl.sh @@ -45,6 +45,10 @@ EOF test "`guix repl "$tmpfile"`" = "coreutils" +# Make sure that the file can also be loaded when passed as a relative file +# name. +(cd "$(dirname "$tmpfile")"; test "$(guix repl "$(basename "$tmpfile")")" = "coreutils") + cat > "$module_dir/foo.scm"<<EOF (define-module (foo) diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 0e22686a34..957479ede0 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -261,8 +261,8 @@ guix system vm "$tmpfile" -d | grep '\.drv$' 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`" +drv1="`guix system disk-image -t iso9660 "$tmpfile" -d`" +drv2="`guix system disk-image -t iso9660 "$tmpfile" -d`" test "$drv1" = "$drv2" make_user_config "group-that-does-not-exist" "users" @@ -297,6 +297,20 @@ EOF guix system build "$tmpdir/config.scm" -n (cd "$tmpdir"; guix system build "config.scm" -n) +# Check that we get a warning when passing 'local-file' a non-literal relative +# file name. +cat > "$tmpdir/config.scm" <<EOF +(use-modules (guix)) + +(define (bad-local-file file) + (local-file file)) + +(bad-local-file "whatever.scm") +EOF +! guix system build "$tmpdir/config.scm" -n +guix system build "$tmpdir/config.scm" -n 2>&1 | \ + grep "config\.scm:4:2: warning:.*whatever.*relative to current directory" + # Searching. guix system search tor | grep "^name: tor" guix system search tor | grep "^shepherdnames: tor" @@ -320,5 +334,8 @@ 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 disk-image -t iso9660 gnu/system/examples/bare-bones.tmpl guix system -n docker-image gnu/system/examples/docker-image.tmpl + +# Verify that at least the raw image type is available. +guix system --list-image-types | grep "raw" diff --git a/tests/opam.scm b/tests/opam.scm index 68b5908e3f..ec2a668307 100644 --- a/tests/opam.scm +++ b/tests/opam.scm @@ -116,81 +116,76 @@ url { ;; Test the opam file parser ;; We fold over some test cases. Each case is a pair of the string to parse and the ;; expected result. -(test-assert "parse-strings" - (fold (lambda (test acc) - (display test) (newline) - (and acc - (let ((result (peg:tree (match-pattern string-pat (car test))))) - (if (equal? result (cdr test)) - #t - (pk 'fail (list (car test) result (cdr test)) #f))))) - #t '(("" . #f) - ("\"hello\"" . (string-pat "hello")) - ("\"hello world\"" . (string-pat "hello world")) - ("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\"")) - ("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)")) - ("\"今日は\"" . (string-pat "今日は"))))) +(define (test-opam-syntax name pattern test-cases) + (test-assert name + (fold (lambda (test acc) + (display test) (newline) + (match test + ((str . expected) + (and acc + (let ((result (peg:tree (match-pattern pattern str)))) + (if (equal? result expected) + #t + (pk 'fail (list str result expected) #f))))))) + #t test-cases))) -(test-assert "parse-multiline-strings" - (fold (lambda (test acc) - (display test) (newline) - (and acc - (let ((result (peg:tree (match-pattern multiline-string (car test))))) - (if (equal? result (cdr test)) - #t - (pk 'fail (list (car test) result (cdr test)) #f))))) - #t '(("" . #f) - ("\"\"\"hello\"\"\"" . (multiline-string "hello")) - ("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello \"world\"!")) - ("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello \"\"world\"\"!"))))) +(test-opam-syntax + "parse-strings" string-pat + '(("" . #f) + ("\"hello\"" . (string-pat "hello")) + ("\"hello world\"" . (string-pat "hello world")) + ("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\"")) + ("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)")) + ("\"今日は\"" . (string-pat "今日は")))) -(test-assert "parse-lists" - (fold (lambda (test acc) - (and acc - (let ((result (peg:tree (match-pattern list-pat (car test))))) - (if (equal? result (cdr test)) - #t - (pk 'fail (list (car test) result (cdr test)) #f))))) - #t '(("" . #f) - ("[]" . list-pat) - ("[make]" . (list-pat (var "make"))) - ("[\"make\"]" . (list-pat (string-pat "make"))) - ("[\n a\n b\n c]" . (list-pat (var "a") (var "b") (var "c"))) - ("[a b \"c\"]" . (list-pat (var "a") (var "b") (string-pat "c")))))) +(test-opam-syntax + "parse-multiline-strings" multiline-string + '(("" . #f) + ("\"\"\"hello\"\"\"" . (multiline-string "hello")) + ("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello \"world\"!")) + ("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello \"\"world\"\"!")))) -(test-assert "parse-dicts" - (fold (lambda (test acc) - (and acc - (let ((result (peg:tree (match-pattern dict (car test))))) - (if (equal? result (cdr test)) - #t - (pk 'fail (list (car test) result (cdr test)) #f))))) - #t '(("" . #f) - ("{}" . dict) - ("{a: \"b\"}" . (dict (record "a" (string-pat "b")))) - ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record "c" (string-pat "d"))))))) +(test-opam-syntax + "parse-lists" list-pat + '(("" . #f) + ("[]" . list-pat) + ("[make]" . (list-pat (var "make"))) + ("[\"make\"]" . (list-pat (string-pat "make"))) + ("[\n a\n b\n c]" . (list-pat (var "a") (var "b") (var "c"))) + ("[a b \"c\"]" . (list-pat (var "a") (var "b") (string-pat "c"))) + ;; complex lists + ("[(a & b)]" . (list-pat (choice-pat (group-pat (var "a") (var "b"))))) + ("[(a | b & c)]" . (list-pat (choice-pat (var "a") (group-pat (var "b") (var "c"))))) + ("[a (b | c) d]" . (list-pat (var "a") (choice-pat (var "b") (var "c")) (var "d"))))) -(test-assert "parse-conditions" - (fold (lambda (test acc) - (and acc - (let ((result (peg:tree (match-pattern condition (car test))))) - (if (equal? result (cdr test)) - #t - (pk 'fail (list (car test) result (cdr test)) #f))))) - #t '(("" . #f) - ("{}" . #f) - ("{build}" . (condition-var "build")) - ("{>= \"0.2.0\"}" . (condition-greater-or-equal - (condition-string "0.2.0"))) - ("{>= \"0.2.0\" & test}" . (condition-and - (condition-greater-or-equal - (condition-string "0.2.0")) - (condition-var "test"))) - ("{>= \"0.2.0\" | build}" . (condition-or - (condition-greater-or-equal - (condition-string "0.2.0")) - (condition-var "build"))) - ("{ = \"1.0+beta19\" }" . (condition-eq - (condition-string "1.0+beta19")))))) +(test-opam-syntax + "parse-dicts" dict + '(("" . #f) + ("{}" . dict) + ("{a: \"b\"}" . (dict (record "a" (string-pat "b")))) + ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record "c" (string-pat "d")))))) + +(test-opam-syntax + "parse-conditions" condition + '(("" . #f) + ("{}" . #f) + ("{build}" . (condition-var "build")) + ("{>= \"0.2.0\"}" . (condition-greater-or-equal + (condition-string "0.2.0"))) + ("{>= \"0.2.0\" & test}" . (condition-and + (condition-greater-or-equal + (condition-string "0.2.0")) + (condition-var "test"))) + ("{>= \"0.2.0\" | build}" . (condition-or + (condition-greater-or-equal + (condition-string "0.2.0")) + (condition-var "build"))) + ("{ = \"1.0+beta19\" }" . (condition-eq + (condition-string "1.0+beta19"))))) + +(test-opam-syntax + "parse-comment" list-pat + '(("" . #f) + ("[#comment\n]" . list-pat))) (test-end "opam") diff --git a/tests/openpgp.scm b/tests/openpgp.scm index 0beab6f88b..c2be26fa49 100644 --- a/tests/openpgp.scm +++ b/tests/openpgp.scm @@ -50,6 +50,12 @@ vBSFjNSiVHsuAA== =AAAA -----END PGP MESSAGE-----\n") +(define %binary-sample + ;; Same message as %radix-64-sample, decoded into bytevector. + (base16-string->bytevector + "c838013b6d96c411efecef17ecefe3ca0004ce8979ea250a897995f979a9\ +0ad9a9a9050a890ac5a9c945a940c1a2fcd2bc14858cd4a2547b2e00")) + (define %civodul-fingerprint "3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5") @@ -155,6 +161,12 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0= read-radix-64)) list)) +(test-assert "port-ascii-armored?, #t" + (call-with-input-string %radix-64-sample port-ascii-armored?)) + +(test-assert "port-ascii-armored?, #f" + (not (port-ascii-armored? (open-bytevector-input-port %binary-sample)))) + (test-assert "get-openpgp-keyring" (let* ((key (search-path %load-path "tests/civodul.key")) (keyring (get-openpgp-keyring diff --git a/tests/packages.scm b/tests/packages.scm index cbd0503733..5d5abcbd76 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -38,6 +38,7 @@ #:use-module (guix build-system) #:use-module (guix build-system trivial) #:use-module (guix build-system gnu) + #:use-module (guix build-system python) #:use-module (guix memoization) #:use-module (guix profiles) #:use-module (guix scripts package) @@ -45,6 +46,7 @@ #:use-module (gnu packages base) #:use-module (gnu packages guile) #:use-module (gnu packages bootstrap) + #:use-module (gnu packages python) #:use-module (gnu packages version-control) #:use-module (gnu packages xml) #:use-module (srfi srfi-1) @@ -185,6 +187,29 @@ (string=? (manifest-pattern-version pattern) "1") (string=? (manifest-pattern-output pattern) "out"))))))) +(test-equal "transaction-upgrade-entry, transformation options preserved" + (derivation-file-name (package-derivation %store grep)) + + (let* ((old (dummy-package "emacs" (version "1"))) + (props '((transformations . ((with-input . "emacs=grep"))))) + (tx (transaction-upgrade-entry + %store + (manifest-entry + (inherit (package->manifest-entry old)) + (properties props) + (item (string-append (%store-prefix) "/" + (make-string 32 #\e) "-foo-1"))) + (manifest-transaction)))) + (match (manifest-transaction-install tx) + (((? manifest-entry? entry)) + (and (string=? (manifest-entry-version entry) + (package-version grep)) + (string=? (manifest-entry-name entry) + (package-name grep)) + (equal? (manifest-entry-properties entry) props) + (derivation-file-name + (package-derivation %store (manifest-entry-item entry)))))))) + (test-assert "transaction-upgrade-entry, grafts" ;; Ensure that, when grafts are enabled, 'transaction-upgrade-entry' doesn't ;; try to build stuff. @@ -1172,15 +1197,24 @@ (let* ((dep (dummy-package "chbouib" (native-inputs `(("x" ,grep))))) (p0 (dummy-package "example" + (source 77) (inputs `(("foo" ,coreutils) ("bar" ,grep) ("baz" ,dep))))) (transform (lambda (p) (package (inherit p) (source 42)))) (rewrite (package-mapping transform)) - (p1 (rewrite p0))) + (p1 (rewrite p0)) + (bag0 (package->bag p0)) + (bag1 (package->bag p1))) (and (eq? p1 (rewrite p0)) (eqv? 42 (package-source p1)) + + ;; Implicit inputs should be left unchanged (skip "source", "foo", + ;; "bar", and "baz" in this comparison). + (equal? (drop (bag-direct-inputs bag0) 4) + (drop (bag-direct-inputs bag1) 4)) + (match (package-inputs p1) ((("foo" dep1) ("bar" dep2) ("baz" dep3)) (and (eq? dep1 (rewrite coreutils)) ;memoization @@ -1194,6 +1228,31 @@ (and (eq? dep (rewrite grep)) (package-source dep)))))))))) +(test-equal "package-mapping, deep" + '(42) + (let* ((p0 (dummy-package "example" + (inputs `(("foo" ,coreutils) + ("bar" ,grep))))) + (transform (lambda (p) + (package (inherit p) (source 42)))) + (rewrite (package-mapping transform #:deep? #t)) + (p1 (rewrite p0)) + (bag (package->bag p1))) + (and (eq? p1 (rewrite p0)) + (match (bag-direct-inputs bag) + ((("source" 42) ("foo" dep1) ("bar" dep2) rest ..1) + (and (eq? dep1 (rewrite coreutils)) ;memoization + (eq? dep2 (rewrite grep)) + (= 42 (package-source dep1)) + (= 42 (package-source dep2)) + + ;; Check that implicit inputs of P0 also got rewritten. + (delete-duplicates + (map (match-lambda + ((_ package . _) + (package-source package))) + rest)))))))) + (test-assert "package-input-rewriting" (let* ((dep (dummy-package "chbouib" (native-inputs `(("x" ,grep))))) @@ -1203,7 +1262,8 @@ ("baz" ,dep))))) (rewrite (package-input-rewriting `((,coreutils . ,sed) (,grep . ,findutils)) - (cut string-append "r-" <>))) + (cut string-append "r-" <>) + #:deep? #f)) (p1 (rewrite p0)) (p2 (rewrite p0))) (and (not (eq? p1 p0)) @@ -1217,7 +1277,22 @@ (eq? dep3 (rewrite dep)) ;memoization (match (package-native-inputs dep3) ((("x" dep)) - (eq? dep findutils))))))))) + (eq? dep findutils)))))) + + ;; Make sure implicit inputs were left unchanged. + (equal? (drop (bag-direct-inputs (package->bag p1)) 3) + (drop (bag-direct-inputs (package->bag p0)) 3))))) + +(test-eq "package-input-rewriting, deep" + (derivation-file-name (package-derivation %store sed)) + (let* ((p0 (dummy-package "chbouib" + (build-system python-build-system) + (arguments `(#:python ,python)))) + (rewrite (package-input-rewriting `((,python . ,sed)))) + (p1 (rewrite p0))) + (match (bag-direct-inputs (package->bag p1)) + ((("python" python) _ ...) + (derivation-file-name (package-derivation %store python)))))) (test-assert "package-input-rewriting/spec" (let* ((dep (dummy-package "chbouib" @@ -1228,7 +1303,8 @@ ("baz" ,dep))))) (rewrite (package-input-rewriting/spec `(("coreutils" . ,(const sed)) - ("grep" . ,(const findutils))))) + ("grep" . ,(const findutils))) + #:deep? #f)) (p1 (rewrite p0)) (p2 (rewrite p0))) (and (not (eq? p1 p0)) @@ -1245,7 +1321,11 @@ (match (package-native-inputs dep3) ((("x" dep)) (string=? (package-full-name dep) - (package-full-name findutils)))))))))) + (package-full-name findutils))))))) + + ;; Make sure implicit inputs were left unchanged. + (equal? (drop (bag-direct-inputs (package->bag p1)) 3) + (drop (bag-direct-inputs (package->bag p0)) 3))))) (test-assert "package-input-rewriting/spec, partial match" (let* ((dep (dummy-package "chbouib" @@ -1256,7 +1336,8 @@ ("bar" ,dep))))) (rewrite (package-input-rewriting/spec `(("chbouib@123" . ,(const sed)) ;not matched - ("grep" . ,(const findutils))))) + ("grep" . ,(const findutils))) + #:deep? #f)) (p1 (rewrite p0))) (and (not (eq? p1 p0)) (string=? "example" (package-name p1)) @@ -1270,6 +1351,85 @@ (string=? (package-full-name dep) (package-full-name findutils)))))))))) +(test-assert "package-input-rewriting/spec, deep" + (let* ((dep (dummy-package "chbouib")) + (p0 (dummy-package "example" + (build-system gnu-build-system) + (inputs `(("dep" ,dep))))) + (rewrite (package-input-rewriting/spec + `(("tar" . ,(const sed)) + ("gzip" . ,(const findutils))))) + (p1 (rewrite p0)) + (p2 (rewrite p0))) + (and (not (eq? p1 p0)) + (eq? p1 p2) ;memoization + (string=? "example" (package-name p1)) + (match (package-inputs p1) + ((("dep" dep1)) + (and (string=? (package-full-name dep1) + (package-full-name dep)) + (eq? dep1 (rewrite dep))))) ;memoization + + ;; Make sure implicit inputs were replaced. + (match (bag-direct-inputs (package->bag p1)) + ((("dep" dep1) ("tar" tar) ("gzip" gzip) _ ...) + (and (eq? dep1 (rewrite dep)) + (string=? (package-full-name tar) + (package-full-name sed)) + (string=? (package-full-name gzip) + (package-full-name findutils)))))))) + +(test-assert "package-input-rewriting/spec, no duplicates" + ;; Ensure that deep input rewriting does not forget implicit inputs. Doing + ;; so could lead to duplicates in a package's inputs: in the example below, + ;; P0's transitive inputs would contain one rewritten "python" and one + ;; original "python". These two "python" packages are thus not 'eq?' but + ;; they lower to the same derivation. See <https://bugs.gnu.org/42156>, + ;; which can be reproduced by passing #:deep? #f. + (let* ((dep0 (dummy-package "dep0" + (build-system trivial-build-system) + (propagated-inputs `(("python" ,python))))) + (p0 (dummy-package "chbouib" + (build-system python-build-system) + (arguments `(#:python ,python)) + (inputs `(("dep0" ,dep0))))) + (rewrite (package-input-rewriting/spec '() #:deep? #t)) + (p1 (rewrite p0)) + (bag1 (package->bag p1)) + (pythons (filter-map (match-lambda + (("python" python) python) + (_ #f)) + (bag-transitive-inputs bag1)))) + (match (delete-duplicates pythons eq?) + ((p) (eq? p (rewrite python)))))) + +(test-equal "package-input-rewriting/spec, graft" + (derivation-file-name (package-derivation %store sed)) + + ;; Make sure replacements are rewritten. + (let* ((dep0 (dummy-package "dep" + (version "1") + (build-system trivial-build-system) + (inputs `(("coreutils" ,coreutils))))) + (dep1 (dummy-package "dep" + (version "0") + (build-system trivial-build-system) + (replacement dep0))) + (p0 (dummy-package "p" + (build-system trivial-build-system) + (inputs `(("dep" ,dep1))))) + (rewrite (package-input-rewriting/spec + `(("coreutils" . ,(const sed))))) + (p1 (rewrite p0))) + (match (package-inputs p1) + ((("dep" dep)) + (match (package-inputs (package-replacement dep)) + ((("coreutils" coreutils)) + ;; COREUTILS is not 'eq?' to SED, so the most reliable way to check + ;; for equality is to lower to a derivation. + (derivation-file-name + (package-derivation %store coreutils)))))))) + (test-equal "package-patched-vulnerabilities" '(("CVE-2015-1234") ("CVE-2016-1234" "CVE-2018-4567") diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index 32876e956a..5f91360953 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +19,7 @@ (define-module (test-scripts-build) #:use-module (guix tests) #:use-module (guix store) + #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix git-download) #:use-module (guix scripts build) @@ -163,11 +164,16 @@ ((("foo" dep1) ("bar" dep2)) (and (string=? (package-full-name dep1) (package-full-name grep)) - (eq? (package-replacement dep1) findutils) + (string=? (package-full-name (package-replacement dep1)) + (package-full-name findutils)) (string=? (package-name dep2) "chbouib") (match (package-native-inputs dep2) ((("x" dep)) - (eq? (package-replacement dep) findutils))))))))))) + (with-store store + (string=? (derivation-file-name + (package-derivation store findutils)) + (derivation-file-name + (package-derivation store dep)))))))))))))) (test-equal "options->transformation, with-branch" (git-checkout (url "https://example.org") @@ -264,5 +270,19 @@ ((("x" dep3)) (map package-source (list dep1 dep3)))))))))))) +(test-assert "options->transformation, without-tests" + (let* ((dep (dummy-package "dep")) + (p (dummy-package "foo" + (inputs `(("dep" ,dep))))) + (t (options->transformation '((without-tests . "dep") + (without-tests . "tar"))))) + (with-store store + (let ((new (t store p))) + (match (bag-direct-inputs (package->bag new)) + ((("dep" dep) ("tar" tar) _ ...) + ;; TODO: Check whether TAR has #:tests? #f when transformations + ;; apply to implicit inputs. + (equal? (package-arguments dep) + '(#:tests? #f)))))))) (test-end) diff --git a/tests/store.scm b/tests/store.scm index 8ff76e8f98..38051bf5e5 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -223,30 +223,22 @@ ;;(> freed 0) (not (file-exists? p)))))) -(test-assert "add-text-to-store vs. delete-paths" - ;; Before, 'add-text-to-store' would return PATH2 without noticing that it - ;; is no longer valid. +(test-assert "add-text-to-store/add-to-store vs. delete-paths" + ;; Before, 'add-text-to-store' and 'add-to-store' would return the same + ;; store item without noticing that it is no longer valid. (with-store store (let* ((text (random-text)) - (path (add-text-to-store store "delete-me" text)) - (deleted (delete-paths store (list path))) - (path2 (add-text-to-store store "delete-me" text))) - (and (string=? path path2) - (equal? deleted (list path)) - (valid-path? store path) - (file-exists? path))))) - -(test-assert "add-to-store vs. delete-paths" - ;; Same as above. - (with-store store - (let* ((file (search-path %load-path "guix.scm")) - (path (add-to-store store "delete-me" #t "sha256" file)) - (deleted (delete-paths store (list path))) - (path2 (add-to-store store "delete-me" #t "sha256" file))) - (and (string=? path path2) - (equal? deleted (list path)) - (valid-path? store path) - (file-exists? path))))) + (file (search-path %load-path "guix.scm")) + (path1 (add-text-to-store store "delete-me" text)) + (path2 (add-to-store store "delete-me" #t "sha256" file)) + (deleted (delete-paths store (list path1 path2)))) + (and (string=? path1 (add-text-to-store store "delete-me" text)) + (string=? path2 (add-to-store store "delete-me" #t "sha256" file)) + (lset= string=? deleted (list path1 path2)) + (valid-path? store path1) + (valid-path? store path2) + (file-exists? path1) + (file-exists? path2))))) (test-equal "add-file-tree-to-store" `(42 @@ -990,7 +982,7 @@ ;; Ensure 'import-paths' raises an exception. (guard (c ((store-protocol-error? c) - (and (not (zero? (store-protocol-error-status (pk 'C c)))) + (and (not (zero? (store-protocol-error-status c))) (string-contains (store-protocol-error-message c) "lacks a signature")))) (let* ((source (open-bytevector-input-port dump)) @@ -1030,9 +1022,9 @@ ;; Ensure 'import-paths' raises an exception. (guard (c ((store-protocol-error? c) - ;; XXX: The daemon-provided error message currently doesn't - ;; mention the reason of the failure. - (not (zero? (store-protocol-error-status c))))) + (and (not (zero? (store-protocol-error-status c))) + (string-contains (store-protocol-error-message c) + "unauthorized public key")))) (let* ((source (open-bytevector-input-port dump)) (imported (import-paths %store source))) (pk 'unauthorized-imported imported) |