[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: tests: pack: Fix indentation.
|
From: |
guix-commits |
|
Subject: |
02/02: tests: pack: Fix indentation. |
|
Date: |
Tue, 18 Jul 2023 17:13:31 -0400 (EDT) |
apteryx pushed a commit to branch master
in repository guix.
commit c75022d65f1fa18b8c4839e50f915e8f4d4fe305
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Tue Jul 18 11:43:45 2023 -0400
tests: pack: Fix indentation.
* tests/pack.scm: Fix indentation.
---
tests/pack.scm | 201 +++++++++++++++++++++++++++++----------------------------
1 file changed, 101 insertions(+), 100 deletions(-)
diff --git a/tests/pack.scm b/tests/pack.scm
index 0864a4b78a..cf249f861b 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -239,15 +239,14 @@
((layer)
(invoke "tar" "xvf" layer)))
- (when
- (and (file-exists? (string-append bin "/guile"))
- (file-exists? "var/guix/db/db.sqlite")
- (file-is-directory? "tmp")
- (string=? (string-append #$%bootstrap-guile
"/bin")
- (pk 'binlink (readlink bin)))
- (string=? (string-append #$profile "/bin/guile")
- (pk 'guilelink (readlink
"bin/Guile"))))
- (mkdir #$output)))))))
+ (when (and (file-exists? (string-append bin "/guile"))
+ (file-exists? "var/guix/db/db.sqlite")
+ (file-is-directory? "tmp")
+ (string=? (string-append
#$%bootstrap-guile "/bin")
+ (pk 'binlink (readlink bin)))
+ (string=? (string-append #$profile
"/bin/guile")
+ (pk 'guilelink (readlink
"bin/Guile"))))
+ (mkdir #$output)))))))
(built-derivations (list check))))
(unless store (test-skip 1))
@@ -310,71 +309,72 @@
(plain-file "postinst"
"echo running configure script\n"))))
(check
- (gexp->derivation "check-deb-pack"
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 match)
- (ice-9 popen)
- (ice-9 rdelim)
- (ice-9 textual-ports)
- (rnrs base))
-
- (setenv "PATH" (string-join
- (list (string-append #+%tar-bootstrap "/bin")
- (string-append #+dpkg "/bin")
- (string-append #+%ar-bootstrap "/bin"))
- ":"))
-
- ;; Validate the output of 'dpkg --info'.
- (let* ((port (open-pipe* OPEN_READ "dpkg" "--info" #$deb))
- (info (get-string-all port))
- (exit-val (status:exit-val (close-pipe port))))
- (assert (zero? exit-val))
-
- (assert (string-contains
- info
- (string-append "Package: "
- #+(package-name
%bootstrap-guile))))
-
- (assert (string-contains
- info
- (string-append "Version: "
- #+(package-version
%bootstrap-guile)))))
-
- ;; Sanity check .deb contents.
- (invoke "ar" "-xv" #$deb)
- (assert (file-exists? "debian-binary"))
- (assert (file-exists? "data.tar.gz"))
- (assert (file-exists? "control.tar.gz"))
-
- ;; Verify there are no hard links in data.tar.gz, as hard
- ;; links would cause dpkg to fail unpacking the archive.
- (define hard-links
- (let ((port (open-pipe* OPEN_READ "tar" "-tvf"
"data.tar.gz")))
- (let loop ((hard-links '()))
- (match (read-line port)
- ((? eof-object?)
- (assert (zero? (status:exit-val (close-pipe port))))
- hard-links)
- (line
- (if (string-prefix? "u" line)
- (loop (cons line hard-links))
- (loop hard-links)))))))
-
- (unless (null? hard-links)
- (error "hard links found in data.tar.gz" hard-links))
-
- ;; Verify the presence of the control files.
- (invoke "tar" "-xf" "control.tar.gz")
- (assert (file-exists? "control"))
- (assert (and (file-exists? "postinst")
- (= #o111 ;script is executable
- (logand #o111 (stat:perms
- (stat "postinst"))))))
- (assert (file-exists? "triggers"))
-
- (mkdir #$output))))))
+ (gexp->derivation
+ "check-deb-pack"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (ice-9 textual-ports)
+ (rnrs base))
+
+ (setenv "PATH" (string-join
+ (list (string-append #+%tar-bootstrap "/bin")
+ (string-append #+dpkg "/bin")
+ (string-append #+%ar-bootstrap "/bin"))
+ ":"))
+
+ ;; Validate the output of 'dpkg --info'.
+ (let* ((port (open-pipe* OPEN_READ "dpkg" "--info" #$deb))
+ (info (get-string-all port))
+ (exit-val (status:exit-val (close-pipe port))))
+ (assert (zero? exit-val))
+
+ (assert (string-contains
+ info
+ (string-append "Package: "
+ #+(package-name %bootstrap-guile))))
+
+ (assert (string-contains
+ info
+ (string-append "Version: "
+ #+(package-version
%bootstrap-guile)))))
+
+ ;; Sanity check .deb contents.
+ (invoke "ar" "-xv" #$deb)
+ (assert (file-exists? "debian-binary"))
+ (assert (file-exists? "data.tar.gz"))
+ (assert (file-exists? "control.tar.gz"))
+
+ ;; Verify there are no hard links in data.tar.gz, as hard
+ ;; links would cause dpkg to fail unpacking the archive.
+ (define hard-links
+ (let ((port (open-pipe* OPEN_READ "tar" "-tvf"
"data.tar.gz")))
+ (let loop ((hard-links '()))
+ (match (read-line port)
+ ((? eof-object?)
+ (assert (zero? (status:exit-val (close-pipe port))))
+ hard-links)
+ (line
+ (if (string-prefix? "u" line)
+ (loop (cons line hard-links))
+ (loop hard-links)))))))
+
+ (unless (null? hard-links)
+ (error "hard links found in data.tar.gz" hard-links))
+
+ ;; Verify the presence of the control files.
+ (invoke "tar" "-xf" "control.tar.gz")
+ (assert (file-exists? "control"))
+ (assert (and (file-exists? "postinst")
+ (= #o111 ;script is executable
+ (logand #o111 (stat:perms
+ (stat "postinst"))))))
+ (assert (file-exists? "triggers"))
+
+ (mkdir #$output))))))
(built-derivations (list check))))
(unless store (test-skip 1))
@@ -390,32 +390,33 @@
#: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))))))
+ (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)