summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/guix-pack-relocatable.sh6
-rw-r--r--tests/guix-pack.sh5
-rw-r--r--tests/hackage.scm5
-rw-r--r--tests/pack.scm89
-rw-r--r--tests/packages.scm37
-rw-r--r--tests/read-print.scm24
-rw-r--r--tests/rpm.scm86
7 files changed, 230 insertions, 22 deletions
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index b90bc7f891..46120c9ee6 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2018, 2019, 2020, 2023 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2020 Eric Bavier <bavier@posteo.net>
#
# This file is part of GNU Guix.
@@ -82,6 +82,7 @@ then
tarball="`guix pack -R -S /Bin=bin sed`"
(cd "$test_directory"; tar xvf "$tarball")
+ chmod +w "$test_directory"
run_without_store "$test_directory/Bin/sed" --version > "$test_directory/output"
grep 'GNU sed' "$test_directory/output"
@@ -104,6 +105,7 @@ case "`uname -m`" in
tarball="`guix pack -RR -S /Bin=bin sed`"
tar tvf "$tarball" | grep /bin/proot
(cd "$test_directory"; tar xf "$tarball")
+ chmod +w "$test_directory"
run_without_store GUIX_EXECUTION_ENGINE="proot" \
"$test_directory/Bin/sed" --version > "$test_directory/output"
grep 'GNU sed' "$test_directory/output"
@@ -195,6 +197,7 @@ EOF
# Run '/bin/daemon', which forks, then wait for the child, send it SIGHUP
# so that it dumps its view of the store, and make sure the child and
# parent both see the same store contents.
+ chmod +w "$test_directory"
(cd "$test_directory"; run_without_store ./bin/daemon)
wait_for_file "$test_directory/pid"
kill -HUP $(cat "$test_directory/pid")
@@ -241,6 +244,7 @@ cat >"$test_directory/manifest.scm" <<'EOF'
EOF
tarball="`guix pack -RR -S /opt= -m $test_directory/manifest.scm`"
(cd "$test_directory"; tar xvf "$tarball")
+chmod +w "$test_directory"
( export GUIX_PROFILE=$test_directory/opt
. $GUIX_PROFILE/etc/profile
run_without_store "$test_directory/opt/bin/hello" > "$test_directory/output" )
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 6fc9e3723b..a13e0ededf 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -1,6 +1,6 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
-# Copyright © 2018, 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2018, 2019, 2020, 2022, 2023 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -114,7 +114,8 @@ guix pack --dry-run --bootstrap --target=arm-linux-gnueabihf coreutils
guix pack -R --dry-run --bootstrap -S /mybin=bin guile-bootstrap
# Make sure package transformation options are honored.
-mkdir -p "$test_directory"
+chmod -Rf +w "$test_directory"; rm -r "$test_directory"
+mkdir -p "$test_directory" -m 755
drv1="`guix pack --no-grafts -n guile 2>&1 | grep pack.*\.drv`"
drv2="`guix pack --no-grafts -n --with-source=guile=$test_directory guile 2>&1 | grep pack.*\.drv`"
test -n "$drv1"
diff --git a/tests/hackage.scm b/tests/hackage.scm
index ad2ee4b7f9..8eea818ebd 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -201,6 +201,7 @@ library
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
+ ('properties '(quote ((upstream-name . "foo"))))
('inputs ('list 'ghc-http))
('home-page "http://test.org")
('synopsis (? string?))
@@ -241,6 +242,7 @@ library
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
+ ('properties '(quote ((upstream-name . "foo"))))
('inputs ('list 'ghc-b 'ghc-http))
('native-inputs ('list 'ghc-haskell-gi))
('home-page "http://test.org")
@@ -471,6 +473,7 @@ library
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
+ ('properties '(quote ((upstream-name . "foo"))))
('inputs ('list 'ghc-c))
('home-page "http://test.org")
('synopsis (? string?))
@@ -520,6 +523,7 @@ executable cabal
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
+ ('properties '(quote ((upstream-name . "foo"))))
('inputs ('list 'ghc-http))
('arguments
('quasiquote
@@ -610,6 +614,7 @@ executable cabal
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
+ ('properties '(quote ((upstream-name . "foo"))))
('inputs ('list 'ghc-http))
('home-page "http://test.org")
('synopsis (? string?))
diff --git a/tests/pack.scm b/tests/pack.scm
index a4c388d93e..ce5a2f8a53 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,13 +28,16 @@
#:use-module (guix tests)
#:use-module (guix gexp)
#:use-module (guix modules)
+ #:use-module (guix utils)
#:use-module (gnu packages)
#:use-module ((gnu packages base) #:select (glibc-utf8-locales))
#:use-module (gnu packages bootstrap)
+ #:use-module ((gnu packages package-management) #:select (rpm))
#:use-module ((gnu packages compression) #:select (squashfs-tools))
#:use-module ((gnu packages debian) #:select (dpkg))
#:use-module ((gnu packages guile) #:select (guile-sqlite3))
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
+ #:use-module ((gnu packages linux) #:select (fakeroot))
#:use-module (srfi srfi-64))
(define %store
@@ -59,6 +62,17 @@
(define %ar-bootstrap %bootstrap-binutils)
+;;; This is a variant of the RPM package configured so that its database can
+;;; be created on a writable location readily available inside the build
+;;; container ("/tmp").
+(define rpm-for-tests
+ (package
+ (inherit rpm)
+ (arguments (substitute-keyword-arguments (package-arguments rpm)
+ ((#:configure-flags flags '())
+ #~(cons "--localstatedir=/tmp"
+ (delete "--localstatedir=/var" #$flags)))))))
+
(test-begin "pack")
@@ -125,10 +139,10 @@
(test-assertm "self-contained-tarball + localstatedir" store
(mlet* %store-monad
((guile (set-guile-for-build (default-guile)))
- (profile (profile-derivation (packages->manifest
- (list %bootstrap-guile))
- #:hooks '()
- #:locales? #f))
+ (profile -> (profile
+ (content (packages->manifest (list %bootstrap-guile)))
+ (hooks '())
+ (locales? #f)))
(tarball (self-contained-tarball "tar-pack" profile
#:localstatedir? #t))
(check (gexp->derivation
@@ -199,10 +213,10 @@
(test-assertm "docker-image + localstatedir" store
(mlet* %store-monad
((guile (set-guile-for-build (default-guile)))
- (profile (profile-derivation (packages->manifest
- (list %bootstrap-guile))
- #:hooks '()
- #:locales? #f))
+ (profile -> (profile
+ (content (packages->manifest (list %bootstrap-guile)))
+ (hooks '())
+ (locales? #f)))
(tarball (docker-image "docker-pack" profile
#:symlinks '(("/bin/Guile" -> "bin/guile"))
#:localstatedir? #t))
@@ -240,10 +254,10 @@
(test-assertm "squashfs-image + localstatedir" store
(mlet* %store-monad
((guile (set-guile-for-build (default-guile)))
- (profile (profile-derivation (packages->manifest
- (list %bootstrap-guile))
- #:hooks '()
- #:locales? #f))
+ (profile -> (profile
+ (content (packages->manifest (list %bootstrap-guile)))
+ (hooks '())
+ (locales? #f)))
(image (squashfs-image "squashfs-pack" profile
#:symlinks '(("/bin" -> "bin"))
#:localstatedir? #t))
@@ -279,10 +293,10 @@
(test-assertm "deb archive with symlinks and control files" store
(mlet* %store-monad
((guile (set-guile-for-build (default-guile)))
- (profile (profile-derivation (packages->manifest
- (list %bootstrap-guile))
- #:hooks '()
- #:locales? #f))
+ (profile -> (profile
+ (content (packages->manifest (list %bootstrap-guile)))
+ (hooks '())
+ (locales? #f)))
(deb (debian-archive
"deb-pack" profile
#:compressor %gzip-compressor
@@ -361,6 +375,47 @@
(assert (file-exists? "triggers"))
(mkdir #$output))))))
+ (built-derivations (list check))))
+
+ (unless store (test-skip 1))
+ (test-assertm "rpm archive can be installed/uninstalled" store
+ (mlet* %store-monad
+ ((guile (set-guile-for-build (default-guile)))
+ (profile -> (profile
+ (content (packages->manifest (list %bootstrap-guile)))
+ (hooks '())
+ (locales? #f)))
+ (rpm-pack (rpm-archive "rpm-pack" profile
+ #:compressor %gzip-compressor
+ #:symlinks '(("/bin/guile" -> "bin/guile"))
+ #:extra-options '(#:relocatable? #t)))
+ (check
+ (gexp->derivation "check-rpm-pack"
+ (with-imported-modules (source-module-closure
+ '((guix build utils)))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (define fakeroot #+(file-append fakeroot "/bin/fakeroot"))
+ (define rpm #+(file-append rpm-for-tests "/bin/rpm"))
+ (mkdir-p "/tmp/lib/rpm")
+
+ ;; Install the RPM package. This causes RPM to validate the
+ ;; signatures, header as well as the file digests, which
+ ;; makes it a rather thorough test.
+ (mkdir "test-prefix")
+ (invoke fakeroot rpm "--install"
+ (string-append "--prefix=" (getcwd) "/test-prefix")
+ #$rpm-pack)
+
+ ;; Invoke the installed Guile command.
+ (invoke "./test-prefix/bin/guile" "--version")
+
+ ;; Uninstall the RPM package.
+ (invoke fakeroot rpm "--erase" "guile-bootstrap")
+
+ ;; Required so the above is run.
+ (mkdir #$output))))))
(built-derivations (list check)))))
(test-end)
diff --git a/tests/packages.scm b/tests/packages.scm
index f58c47817b..ef97fca86d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,8 +1,9 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -418,12 +419,15 @@
(let* ((o (dummy-origin))
(u (dummy-origin))
(i (dummy-origin))
+ (j (dummy-origin (patches (list o))))
(a (dummy-package "a"))
(b (dummy-package "b" (inputs (list a i))))
(c (package (inherit b) (source o)))
(d (dummy-package "d"
(build-system trivial-build-system)
- (source u) (inputs (list c)))))
+ (source u) (inputs (list c))))
+ (e (dummy-package "e" (source j)))
+ (f (package (inherit e) (inputs (list u)))))
(test-assert "package-direct-sources, no source"
(null? (package-direct-sources a)))
(test-equal "package-direct-sources, #f source"
@@ -437,6 +441,17 @@
(and (= (length (pk 's-sources s)) 2)
(member o s)
(member i s))))
+ (test-assert "package-direct-sources, with patches"
+ (let ((s (package-direct-sources e)))
+ (and (= (length (pk 's-sources s)) 2)
+ (member o s)
+ (member j s))))
+ (test-assert "package-direct-sources, with patches and inputs"
+ (let ((s (package-direct-sources f)))
+ (and (= (length (pk 's-sources s)) 3)
+ (member o s)
+ (member j s)
+ (member u s))))
(test-assert "package-transitive-sources"
(let ((s (package-transitive-sources d)))
(and (= (length (pk 'd-sources s)) 3)
@@ -1577,6 +1592,24 @@
(match (delete-duplicates pythons eq?)
((p) (eq? p (rewrite python))))))
+(test-assert "package-input-rewriting/spec, hidden package"
+ ;; Hidden packages are not subject to rewriting.
+ (let* ((python (hidden-package python))
+ (p0 (dummy-package "chbouib"
+ (build-system trivial-build-system)
+ (inputs (list python))))
+ (rewrite (package-input-rewriting/spec
+ `(("python" . ,(const sed)))
+ #: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 python)))))
+
(test-equal "package-input-rewriting/spec, graft"
(derivation-file-name (package-derivation %store sed))
diff --git a/tests/read-print.scm b/tests/read-print.scm
index 79a4101be6..f4627e076a 100644
--- a/tests/read-print.scm
+++ b/tests/read-print.scm
@@ -211,6 +211,15 @@ mnopqrstuvwxyz.\")"
#:max-width 33)
(test-pretty-print "\
+(list ;margin comment
+ a b c)")
+
+(test-pretty-print "\
+(list
+ ;; This is a line comment immediately following the list head.
+ #:test-flags #~(list \"-m\" \"not external and not samples\"))")
+
+(test-pretty-print "\
(modify-phases %standard-phases
(replace 'build
;; Nicely indented in 'modify-phases' context.
@@ -223,6 +232,21 @@ mnopqrstuvwxyz.\")"
(replace \"gmp\" gmp))")
(test-pretty-print "\
+#~(modify-phases phases
+ (add-after 'whatever 'something-else
+ (lambda _
+ ;; This comment appears inside a gexp.
+ 42)))")
+
+(test-pretty-print "\
+#~(list #$@(list coreutils ;yup
+ grep) ;margin comment
+ #+sed
+
+ ;; Line comment.
+ #$grep)")
+
+(test-pretty-print "\
(package
;; Here 'sha256', 'base32', and 'arguments' must be
;; immediately followed by a newline.
diff --git a/tests/rpm.scm b/tests/rpm.scm
new file mode 100644
index 0000000000..f40b36fe60
--- /dev/null
+++ b/tests/rpm.scm
@@ -0,0 +1,86 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@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-rpm)
+ #:use-module (guix rpm)
+ #:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-64)
+ #:use-module (srfi srfi-71))
+
+;; For white-box testing.
+(define-syntax-rule (expose-internal name)
+ (define name (@@ (guix rpm) name)))
+
+(expose-internal RPMTAG_ARCH)
+(expose-internal RPMTAG_LICENSE)
+(expose-internal RPMTAG_NAME)
+(expose-internal RPMTAG_OS)
+(expose-internal RPMTAG_RELEASE)
+(expose-internal RPMTAG_SUMMARY)
+(expose-internal RPMTAG_VERSION)
+(expose-internal header-entry-count)
+(expose-internal header-entry-tag)
+(expose-internal header-entry-value)
+(expose-internal header-entry?)
+(expose-internal make-header)
+(expose-internal make-header-entry)
+(expose-internal make-header-index+data)
+
+(test-begin "rpm")
+
+(test-equal "lead must be 96 bytes long"
+ 96
+ (length (generate-lead "hello-2.12.1")))
+
+(define header-entries
+ (list (make-header-entry RPMTAG_NAME 1 "hello")
+ (make-header-entry RPMTAG_VERSION 1 "2.12.1")
+ (make-header-entry RPMTAG_RELEASE 1 "0")
+ (make-header-entry RPMTAG_SUMMARY 1
+ "Hello, GNU world: An example GNU package")
+ (make-header-entry RPMTAG_LICENSE 1 "GPL 3 or later")
+ (make-header-entry RPMTAG_OS 1 "Linux")
+ (make-header-entry RPMTAG_ARCH 1 "x86_64")))
+
+(define expected-header-index-length
+ (* 16 (length header-entries))) ;16 bytes per index entry
+
+(define expected-header-data-length
+ (+ (length header-entries) ;to account for null bytes
+ (fold + 0 (map (compose string-length (cut header-entry-value <>))
+ header-entries))))
+
+(let ((index data (make-header-index+data header-entries)))
+ (test-equal "header index"
+ expected-header-index-length
+ (length index))
+
+ ;; This test depends on the fact that only STRING entries are used, and that
+ ;; they are composed of single byte characters and the delimiting null byte.
+ (test-equal "header data"
+ expected-header-data-length
+ (length data)))
+
+(test-equal "complete header section"
+ (+ 16 ;leading magic + count bytes
+ expected-header-index-length expected-header-data-length)
+ (length (make-header header-entries)))
+
+(test-end)
generated by cgit v1.2.3 (git 2.49.0) at 2025-05-01 05:28:21 +0000