summaryrefslogtreecommitdiff
path: root/tests/pack.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/pack.scm')
-rw-r--r--tests/pack.scm201
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)