diff options
| author | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2023-03-17 12:14:14 -0400 |
|---|---|---|
| committer | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2023-03-17 12:14:14 -0400 |
| commit | 933051281fbed0ae71bd40c24a701faf2a02791c (patch) | |
| tree | 2e002746c81650e39eb6b6bf134be71a269b80fa /tests/pack.scm | |
| parent | d0b7858968a2c8c8cdacc3679447b250fb5b4dd9 (diff) | |
Revert "tests: pack: Fix indentation."
This reverts commit ac1d530d56c1a259630c8873b2281033878a4acb.
Diffstat (limited to 'tests/pack.scm')
| -rw-r--r-- | tests/pack.scm | 279 |
1 files changed, 142 insertions, 137 deletions
diff --git a/tests/pack.scm b/tests/pack.scm index 87187bb62c7..ce5a2f8a53c 100644 --- a/tests/pack.scm +++ b/tests/pack.scm | |||
| @@ -88,43 +88,44 @@ | |||
| 88 | -> "bin/guile")) | 88 | -> "bin/guile")) |
| 89 | #:compressor %gzip-compressor | 89 | #:compressor %gzip-compressor |
| 90 | #:archiver %tar-bootstrap)) | 90 | #:archiver %tar-bootstrap)) |
| 91 | (check (gexp->derivation "check-tarball" | 91 | (check (gexp->derivation |
| 92 | (with-imported-modules '((guix build utils)) | 92 | "check-tarball" |
| 93 | #~(begin | 93 | (with-imported-modules '((guix build utils)) |
| 94 | (use-modules (guix build utils) | 94 | #~(begin |
| 95 | (srfi srfi-1)) | 95 | (use-modules (guix build utils) |
| 96 | 96 | (srfi srfi-1)) | |
| 97 | (define store | 97 | |
| 98 | ;; The unpacked store. | 98 | (define store |
| 99 | (string-append "." (%store-directory) "/")) | 99 | ;; The unpacked store. |
| 100 | 100 | (string-append "." (%store-directory) "/")) | |
| 101 | (define (canonical? file) | 101 | |
| 102 | ;; Return #t if FILE is read-only and its mtime is 1. | 102 | (define (canonical? file) |
| 103 | (let ((st (lstat file))) | 103 | ;; Return #t if FILE is read-only and its mtime is 1. |
| 104 | (or (not (string-prefix? store file)) | 104 | (let ((st (lstat file))) |
| 105 | (eq? 'symlink (stat:type st)) | 105 | (or (not (string-prefix? store file)) |
| 106 | (and (= 1 (stat:mtime st)) | 106 | (eq? 'symlink (stat:type st)) |
| 107 | (zero? (logand #o222 | 107 | (and (= 1 (stat:mtime st)) |
| 108 | (stat:mode st))))))) | 108 | (zero? (logand #o222 |
| 109 | 109 | (stat:mode st))))))) | |
| 110 | (define bin | 110 | |
| 111 | (string-append "." #$profile "/bin")) | 111 | (define bin |
| 112 | 112 | (string-append "." #$profile "/bin")) | |
| 113 | (setenv "PATH" | 113 | |
| 114 | (string-append #$%tar-bootstrap "/bin")) | 114 | (setenv "PATH" |
| 115 | (system* "tar" "xvf" #$tarball) | 115 | (string-append #$%tar-bootstrap "/bin")) |
| 116 | (mkdir #$output) | 116 | (system* "tar" "xvf" #$tarball) |
| 117 | (exit | 117 | (mkdir #$output) |
| 118 | (and (file-exists? (string-append bin "/guile")) | 118 | (exit |
| 119 | (file-exists? store) | 119 | (and (file-exists? (string-append bin "/guile")) |
| 120 | (every canonical? | 120 | (file-exists? store) |
| 121 | (find-files "." (const #t) | 121 | (every canonical? |
| 122 | #:directories? #t)) | 122 | (find-files "." (const #t) |
| 123 | (string=? (string-append #$%bootstrap-guile "/bin") | 123 | #:directories? #t)) |
| 124 | (readlink bin)) | 124 | (string=? (string-append #$%bootstrap-guile "/bin") |
| 125 | (string=? (string-append ".." #$profile | 125 | (readlink bin)) |
| 126 | "/bin/guile") | 126 | (string=? (string-append ".." #$profile |
| 127 | (readlink "bin/Guile"))))))))) | 127 | "/bin/guile") |
| 128 | (readlink "bin/Guile"))))))))) | ||
| 128 | (built-derivations (list check)))) | 129 | (built-derivations (list check)))) |
| 129 | 130 | ||
| 130 | ;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of | 131 | ;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of |
| @@ -144,16 +145,17 @@ | |||
| 144 | (locales? #f))) | 145 | (locales? #f))) |
| 145 | (tarball (self-contained-tarball "tar-pack" profile | 146 | (tarball (self-contained-tarball "tar-pack" profile |
| 146 | #:localstatedir? #t)) | 147 | #:localstatedir? #t)) |
| 147 | (check (gexp->derivation "check-tarball" | 148 | (check (gexp->derivation |
| 148 | #~(let ((bin (string-append "." #$profile "/bin"))) | 149 | "check-tarball" |
| 149 | (setenv "PATH" | 150 | #~(let ((bin (string-append "." #$profile "/bin"))) |
| 150 | (string-append #$%tar-bootstrap "/bin")) | 151 | (setenv "PATH" |
| 151 | (system* "tar" "xvf" #$tarball) | 152 | (string-append #$%tar-bootstrap "/bin")) |
| 152 | (mkdir #$output) | 153 | (system* "tar" "xvf" #$tarball) |
| 153 | (exit | 154 | (mkdir #$output) |
| 154 | (and (file-exists? "var/guix/db/db.sqlite") | 155 | (exit |
| 155 | (string=? (string-append #$%bootstrap-guile "/bin") | 156 | (and (file-exists? "var/guix/db/db.sqlite") |
| 156 | (readlink bin)))))))) | 157 | (string=? (string-append #$%bootstrap-guile "/bin") |
| 158 | (readlink bin)))))))) | ||
| 157 | (built-derivations (list check)))) | 159 | (built-derivations (list check)))) |
| 158 | 160 | ||
| 159 | (unless store (test-skip 1)) | 161 | (unless store (test-skip 1)) |
| @@ -166,44 +168,45 @@ | |||
| 166 | ("λ" regular (data "lambda"))))) | 168 | ("λ" regular (data "lambda"))))) |
| 167 | (tarball (self-contained-tarball "tar-pack" tree | 169 | (tarball (self-contained-tarball "tar-pack" tree |
| 168 | #:localstatedir? #t)) | 170 | #:localstatedir? #t)) |
| 169 | (check (gexp->derivation "check-tarball" | 171 | (check (gexp->derivation |
| 170 | (with-extensions (list guile-sqlite3 guile-gcrypt) | 172 | "check-tarball" |
| 171 | (with-imported-modules (source-module-closure | 173 | (with-extensions (list guile-sqlite3 guile-gcrypt) |
| 172 | '((guix store database))) | 174 | (with-imported-modules (source-module-closure |
| 173 | #~(begin | 175 | '((guix store database))) |
| 174 | (use-modules (guix store database) | 176 | #~(begin |
| 175 | (rnrs io ports) | 177 | (use-modules (guix store database) |
| 176 | (srfi srfi-1)) | 178 | (rnrs io ports) |
| 177 | 179 | (srfi srfi-1)) | |
| 178 | (define (valid-file? basename data) | 180 | |
| 179 | (define file | 181 | (define (valid-file? basename data) |
| 180 | (string-append "./" #$tree "/" basename)) | 182 | (define file |
| 181 | 183 | (string-append "./" #$tree "/" basename)) | |
| 182 | (string=? (call-with-input-file (pk 'file file) | 184 | |
| 183 | get-string-all) | 185 | (string=? (call-with-input-file (pk 'file file) |
| 184 | data)) | 186 | get-string-all) |
| 185 | 187 | data)) | |
| 186 | (setenv "PATH" | 188 | |
| 187 | (string-append #$%tar-bootstrap "/bin")) | 189 | (setenv "PATH" |
| 188 | (system* "tar" "xvf" #$tarball) | 190 | (string-append #$%tar-bootstrap "/bin")) |
| 189 | 191 | (system* "tar" "xvf" #$tarball) | |
| 190 | (sql-schema | 192 | |
| 191 | #$(local-file (search-path %load-path | 193 | (sql-schema |
| 192 | "guix/store/schema.sql"))) | 194 | #$(local-file (search-path %load-path |
| 193 | (with-database "var/guix/db/db.sqlite" db | 195 | "guix/store/schema.sql"))) |
| 194 | ;; Make sure non-ASCII file names are properly | 196 | (with-database "var/guix/db/db.sqlite" db |
| 195 | ;; handled. | 197 | ;; Make sure non-ASCII file names are properly |
| 196 | (setenv "GUIX_LOCPATH" | 198 | ;; handled. |
| 197 | #+(file-append glibc-utf8-locales | 199 | (setenv "GUIX_LOCPATH" |
| 198 | "/lib/locale")) | 200 | #+(file-append glibc-utf8-locales |
| 199 | (setlocale LC_ALL "en_US.utf8") | 201 | "/lib/locale")) |
| 200 | 202 | (setlocale LC_ALL "en_US.utf8") | |
| 201 | (mkdir #$output) | 203 | |
| 202 | (exit | 204 | (mkdir #$output) |
| 203 | (and (every valid-file? | 205 | (exit |
| 204 | '("α" "λ") | 206 | (and (every valid-file? |
| 205 | '("alpha" "lambda")) | 207 | '("α" "λ") |
| 206 | (integer? (path-id db #$tree))))))))))) | 208 | '("alpha" "lambda")) |
| 209 | (integer? (path-id db #$tree))))))))))) | ||
| 207 | (built-derivations (list check)))) | 210 | (built-derivations (list check)))) |
| 208 | 211 | ||
| 209 | (unless store (test-skip 1)) | 212 | (unless store (test-skip 1)) |
| @@ -217,33 +220,34 @@ | |||
| 217 | (tarball (docker-image "docker-pack" profile | 220 | (tarball (docker-image "docker-pack" profile |
| 218 | #:symlinks '(("/bin/Guile" -> "bin/guile")) | 221 | #:symlinks '(("/bin/Guile" -> "bin/guile")) |
| 219 | #:localstatedir? #t)) | 222 | #:localstatedir? #t)) |
| 220 | (check (gexp->derivation "check-tarball" | 223 | (check (gexp->derivation |
| 221 | (with-imported-modules '((guix build utils)) | 224 | "check-tarball" |
| 222 | #~(begin | 225 | (with-imported-modules '((guix build utils)) |
| 223 | (use-modules (guix build utils) | 226 | #~(begin |
| 224 | (ice-9 match)) | 227 | (use-modules (guix build utils) |
| 225 | 228 | (ice-9 match)) | |
| 226 | (define bin | 229 | |
| 227 | (string-append "." #$profile "/bin")) | 230 | (define bin |
| 228 | 231 | (string-append "." #$profile "/bin")) | |
| 229 | (setenv "PATH" (string-append #$%tar-bootstrap "/bin")) | 232 | |
| 230 | (mkdir "base") | 233 | (setenv "PATH" (string-append #$%tar-bootstrap "/bin")) |
| 231 | (with-directory-excursion "base" | 234 | (mkdir "base") |
| 232 | (invoke "tar" "xvf" #$tarball)) | 235 | (with-directory-excursion "base" |
| 233 | 236 | (invoke "tar" "xvf" #$tarball)) | |
| 234 | (match (find-files "base" "layer.tar") | 237 | |
| 235 | ((layer) | 238 | (match (find-files "base" "layer.tar") |
| 236 | (invoke "tar" "xvf" layer))) | 239 | ((layer) |
| 237 | 240 | (invoke "tar" "xvf" layer))) | |
| 238 | (when | 241 | |
| 239 | (and (file-exists? (string-append bin "/guile")) | 242 | (when |
| 240 | (file-exists? "var/guix/db/db.sqlite") | 243 | (and (file-exists? (string-append bin "/guile")) |
| 241 | (file-is-directory? "tmp") | 244 | (file-exists? "var/guix/db/db.sqlite") |
| 242 | (string=? (string-append #$%bootstrap-guile "/bin") | 245 | (file-is-directory? "tmp") |
| 243 | (pk 'binlink (readlink bin))) | 246 | (string=? (string-append #$%bootstrap-guile "/bin") |
| 244 | (string=? (string-append #$profile "/bin/guile") | 247 | (pk 'binlink (readlink bin))) |
| 245 | (pk 'guilelink (readlink "bin/Guile")))) | 248 | (string=? (string-append #$profile "/bin/guile") |
| 246 | (mkdir #$output))))))) | 249 | (pk 'guilelink (readlink "bin/Guile")))) |
| 250 | (mkdir #$output))))))) | ||
| 247 | (built-derivations (list check)))) | 251 | (built-derivations (list check)))) |
| 248 | 252 | ||
| 249 | (unless store (test-skip 1)) | 253 | (unless store (test-skip 1)) |
| @@ -257,31 +261,32 @@ | |||
| 257 | (image (squashfs-image "squashfs-pack" profile | 261 | (image (squashfs-image "squashfs-pack" profile |
| 258 | #:symlinks '(("/bin" -> "bin")) | 262 | #:symlinks '(("/bin" -> "bin")) |
| 259 | #:localstatedir? #t)) | 263 | #:localstatedir? #t)) |
| 260 | (check (gexp->derivation "check-tarball" | 264 | (check (gexp->derivation |
| 261 | (with-imported-modules '((guix build utils)) | 265 | "check-tarball" |
| 262 | #~(begin | 266 | (with-imported-modules '((guix build utils)) |
| 263 | (use-modules (guix build utils) | 267 | #~(begin |
| 264 | (ice-9 match)) | 268 | (use-modules (guix build utils) |
| 265 | 269 | (ice-9 match)) | |
| 266 | (define bin | 270 | |
| 267 | (string-append "." #$profile "/bin")) | 271 | (define bin |
| 268 | 272 | (string-append "." #$profile "/bin")) | |
| 269 | (setenv "PATH" | 273 | |
| 270 | (string-append #$squashfs-tools "/bin")) | 274 | (setenv "PATH" |
| 271 | (invoke "unsquashfs" #$image) | 275 | (string-append #$squashfs-tools "/bin")) |
| 272 | (with-directory-excursion "squashfs-root" | 276 | (invoke "unsquashfs" #$image) |
| 273 | (when (and (file-exists? (string-append bin | 277 | (with-directory-excursion "squashfs-root" |
| 274 | "/guile")) | 278 | (when (and (file-exists? (string-append bin |
| 275 | (file-exists? "var/guix/db/db.sqlite") | 279 | "/guile")) |
| 276 | (string=? (string-append #$%bootstrap-guile "/bin") | 280 | (file-exists? "var/guix/db/db.sqlite") |
| 277 | (pk 'binlink (readlink bin))) | 281 | (string=? (string-append #$%bootstrap-guile "/bin") |
| 278 | 282 | (pk 'binlink (readlink bin))) | |
| 279 | ;; This is a relative symlink target. | 283 | |
| 280 | (string=? (string-drop | 284 | ;; This is a relative symlink target. |
| 281 | (string-append #$profile "/bin") | 285 | (string=? (string-drop |
| 282 | 1) | 286 | (string-append #$profile "/bin") |
| 283 | (pk 'guilelink (readlink "bin")))) | 287 | 1) |
| 284 | (mkdir #$output)))))))) | 288 | (pk 'guilelink (readlink "bin")))) |
| 289 | (mkdir #$output)))))))) | ||
| 285 | (built-derivations (list check)))) | 290 | (built-derivations (list check)))) |
| 286 | 291 | ||
| 287 | (unless store (test-skip 1)) | 292 | (unless store (test-skip 1)) |
