guix - Wojtek's customized Guix

path: root/gnu/packages/patches/perl-autosplit-default-time.patch

diff options

Diffstat (limited to 'gnu/packages/patches/perl-autosplit-default-time.patch')

0 files changed, 0 insertions, 0 deletions

tedir=/var" #$flags))))))) (test-begin "pack") ;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of ;; commit c45477d2a1a651485feede20fe0f3d15aec48b39 and related changes. Thus, ;; run it on the user's store, if it's available, on the grounds that these ;; dependencies may be already there, or we can get substitutes or build them ;; quite inexpensively; see <https://bugs.gnu.org/32184>. (with-external-store store (define-syntax-rule (test-assertm name exp) (test-assert name (let ((guile (package-derivation store %bootstrap-guile))) (run-with-store store exp #:guile-for-build guile)))) (unless store (test-skip 1)) (test-assertm "self-contained-tarball" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (tarball (self-contained-tarball "pack" profile #:symlinks '(("/bin/Guile" -> "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"))))))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "self-contained-tarball + localstatedir" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (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)))))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "self-contained-tarball + localstatedir, UTF-8 file names" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (tree (interned-file-tree `("directory-with-utf8-file-names" directory ("α" regular (data "alpha")) ("λ" 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 (libc-utf8-locales-for-target) "/lib/locale")) (setlocale LC_ALL "en_US.utf8") (mkdir #$output) (exit (and (every valid-file? '("α" "λ") '("alpha" "lambda")) (integer? (valid-path-id db #$tree))))))))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "docker-image + localstatedir" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (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))))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "docker-layered-image + localstatedir" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (tarball (docker-image "docker-pack" profile #:symlinks '(("/bin/Guile" -> "bin/guile")) #:localstatedir? #t #:max-layers 100)) (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")) (define store (string-append "." #$(%store-directory))) (setenv "PATH" (string-append #$%tar-bootstrap "/bin")) (mkdir "base") (with-directory-excursion "base" (invoke "tar" "xvf" #$tarball)) (match (find-files "base" "layer.tar") ((layers ...) (for-each (lambda (layer) (invoke "tar" "xvf" layer) (invoke "chmod" "--recursive" "u+w" store)) layers))) (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") (readlink bin)) (string=? (string-append #$profile "/bin/guile") (readlink "bin/Guile"))) (mkdir #$output))))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "squashfs-image + localstatedir" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (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") (file-is-directory? "tmp") (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)) (test-assertm "deb archive with symlinks and control files" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (deb (debian-archive "deb-pack" profile #:compressor %gzip-compressor #:symlinks '(("/opt/gnu/bin" -> "bin")) #:archiver %tar-bootstrap #:extra-options (list #:triggers-file (plain-file "triggers" "activate-noawait /usr/share/icons/hicolor\n") #:postinst-file (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)))))) (built-derivations (list check)))) (unless store (test-skip 1)) (test-assertm "rpm archive can be installed/uninstalled" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) (profile -> (profile (content (packages->manifest (list %bootstrap-guile))) (hooks '()) (locales? #f))) (rpm-pack (rpm-archive "rpm-pack" profile #:compressor %gzip-compressor #: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)))))) (built-derivations (list check))))) (test-end) ;; Local Variables: ;; eval: (put 'test-assertm 'scheme-indent-function 2) ;; End:


context:
space:
mode: