From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: 61255@debbugs.gnu.org
Cc: ludo@gnu.org, Maxim Cournoyer <maxim.cournoyer@gmail.com>
Subject: [bug#61255] [PATCH v2 5/8] tests: pack: Fix indentation.
Date: Fri, 17 Feb 2023 02:49:34 +0100 [thread overview]
Message-ID: <20230217014938.20919-6-maxim.cournoyer@gmail.com> (raw)
In-Reply-To: <20230217014938.20919-1-maxim.cournoyer@gmail.com>
* tests/pack.scm: Fix indentation.
---
Changes in v2:
- Better make use of the new indentation rule
tests/pack.scm | 279 ++++++++++++++++++++++++-------------------------
1 file changed, 137 insertions(+), 142 deletions(-)
diff --git a/tests/pack.scm b/tests/pack.scm
index a4c388d93e..a02924b7d2 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -74,44 +74,43 @@ (define %ar-bootstrap %bootstrap-binutils)
-> "bin/guile"))
#:compressor %gzip-compressor
#:archiver %tar-bootstrap))
- (check (gexp->derivation
- "check-tarball"
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (srfi srfi-1))
-
- (define store
- ;; The unpacked store.
- (string-append "." (%store-directory) "/"))
-
- (define (canonical? file)
- ;; Return #t if FILE is read-only and its mtime is 1.
- (let ((st (lstat file)))
- (or (not (string-prefix? store file))
- (eq? 'symlink (stat:type st))
- (and (= 1 (stat:mtime st))
- (zero? (logand #o222
- (stat:mode st)))))))
-
- (define bin
- (string-append "." #$profile "/bin"))
-
- (setenv "PATH"
- (string-append #$%tar-bootstrap "/bin"))
- (system* "tar" "xvf" #$tarball)
- (mkdir #$output)
- (exit
- (and (file-exists? (string-append bin "/guile"))
- (file-exists? store)
- (every canonical?
- (find-files "." (const #t)
- #:directories? #t))
- (string=? (string-append #$%bootstrap-guile "/bin")
- (readlink bin))
- (string=? (string-append ".." #$profile
- "/bin/guile")
- (readlink "bin/Guile")))))))))
+ (check (gexp->derivation "check-tarball"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-1))
+
+ (define store
+ ;; The unpacked store.
+ (string-append "." (%store-directory) "/"))
+
+ (define (canonical? file)
+ ;; Return #t if FILE is read-only and its mtime is 1.
+ (let ((st (lstat file)))
+ (or (not (string-prefix? store file))
+ (eq? 'symlink (stat:type st))
+ (and (= 1 (stat:mtime st))
+ (zero? (logand #o222
+ (stat:mode st)))))))
+
+ (define bin
+ (string-append "." #$profile "/bin"))
+
+ (setenv "PATH"
+ (string-append #$%tar-bootstrap "/bin"))
+ (system* "tar" "xvf" #$tarball)
+ (mkdir #$output)
+ (exit
+ (and (file-exists? (string-append bin "/guile"))
+ (file-exists? store)
+ (every canonical?
+ (find-files "." (const #t)
+ #:directories? #t))
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (readlink bin))
+ (string=? (string-append ".." #$profile
+ "/bin/guile")
+ (readlink "bin/Guile")))))))))
(built-derivations (list check))))
;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of
@@ -131,17 +130,16 @@ (define bin
#:locales? #f))
(tarball (self-contained-tarball "tar-pack" profile
#:localstatedir? #t))
- (check (gexp->derivation
- "check-tarball"
- #~(let ((bin (string-append "." #$profile "/bin")))
- (setenv "PATH"
- (string-append #$%tar-bootstrap "/bin"))
- (system* "tar" "xvf" #$tarball)
- (mkdir #$output)
- (exit
- (and (file-exists? "var/guix/db/db.sqlite")
- (string=? (string-append #$%bootstrap-guile "/bin")
- (readlink bin))))))))
+ (check (gexp->derivation "check-tarball"
+ #~(let ((bin (string-append "." #$profile "/bin")))
+ (setenv "PATH"
+ (string-append #$%tar-bootstrap "/bin"))
+ (system* "tar" "xvf" #$tarball)
+ (mkdir #$output)
+ (exit
+ (and (file-exists? "var/guix/db/db.sqlite")
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (readlink bin))))))))
(built-derivations (list check))))
(unless store (test-skip 1))
@@ -154,45 +152,44 @@ (define bin
("λ" regular (data "lambda")))))
(tarball (self-contained-tarball "tar-pack" tree
#:localstatedir? #t))
- (check (gexp->derivation
- "check-tarball"
- (with-extensions (list guile-sqlite3 guile-gcrypt)
- (with-imported-modules (source-module-closure
- '((guix store database)))
- #~(begin
- (use-modules (guix store database)
- (rnrs io ports)
- (srfi srfi-1))
-
- (define (valid-file? basename data)
- (define file
- (string-append "./" #$tree "/" basename))
-
- (string=? (call-with-input-file (pk 'file file)
- get-string-all)
- data))
-
- (setenv "PATH"
- (string-append #$%tar-bootstrap "/bin"))
- (system* "tar" "xvf" #$tarball)
-
- (sql-schema
- #$(local-file (search-path %load-path
- "guix/store/schema.sql")))
- (with-database "var/guix/db/db.sqlite" db
- ;; Make sure non-ASCII file names are properly
- ;; handled.
- (setenv "GUIX_LOCPATH"
- #+(file-append glibc-utf8-locales
- "/lib/locale"))
- (setlocale LC_ALL "en_US.utf8")
-
- (mkdir #$output)
- (exit
- (and (every valid-file?
- '("α" "λ")
- '("alpha" "lambda"))
- (integer? (path-id db #$tree)))))))))))
+ (check (gexp->derivation "check-tarball"
+ (with-extensions (list guile-sqlite3 guile-gcrypt)
+ (with-imported-modules (source-module-closure
+ '((guix store database)))
+ #~(begin
+ (use-modules (guix store database)
+ (rnrs io ports)
+ (srfi srfi-1))
+
+ (define (valid-file? basename data)
+ (define file
+ (string-append "./" #$tree "/" basename))
+
+ (string=? (call-with-input-file (pk 'file file)
+ get-string-all)
+ data))
+
+ (setenv "PATH"
+ (string-append #$%tar-bootstrap "/bin"))
+ (system* "tar" "xvf" #$tarball)
+
+ (sql-schema
+ #$(local-file (search-path %load-path
+ "guix/store/schema.sql")))
+ (with-database "var/guix/db/db.sqlite" db
+ ;; Make sure non-ASCII file names are properly
+ ;; handled.
+ (setenv "GUIX_LOCPATH"
+ #+(file-append glibc-utf8-locales
+ "/lib/locale"))
+ (setlocale LC_ALL "en_US.utf8")
+
+ (mkdir #$output)
+ (exit
+ (and (every valid-file?
+ '("α" "λ")
+ '("alpha" "lambda"))
+ (integer? (path-id db #$tree)))))))))))
(built-derivations (list check))))
(unless store (test-skip 1))
@@ -206,34 +203,33 @@ (define file
(tarball (docker-image "docker-pack" profile
#:symlinks '(("/bin/Guile" -> "bin/guile"))
#:localstatedir? #t))
- (check (gexp->derivation
- "check-tarball"
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 match))
-
- (define bin
- (string-append "." #$profile "/bin"))
-
- (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
- (mkdir "base")
- (with-directory-excursion "base"
- (invoke "tar" "xvf" #$tarball))
-
- (match (find-files "base" "layer.tar")
- ((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)))))))
+ (check (gexp->derivation "check-tarball"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (define bin
+ (string-append "." #$profile "/bin"))
+
+ (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+ (mkdir "base")
+ (with-directory-excursion "base"
+ (invoke "tar" "xvf" #$tarball))
+
+ (match (find-files "base" "layer.tar")
+ ((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)))))))
(built-derivations (list check))))
(unless store (test-skip 1))
@@ -247,32 +243,31 @@ (define bin
(image (squashfs-image "squashfs-pack" profile
#:symlinks '(("/bin" -> "bin"))
#:localstatedir? #t))
- (check (gexp->derivation
- "check-tarball"
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 match))
-
- (define bin
- (string-append "." #$profile "/bin"))
-
- (setenv "PATH"
- (string-append #$squashfs-tools "/bin"))
- (invoke "unsquashfs" #$image)
- (with-directory-excursion "squashfs-root"
- (when (and (file-exists? (string-append bin
- "/guile"))
- (file-exists? "var/guix/db/db.sqlite")
- (string=? (string-append #$%bootstrap-guile "/bin")
- (pk 'binlink (readlink bin)))
-
- ;; This is a relative symlink target.
- (string=? (string-drop
- (string-append #$profile "/bin")
- 1)
- (pk 'guilelink (readlink "bin"))))
- (mkdir #$output))))))))
+ (check (gexp->derivation "check-tarball"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (define bin
+ (string-append "." #$profile "/bin"))
+
+ (setenv "PATH"
+ (string-append #$squashfs-tools "/bin"))
+ (invoke "unsquashfs" #$image)
+ (with-directory-excursion "squashfs-root"
+ (when (and (file-exists? (string-append bin
+ "/guile"))
+ (file-exists? "var/guix/db/db.sqlite")
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (pk 'binlink (readlink bin)))
+
+ ;; This is a relative symlink target.
+ (string=? (string-drop
+ (string-append #$profile "/bin")
+ 1)
+ (pk 'guilelink (readlink "bin"))))
+ (mkdir #$output))))))))
(built-derivations (list check))))
(unless store (test-skip 1))
--
2.39.1
next prev parent reply other threads:[~2023-02-17 1:51 UTC|newest]
Thread overview: 45+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-02-03 16:19 [bug#61255] [PATCH 0/5] Add support for the RPM format to "guix pack" Maxim Cournoyer
2023-02-03 22:14 ` [bug#61255] [PATCH 1/5] pack: Extract keyword-ref procedure from debian-archive Maxim Cournoyer
2023-02-03 22:14 ` [bug#61255] [PATCH 2/5] gexp: computed-file: Honor %guile-for-build Maxim Cournoyer
2023-02-04 1:11 ` Ludovic Courtès
2023-02-04 3:43 ` Maxim Cournoyer
2023-02-12 18:14 ` [bug#61255] [PATCH 0/5] Add support for the RPM format to "guix pack" Ludovic Courtès
2023-02-16 15:12 ` Maxim Cournoyer
2023-02-23 15:44 ` [bug#61255] (%guile-for-build) default in ‘computed-file’ Ludovic Courtès
2023-02-24 2:38 ` Maxim Cournoyer
2023-02-27 15:10 ` bug#61841: bug#61255: [PATCH 0/5] Add support for the RPM format to "guix pack" Ludovic Courtès
2023-02-27 16:41 ` Maxim Cournoyer
2023-02-27 21:08 ` bug#61841: ‘guix shell’ computes different package derivation than ‘guix build’ Ludovic Courtès
2023-02-28 2:25 ` Maxim Cournoyer
2023-02-03 22:14 ` [bug#61255] [PATCH 3/5] pack: Extract populate-profile-root from self-contained-tarball/builder Maxim Cournoyer
2023-02-03 22:14 ` [bug#61255] [PATCH 4/5] tests: pack: Fix indentation Maxim Cournoyer
2023-02-12 18:20 ` [bug#61255] [PATCH 0/5] Add support for the RPM format to "guix pack" Ludovic Courtès
2023-02-16 15:22 ` Maxim Cournoyer
2023-02-23 15:47 ` Ludovic Courtès
2023-02-23 22:20 ` Feedback on indentation rules (was: [PATCH 0/5] Add support for the RPM format to "guix pack") Maxim Cournoyer
2023-02-27 19:14 ` Efraim Flashner
2023-03-01 15:17 ` Feedback on indentation rules Maxim Cournoyer
2023-03-06 16:56 ` Ludovic Courtès
2023-03-07 13:46 ` Simon Tournier
2023-03-07 16:54 ` Maxim Cournoyer
2023-03-07 17:29 ` Simon Tournier
2023-03-09 13:55 ` Maxim Cournoyer
2023-03-15 16:15 ` Ludovic Courtès
2023-03-17 16:16 ` Maxim Cournoyer
2023-02-03 22:14 ` [bug#61255] [PATCH 5/5] pack: Add RPM format Maxim Cournoyer
2023-02-12 18:52 ` [bug#61255] [PATCH 0/5] Add support for the RPM format to "guix pack" Ludovic Courtès
2023-02-16 22:17 ` Maxim Cournoyer
2023-02-12 18:57 ` Ludovic Courtès
2023-02-16 15:25 ` Maxim Cournoyer
2023-02-17 1:49 ` [bug#61255] [PATCH v2 0/8] " Maxim Cournoyer
2023-02-17 1:49 ` [bug#61255] [PATCH v2 1/8] .dir-locals: Add let-keywords indentation rules Maxim Cournoyer
2023-02-17 1:49 ` [bug#61255] [PATCH v2 2/8] pack: Use let-keywords instead of keyword-ref Maxim Cournoyer
2023-02-17 1:49 ` [bug#61255] [PATCH v2 3/8] gexp: computed-file: Honor %guile-for-build Maxim Cournoyer
2023-02-17 1:49 ` [bug#61255] [PATCH v2 4/8] pack: Extract populate-profile-root from self-contained-tarball/builder Maxim Cournoyer
2023-02-17 1:49 ` Maxim Cournoyer [this message]
2023-02-17 1:49 ` [bug#61255] [PATCH v2 6/8] pack: Add RPM format Maxim Cournoyer
2023-02-17 1:49 ` [bug#61255] [PATCH v2 7/8] etc: Add a news entry snippet Maxim Cournoyer
2023-02-17 1:49 ` [bug#61255] [PATCH v2 8/8] news: Add entry for the new 'rpm' guix pack format Maxim Cournoyer
2023-02-17 6:34 ` Julien Lepiller
2023-02-17 17:32 ` Maxim Cournoyer
2023-02-17 15:12 ` pelzflorian (Florian Pelz)
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20230217014938.20919-6-maxim.cournoyer@gmail.com \
--to=maxim.cournoyer@gmail.com \
--cc=61255@debbugs.gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.