diff options
| author | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2023-07-18 11:43:45 -0400 |
|---|---|---|
| committer | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2023-07-18 16:56:06 -0400 |
| commit | c75022d65f1fa18b8c4839e50f915e8f4d4fe305 (patch) | |
| tree | 8d12696d1069d34b8e637e05e89ee65c5ac75e4a /tests/pack.scm | |
| parent | d5f8b50365533f2713596f59519c48019f6b1f19 (diff) | |
tests: pack: Fix indentation.
* tests/pack.scm: Fix indentation.
Diffstat (limited to 'tests/pack.scm')
| -rw-r--r-- | tests/pack.scm | 201 |
1 files changed, 101 insertions, 100 deletions
diff --git a/tests/pack.scm b/tests/pack.scm index 0864a4b78a7..cf249f861bf 100644 --- a/tests/pack.scm +++ b/tests/pack.scm | |||
| @@ -239,15 +239,14 @@ | |||
| 239 | ((layer) | 239 | ((layer) |
| 240 | (invoke "tar" "xvf" layer))) | 240 | (invoke "tar" "xvf" layer))) |
| 241 | 241 | ||
| 242 | (when | 242 | (when (and (file-exists? (string-append bin "/guile")) |
| 243 | (and (file-exists? (string-append bin "/guile")) | 243 | (file-exists? "var/guix/db/db.sqlite") |
| 244 | (file-exists? "var/guix/db/db.sqlite") | 244 | (file-is-directory? "tmp") |
| 245 | (file-is-directory? "tmp") | 245 | (string=? (string-append #$%bootstrap-guile "/bin") |
| 246 | (string=? (string-append #$%bootstrap-guile "/bin") | 246 | (pk 'binlink (readlink bin))) |
| 247 | (pk 'binlink (readlink bin))) | 247 | (string=? (string-append #$profile "/bin/guile") |
| 248 | (string=? (string-append #$profile "/bin/guile") | 248 | (pk 'guilelink (readlink "bin/Guile")))) |
| 249 | (pk 'guilelink (readlink "bin/Guile")))) | 249 | (mkdir #$output))))))) |
| 250 | (mkdir #$output))))))) | ||
| 251 | (built-derivations (list check)))) | 250 | (built-derivations (list check)))) |
| 252 | 251 | ||
| 253 | (unless store (test-skip 1)) | 252 | (unless store (test-skip 1)) |
| @@ -310,71 +309,72 @@ | |||
| 310 | (plain-file "postinst" | 309 | (plain-file "postinst" |
| 311 | "echo running configure script\n")))) | 310 | "echo running configure script\n")))) |
| 312 | (check | 311 | (check |
| 313 | (gexp->derivation "check-deb-pack" | 312 | (gexp->derivation |
| 314 | (with-imported-modules '((guix build utils)) | 313 | "check-deb-pack" |
| 315 | #~(begin | 314 | (with-imported-modules '((guix build utils)) |
| 316 | (use-modules (guix build utils) | 315 | #~(begin |
| 317 | (ice-9 match) | 316 | (use-modules (guix build utils) |
| 318 | (ice-9 popen) | 317 | (ice-9 match) |
| 319 | (ice-9 rdelim) | 318 | (ice-9 popen) |
| 320 | (ice-9 textual-ports) | 319 | (ice-9 rdelim) |
| 321 | (rnrs base)) | 320 | (ice-9 textual-ports) |
| 322 | 321 | (rnrs base)) | |
| 323 | (setenv "PATH" (string-join | 322 | |
| 324 | (list (string-append #+%tar-bootstrap "/bin") | 323 | (setenv "PATH" (string-join |
| 325 | (string-append #+dpkg "/bin") | 324 | (list (string-append #+%tar-bootstrap "/bin") |
| 326 | (string-append #+%ar-bootstrap "/bin")) | 325 | (string-append #+dpkg "/bin") |
| 327 | ":")) | 326 | (string-append #+%ar-bootstrap "/bin")) |
| 328 | 327 | ":")) | |
| 329 | ;; Validate the output of 'dpkg --info'. | 328 | |
| 330 | (let* ((port (open-pipe* OPEN_READ "dpkg" "--info" #$deb)) | 329 | ;; Validate the output of 'dpkg --info'. |
| 331 | (info (get-string-all port)) | 330 | (let* ((port (open-pipe* OPEN_READ "dpkg" "--info" #$deb)) |
| 332 | (exit-val (status:exit-val (close-pipe port)))) | 331 | (info (get-string-all port)) |
| 333 | (assert (zero? exit-val)) | 332 | (exit-val (status:exit-val (close-pipe port)))) |
| 334 | 333 | (assert (zero? exit-val)) | |
| 335 | (assert (string-contains | 334 | |
| 336 | info | 335 | (assert (string-contains |
| 337 | (string-append "Package: " | 336 | info |
| 338 | #+(package-name %bootstrap-guile)))) | 337 | (string-append "Package: " |
| 339 | 338 | #+(package-name %bootstrap-guile)))) | |
| 340 | (assert (string-contains | 339 | |
| 341 | info | 340 | (assert (string-contains |
| 342 | (string-append "Version: " | 341 | info |
| 343 | #+(package-version %bootstrap-guile))))) | 342 | (string-append "Version: " |
| 344 | 343 | #+(package-version %bootstrap-guile))))) | |
| 345 | ;; Sanity check .deb contents. | 344 | |
| 346 | (invoke "ar" "-xv" #$deb) | 345 | ;; Sanity check .deb contents. |
| 347 | (assert (file-exists? "debian-binary")) | 346 | (invoke "ar" "-xv" #$deb) |
| 348 | (assert (file-exists? "data.tar.gz")) | 347 | (assert (file-exists? "debian-binary")) |
| 349 | (assert (file-exists? "control.tar.gz")) | 348 | (assert (file-exists? "data.tar.gz")) |
| 350 | 349 | (assert (file-exists? "control.tar.gz")) | |
| 351 | ;; Verify there are no hard links in data.tar.gz, as hard | 350 | |
| 352 | ;; links would cause dpkg to fail unpacking the archive. | 351 | ;; Verify there are no hard links in data.tar.gz, as hard |
| 353 | (define hard-links | 352 | ;; links would cause dpkg to fail unpacking the archive. |
| 354 | (let ((port (open-pipe* OPEN_READ "tar" "-tvf" "data.tar.gz"))) | 353 | (define hard-links |
| 355 | (let loop ((hard-links '())) | 354 | (let ((port (open-pipe* OPEN_READ "tar" "-tvf" "data.tar.gz"))) |
| 356 | (match (read-line port) | 355 | (let loop ((hard-links '())) |
| 357 | ((? eof-object?) | 356 | (match (read-line port) |
| 358 | (assert (zero? (status:exit-val (close-pipe port)))) | 357 | ((? eof-object?) |
| 359 | hard-links) | 358 | (assert (zero? (status:exit-val (close-pipe port)))) |
| 360 | (line | 359 | hard-links) |
| 361 | (if (string-prefix? "u" line) | 360 | (line |
| 362 | (loop (cons line hard-links)) | 361 | (if (string-prefix? "u" line) |
| 363 | (loop hard-links))))))) | 362 | (loop (cons line hard-links)) |
| 364 | 363 | (loop hard-links))))))) | |
| 365 | (unless (null? hard-links) | 364 | |
| 366 | (error "hard links found in data.tar.gz" hard-links)) | 365 | (unless (null? hard-links) |
| 367 | 366 | (error "hard links found in data.tar.gz" hard-links)) | |
| 368 | ;; Verify the presence of the control files. | 367 | |
| 369 | (invoke "tar" "-xf" "control.tar.gz") | 368 | ;; Verify the presence of the control files. |
| 370 | (assert (file-exists? "control")) | 369 | (invoke "tar" "-xf" "control.tar.gz") |
| 371 | (assert (and (file-exists? "postinst") | 370 | (assert (file-exists? "control")) |
| 372 | (= #o111 ;script is executable | 371 | (assert (and (file-exists? "postinst") |
| 373 | (logand #o111 (stat:perms | 372 | (= #o111 ;script is executable |
| 374 | (stat "postinst")))))) | 373 | (logand #o111 (stat:perms |
| 375 | (assert (file-exists? "triggers")) | 374 | (stat "postinst")))))) |
| 376 | 375 | (assert (file-exists? "triggers")) | |
| 377 | (mkdir #$output)))))) | 376 | |
| 377 | (mkdir #$output)))))) | ||
| 378 | (built-derivations (list check)))) | 378 | (built-derivations (list check)))) |
| 379 | 379 | ||
| 380 | (unless store (test-skip 1)) | 380 | (unless store (test-skip 1)) |
| @@ -390,32 +390,33 @@ | |||
| 390 | #:symlinks '(("/bin/guile" -> "bin/guile")) | 390 | #:symlinks '(("/bin/guile" -> "bin/guile")) |
| 391 | #:extra-options '(#:relocatable? #t))) | 391 | #:extra-options '(#:relocatable? #t))) |
| 392 | (check | 392 | (check |
| 393 | (gexp->derivation "check-rpm-pack" | 393 | (gexp->derivation |
| 394 | (with-imported-modules (source-module-closure | 394 | "check-rpm-pack" |
| 395 | '((guix build utils))) | 395 | (with-imported-modules (source-module-closure |
| 396 | #~(begin | 396 | '((guix build utils))) |
| 397 | (use-modules (guix build utils)) | 397 | #~(begin |
| 398 | 398 | (use-modules (guix build utils)) | |
| 399 | (define fakeroot #+(file-append fakeroot "/bin/fakeroot")) | 399 | |
| 400 | (define rpm #+(file-append rpm-for-tests "/bin/rpm")) | 400 | (define fakeroot #+(file-append fakeroot "/bin/fakeroot")) |
| 401 | (mkdir-p "/tmp/lib/rpm") | 401 | (define rpm #+(file-append rpm-for-tests "/bin/rpm")) |
| 402 | 402 | (mkdir-p "/tmp/lib/rpm") | |
| 403 | ;; Install the RPM package. This causes RPM to validate the | 403 | |
| 404 | ;; signatures, header as well as the file digests, which | 404 | ;; Install the RPM package. This causes RPM to validate the |
| 405 | ;; makes it a rather thorough test. | 405 | ;; signatures, header as well as the file digests, which |
| 406 | (mkdir "test-prefix") | 406 | ;; makes it a rather thorough test. |
| 407 | (invoke fakeroot rpm "--install" | 407 | (mkdir "test-prefix") |
| 408 | (string-append "--prefix=" (getcwd) "/test-prefix") | 408 | (invoke fakeroot rpm "--install" |
| 409 | #$rpm-pack) | 409 | (string-append "--prefix=" (getcwd) "/test-prefix") |
| 410 | 410 | #$rpm-pack) | |
| 411 | ;; Invoke the installed Guile command. | 411 | |
| 412 | (invoke "./test-prefix/bin/guile" "--version") | 412 | ;; Invoke the installed Guile command. |
| 413 | 413 | (invoke "./test-prefix/bin/guile" "--version") | |
| 414 | ;; Uninstall the RPM package. | 414 | |
| 415 | (invoke fakeroot rpm "--erase" "guile-bootstrap") | 415 | ;; Uninstall the RPM package. |
| 416 | 416 | (invoke fakeroot rpm "--erase" "guile-bootstrap") | |
| 417 | ;; Required so the above is run. | 417 | |
| 418 | (mkdir #$output)))))) | 418 | ;; Required so the above is run. |
| 419 | (mkdir #$output)))))) | ||
| 419 | (built-derivations (list check))))) | 420 | (built-derivations (list check))))) |
| 420 | 421 | ||
| 421 | (test-end) | 422 | (test-end) |
