====================================================== GNU Guix 1.0.1.9150-a230-dirty: ./test-suite.log ====================================================== # TOTAL: 993 # PASS: 980 # SKIP: 10 # XFAIL: 2 # FAIL: 1 # XPASS: 0 # ERROR: 0 .. contents:: :depth: 2 SKIP: tests/base32 ================== sh: nix-hash: command not found test-name: bytevector->base32-string location: /home/brown/src/repos/git.savannah.gnu/guix/tests/base32.scm:48 source: + (test-assert + "bytevector->base32-string" + (fold (lambda (bv expected result) + (and result + (string=? + (bytevector->base32-string bv) + expected))) + #t + (map string->utf8 + '("" "f" "fo" "foo" "foob" "fooba" "foobar")) + '("" + "my" + "mzxq" + "mzxw6" + "mzxw6yq" + "mzxw6ytb" + "mzxw6ytboi"))) actual-value: #t result: PASS test-name: base32-string->bytevector location: /home/brown/src/repos/git.savannah.gnu/guix/tests/base32.scm:65 source: + (test-assert + "base32-string->bytevector" + (every (lambda (bv) + (equal? + (base32-string->bytevector + (bytevector->base32-string bv)) + bv)) + (map string->utf8 + '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) actual-value: #t result: PASS test-name: nix-base32-string->bytevector location: /home/brown/src/repos/git.savannah.gnu/guix/tests/base32.scm:73 source: + (test-assert + "nix-base32-string->bytevector" + (every (lambda (bv) + (equal? + (nix-base32-string->bytevector + (bytevector->nix-base32-string bv)) + bv)) + (map string->utf8 + '("" "f" "fo" "foo" "foob" "fooba" "foobar")))) actual-value: #t result: PASS test-name: &invalid-base32-character location: /home/brown/src/repos/git.savannah.gnu/guix/tests/base32.scm:81 source: + (test-equal + "&invalid-base32-character" + #\e + (guard (c ((invalid-base32-character? c) + (invalid-base32-character-value c))) + (nix-base32-string->bytevector + (string-append (make-string 51 #\a) "e")))) expected-value: #\e actual-value: #\e result: PASS test-name: sha256 & bytevector->nix-base32-string location: /home/brown/src/repos/git.savannah.gnu/guix/tests/base32.scm:92 source: + (test-assert + "sha256 & bytevector->nix-base32-string" + (let ((file (search-path %load-path "tests/test.drv"))) + (equal? + (bytevector->nix-base32-string + (sha256 + (call-with-input-file file get-bytevector-all))) + (let* ((c (format + #f + "~a --type sha256 --base32 --flat \"~a\"" + %nix-hash + file)) + (p (open-input-pipe c)) + (l (read-line p))) + (close-pipe p) + l)))) result: SKIP SKIP: tests/cpio ================ test-name: file->cpio-header + write-cpio-header + read-cpio-header location: /home/brown/src/repos/git.savannah.gnu/guix/tests/cpio.scm:37 source: + (test-assert + "file->cpio-header + write-cpio-header + read-cpio-header" + (let* ((file (search-path %load-path "guix.scm")) + (header (file->cpio-header file))) + (call-with-values + (lambda () (open-bytevector-output-port)) + (lambda (port get-bv) + (write-cpio-header header port) + (let ((port (open-bytevector-input-port (get-bv)))) + (equal? header (read-cpio-header port))))))) actual-value: #t result: PASS test-name: bit-identical to GNU cpio's output location: /home/brown/src/repos/git.savannah.gnu/guix/tests/cpio.scm:49 source: + (test-assert + "bit-identical to GNU cpio's output" + (call-with-temporary-output-file + (lambda (link _) + (delete-file link) + (symlink "chbouib" link) + (let ((files (cons* "/" + (canonicalize-path + (dirname (search-path %load-path "guix.scm"))) + link + (map (compose + canonicalize-path + (cut search-path %load-path <>)) + '("guix.scm" + "guix/build/syscalls.scm" + "guix/packages.scm"))))) + (call-with-temporary-output-file + (lambda (ref-file _) + (let ((pipe (open-pipe* + OPEN_WRITE + %cpio-program + "-o" + "-O" + ref-file + "-H" + "newc" + "--null"))) + (for-each + (lambda (file) (format pipe "~a\x00" file)) + files) + (and (zero? (close-pipe pipe)) + (call-with-temporary-output-file + (lambda (file port) + (write-cpio-archive files port) + (close-port port) + (or (file=? ref-file file) + (throw 'cpio-archives-differ + files + ref-file + file + (stat:size (stat ref-file)) + (stat:size (stat file)))))))))))))) result: SKIP random seed for tests: 1578403139 SKIP: tests/gexp ================ test-name: no refs location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:89 source: + (test-equal + "no refs" + '(display "hello!") + (let ((exp (gexp (display "hello!")))) + (and (gexp? exp) + (null? (gexp-inputs exp)) + (gexp->sexp* exp)))) expected-value: (display "hello!") actual-value: (display "hello!") result: PASS test-name: unquote location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:96 source: + (test-equal + "unquote" + '(display `(foo ,(+ 2 3))) + (let ((exp (gexp (display `(foo ,(+ 2 3)))))) + (and (gexp? exp) + (null? (gexp-inputs exp)) + (gexp->sexp* exp)))) expected-value: (display (quasiquote (foo (unquote (+ 2 3))))) actual-value: (display (quasiquote (foo (unquote (+ 2 3))))) result: PASS test-name: one input package location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:103 source: + (test-assert + "one input package" + (let ((exp (gexp (display (ungexp coreutils))))) + (and (gexp? exp) + (match (gexp-inputs exp) + (((p "out")) (eq? p coreutils))) + (equal? + `(display + ,(derivation->output-path + (package-derivation %store coreutils))) + (gexp->sexp* exp))))) actual-value: #t result: PASS test-name: one input package, dotted list location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:113 source: + (test-assert + "one input package, dotted list" + (let ((exp (gexp (coreutils ungexp coreutils)))) + (and (gexp? exp) + (match (gexp-inputs exp) + (((p "out")) (eq? p coreutils))) + (equal? + `(coreutils + unquote + (derivation->output-path + (package-derivation %store coreutils))) + (gexp->sexp* exp))))) actual-value: #t result: PASS test-name: one input origin location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:123 source: + (test-assert + "one input origin" + (let ((exp (gexp (display (ungexp (package-source coreutils)))))) + (and (gexp? exp) + (match (gexp-inputs exp) + (((o "out")) (eq? o (package-source coreutils)))) + (equal? + `(display + ,(derivation->output-path + (package-source-derivation + %store + (package-source coreutils)))) + (gexp->sexp* exp))))) actual-value: #t result: PASS test-name: one local file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:134 source: + (test-assert + "one local file" + (let* ((file (search-path %load-path "guix.scm")) + (local (local-file file)) + (exp (gexp (display (ungexp local)))) + (intd (add-to-store + %store + (basename file) + #f + "sha256" + file))) + (and (gexp? exp) + (match (gexp-inputs exp) + (((x "out")) (eq? x local))) + (equal? `(display ,intd) (gexp->sexp* exp))))) actual-value: #t result: PASS test-name: one local file, symlink location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:146 source: + (test-assert + "one local file, symlink" + (let ((file (search-path %load-path "guix.scm")) + (link (tmpnam))) + (dynamic-wind + (const #t) + (lambda () + (symlink (canonicalize-path file) link) + (let* ((local (local-file link "my-file" #:recursive? #f)) + (exp (gexp (display (ungexp local)))) + (intd (add-to-store %store "my-file" #f "sha256" file))) + (and (gexp? exp) + (match (gexp-inputs exp) + (((x "out")) (eq? x local))) + (equal? `(display ,intd) (gexp->sexp* exp))))) + (lambda () + (false-if-exception (delete-file link)))))) actual-value: #t result: PASS test-name: local-file, relative file name location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:165 source: + (test-equal + "local-file, relative file name" + (canonicalize-path + (search-path %load-path "guix/base32.scm")) + (let ((directory + (dirname + (search-path + %load-path + "guix/build-system/gnu.scm")))) + (with-directory-excursion + directory + (let ((file (local-file "../guix/base32.scm"))) + (local-file-absolute-file-name file))))) expected-value: "/home/brown/src/repos/git.savannah.gnu/guix/guix/base32.scm" actual-value: "/home/brown/src/repos/git.savannah.gnu/guix/guix/base32.scm" result: PASS test-name: local-file, non-literal relative file name location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:173 source: + (test-equal + "local-file, non-literal relative file name" + (canonicalize-path + (search-path %load-path "guix/base32.scm")) + (let ((directory + (dirname + (search-path + %load-path + "guix/build-system/gnu.scm")))) + (with-directory-excursion + directory + (let ((file (local-file (string-copy "../base32.scm")))) + (local-file-absolute-file-name file))))) expected-value: "/home/brown/src/repos/git.savannah.gnu/guix/guix/base32.scm" actual-value: "/home/brown/src/repos/git.savannah.gnu/guix/guix/base32.scm" result: PASS test-name: local-file, #:select? location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:181 source: + (test-assert + "local-file, #:select?" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((select? + -> + (lambda (file stat) + (member + (basename file) + '("guix.scm" "tests" "gexp.scm")))) + (file -> + (local-file + ".." + "directory" + #:recursive? + #t + #:select? + select?)) + (dir (lower-object file))) + (return + (and (store-path? dir) + (equal? + (scandir dir) + '("." ".." "guix.scm" "tests")) + (equal? + (scandir (string-append dir "/tests")) + '("." ".." "gexp.scm"))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: one plain file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:196 source: + (test-assert + "one plain file" + (let* ((file (plain-file "hi" "Hello, world!")) + (exp (gexp (display (ungexp file)))) + (expected + (add-text-to-store %store "hi" "Hello, world!"))) + (and (gexp? exp) + (match (gexp-inputs exp) + (((x "out")) (eq? x file))) + (equal? `(display ,expected) (gexp->sexp* exp))))) actual-value: #t result: PASS test-name: same input twice location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:206 source: + (test-assert + "same input twice" + (let ((exp (gexp (begin + (display (ungexp coreutils)) + (display (ungexp coreutils)))))) + (and (gexp? exp) + (match (gexp-inputs exp) + (((p "out")) (eq? p coreutils))) + (let ((e `(display + ,(derivation->output-path + (package-derivation %store coreutils))))) + (equal? `(begin ,e ,e) (gexp->sexp* exp)))))) actual-value: #t result: PASS test-name: two input packages, one derivation, one file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:218 source: + (test-assert + "two input packages, one derivation, one file" + (let* ((drv (build-expression->derivation + %store + "foo" + 'bar + #:guile-for-build + (package-derivation %store %bootstrap-guile))) + (txt (add-text-to-store %store "foo" "Hello, world!")) + (exp (gexp (begin + (display (ungexp coreutils)) + (display (ungexp %bootstrap-guile)) + (display (ungexp drv)) + (display (ungexp txt)))))) + (define (match-input thing) + (match-lambda + ((drv-or-pkg _ ...) (eq? thing drv-or-pkg)))) + (and (gexp? exp) + (= 4 (length (gexp-inputs exp))) + (every (lambda (input) + (find (match-input input) (gexp-inputs exp))) + (list drv coreutils %bootstrap-guile txt)) + (let ((e0 `(display + ,(derivation->output-path + (package-derivation %store coreutils)))) + (e1 `(display + ,(derivation->output-path + (package-derivation %store %bootstrap-guile)))) + (e2 `(display ,(derivation->output-path drv))) + (e3 `(display ,txt))) + (equal? + `(begin ,e0 ,e1 ,e2 ,e3) + (gexp->sexp* exp)))))) actual-value: #t result: PASS test-name: file-append location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:246 source: + (test-assert + "file-append" + (let* ((drv (package-derivation %store %bootstrap-guile)) + (fa (file-append %bootstrap-guile "/bin/guile")) + (exp (gexp (here we go (ungexp fa))))) + (and (match (gexp->sexp* exp) + (('here 'we 'go (? string? result)) + (string=? + result + (string-append + (derivation->output-path drv) + "/bin/guile")))) + (match (gexp-inputs exp) + (((thing "out")) (eq? thing fa)))))) actual-value: #t result: PASS test-name: file-append, output location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:259 source: + (test-assert + "file-append, output" + (let* ((drv (package-derivation %store glibc)) + (fa (file-append glibc "/lib" "/debug")) + (exp (gexp (foo (ungexp fa "debug"))))) + (and (match (gexp->sexp* exp) + (('foo (? string? result)) + (string=? + result + (string-append + (derivation->output-path drv "debug") + "/lib/debug")))) + (match (gexp-inputs exp) + (((thing "debug")) (eq? thing fa)))))) actual-value: #t result: PASS test-name: file-append, nested location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:272 source: + (test-assert + "file-append, nested" + (let* ((drv (package-derivation %store glibc)) + (dir (file-append glibc "/bin")) + (slash (file-append dir "/")) + (file (file-append slash "getent")) + (exp (gexp (foo (ungexp file))))) + (and (match (gexp->sexp* exp) + (('foo (? string? result)) + (string=? + result + (string-append + (derivation->output-path drv) + "/bin/getent")))) + (match (gexp-inputs exp) + (((thing "out")) (eq? thing file)))))) actual-value: #t result: PASS test-name: ungexp + ungexp-native location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:287 source: + (test-assert + "ungexp + ungexp-native" + (let* ((exp (gexp (list (ungexp-native %bootstrap-guile) + (ungexp coreutils) + (ungexp-native glibc) + (ungexp binutils)))) + (target "mips64el-linux") + (guile (derivation->output-path + (package-derivation %store %bootstrap-guile))) + (cu (derivation->output-path + (package-cross-derivation + %store + coreutils + target))) + (libc (derivation->output-path + (package-derivation %store glibc))) + (bu (derivation->output-path + (package-cross-derivation %store binutils target)))) + (and (lset= equal? + `((,%bootstrap-guile "out") (,glibc "out")) + (gexp-native-inputs exp)) + (lset= equal? + `((,coreutils "out") (,binutils "out")) + (gexp-inputs exp)) + (equal? + `(list ,guile ,cu ,libc ,bu) + (gexp->sexp* exp target))))) actual-value: #t result: PASS test-name: ungexp + ungexp-native, nested location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:310 source: + (test-equal + "ungexp + ungexp-native, nested" + (list `((,%bootstrap-guile "out")) + '<> + `((,coreutils "out"))) + (let* ((exp (gexp (list (ungexp-native (gexp (ungexp coreutils))) + (ungexp %bootstrap-guile))))) + (list (gexp-inputs exp) + '<> + (gexp-native-inputs exp)))) expected-value: (((# "out")) <> ((# "out"))) actual-value: (((# "out")) <> ((# "out"))) result: PASS test-name: ungexp + ungexp-native, nested, special mixture location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:316 source: + (test-equal + "ungexp + ungexp-native, nested, special mixture" + `(() <> ((,coreutils "out"))) + (let* ((foo (gexp (foo (ungexp-native coreutils)))) + (exp (gexp (bar (ungexp foo))))) + (list (gexp-inputs exp) + '<> + (gexp-native-inputs exp)))) expected-value: (() <> ((# "out"))) actual-value: (() <> ((# "out"))) result: PASS test-name: input list location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:324 source: + (test-assert + "input list" + (let ((exp (gexp (display + '(ungexp (list %bootstrap-guile coreutils))))) + (guile (derivation->output-path + (package-derivation %store %bootstrap-guile))) + (cu (derivation->output-path + (package-derivation %store coreutils)))) + (and (lset= equal? + `((,%bootstrap-guile "out") (,coreutils "out")) + (gexp-inputs exp)) + (equal? + `(display '(,guile ,cu)) + (gexp->sexp* exp))))) actual-value: #t result: PASS test-name: input list + ungexp-native location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:337 source: + (test-assert + "input list + ungexp-native" + (let* ((target "mips64el-linux") + (exp (gexp (display + (cons '(ungexp-native + (list %bootstrap-guile coreutils)) + '(ungexp (list glibc binutils)))))) + (guile (derivation->output-path + (package-derivation %store %bootstrap-guile))) + (cu (derivation->output-path + (package-derivation %store coreutils))) + (xlibc (derivation->output-path + (package-cross-derivation %store glibc target))) + (xbu (derivation->output-path + (package-cross-derivation %store binutils target)))) + (and (lset= equal? + `((,%bootstrap-guile "out") (,coreutils "out")) + (gexp-native-inputs exp)) + (lset= equal? + `((,glibc "out") (,binutils "out")) + (gexp-inputs exp)) + (equal? + `(display (cons '(,guile ,cu) '(,xlibc ,xbu))) + (gexp->sexp* exp target))))) actual-value: #t result: PASS test-name: input list splicing location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:359 source: + (test-assert + "input list splicing" + (let* ((inputs + (list (gexp-input glibc "debug") + %bootstrap-guile)) + (outputs + (list (derivation->output-path + (package-derivation %store glibc) + "debug") + (derivation->output-path + (package-derivation %store %bootstrap-guile)))) + (exp (gexp (list (ungexp-splicing (cons (+ 2 3) inputs)))))) + (and (lset= equal? + `((,glibc "debug") (,%bootstrap-guile "out")) + (gexp-inputs exp)) + (equal? + (gexp->sexp* exp) + `(list ,@(cons 5 outputs)))))) actual-value: #t result: PASS test-name: input list splicing + ungexp-native-splicing location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:373 source: + (test-assert + "input list splicing + ungexp-native-splicing" + (let* ((inputs + (list (gexp-input glibc "debug" #:native? #t) + %bootstrap-guile)) + (exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs)))))) + (and (lset= equal? + `((,glibc "debug") (,%bootstrap-guile "out")) + (gexp-native-inputs exp)) + (null? (gexp-inputs exp)) + (equal? + (gexp->sexp* exp) + (gexp->sexp* exp "mips64el-linux"))))) actual-value: #t result: PASS test-name: gexp list splicing + ungexp-splicing location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:384 source: + (test-assert + "gexp list splicing + ungexp-splicing" + (let* ((inner (gexp (ungexp-native glibc))) + (exp (gexp (list (ungexp-splicing (list inner)))))) + (and (equal? + `((,glibc "out")) + (gexp-native-inputs exp)) + (null? (gexp-inputs exp)) + (equal? + (gexp->sexp* exp) + (gexp->sexp* exp "mips64el-linux"))))) actual-value: #t result: PASS test-name: output list location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:392 source: + (test-equal + "output list" + 2 + (let ((exp (gexp (begin + (mkdir (ungexp output)) + (mkdir (ungexp output "bar")))))) + (length (gexp-outputs exp)))) expected-value: 2 actual-value: 2 result: PASS test-name: output list, combined gexps location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:398 source: + (test-assert + "output list, combined gexps" + (let* ((exp0 (gexp (mkdir (ungexp output)))) + (exp1 (gexp (mkdir (ungexp output "foo")))) + (exp2 (gexp (begin + (display "hi!") + (ungexp exp0) + (ungexp exp1))))) + (and (lset= equal? + (append (gexp-outputs exp0) (gexp-outputs exp1)) + (gexp-outputs exp2)) + (= 2 (length (gexp-outputs exp2)))))) actual-value: #t result: PASS test-name: output list, combined gexps, duplicate output location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:407 source: + (test-equal + "output list, combined gexps, duplicate output" + 1 + (let* ((exp0 (gexp (mkdir (ungexp output)))) + (exp1 (gexp (begin (mkdir (ungexp output)) (ungexp exp0)))) + (exp2 (gexp (begin (mkdir (ungexp output)) (ungexp exp1))))) + (length (gexp-outputs exp2)))) expected-value: 1 actual-value: 1 result: PASS test-name: output list + ungexp-splicing list, combined gexps location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:414 source: + (test-assert + "output list + ungexp-splicing list, combined gexps" + (let* ((exp0 (gexp (mkdir (ungexp output)))) + (exp1 (gexp (mkdir (ungexp output "foo")))) + (exp2 (gexp (begin + (display "hi!") + (ungexp-splicing (list exp0 exp1)))))) + (and (lset= equal? + (append (gexp-outputs exp0) (gexp-outputs exp1)) + (gexp-outputs exp2)) + (= 2 (length (gexp-outputs exp2)))))) actual-value: #t result: PASS test-name: gexp->file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:424 source: + (test-assert + "gexp->file" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((exp -> + (gexp (display (ungexp %bootstrap-guile)))) + (guile (package-file %bootstrap-guile)) + (sexp (gexp->sexp exp)) + (drv (gexp->file "foo" exp)) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv))) + (refs (references* out))) + (return + (and (equal? sexp (call-with-input-file out read)) + (equal? (list guile) refs)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->file + file-append location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:435 source: + (test-assert + "gexp->file + file-append" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((exp -> + (gexp (ungexp + (file-append %bootstrap-guile "/bin/guile")))) + (guile (package-file %bootstrap-guile)) + (drv (gexp->file "foo" exp)) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv))) + (refs (references* out))) + (return + (and (equal? + (string-append guile "/bin/guile") + (call-with-input-file out read)) + (equal? (list guile) refs)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->file + #:splice? location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:447 source: + (test-assert + "gexp->file + #:splice?" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((exp -> + (list (gexp (define foo 'bar)) + (gexp (define guile + (ungexp %bootstrap-guile))))) + (guile (package-file %bootstrap-guile)) + (drv (gexp->file "splice" exp #:splice? #t)) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv))) + (refs (references* out))) + (pk 'splice out) + (return + (and (equal? + `((define foo 'bar) + (define guile ,guile) + ,(call-with-input-string "" read)) + (call-with-input-file + out + (lambda (port) + (list (read port) (read port) (read port))))) + (equal? (list guile) refs)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) ;;; (splice "/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/lpkqr70nisgh5ajipjrlncfwxmpyx9bj-splice") actual-value: #t result: PASS test-name: gexp->derivation location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:465 source: + (test-assert + "gexp->derivation" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((file (text-file "foo" "Hello, world!")) + (exp -> + (gexp (begin + (mkdir (ungexp output)) + (chdir (ungexp output)) + (symlink + (string-append + (ungexp %bootstrap-guile) + "/bin/guile") + "foo") + (symlink + (ungexp file) + (ungexp output "2nd"))))) + (drv (gexp->derivation "foo" exp)) + (out -> (derivation->output-path drv)) + (out2 -> (derivation->output-path drv "2nd")) + (done (built-derivations (list drv))) + (refs (references* out)) + (refs2 (references* out2)) + (guile (package-file %bootstrap-guile "bin/guile"))) + (return + (and (string=? + (readlink (string-append out "/foo")) + guile) + (string=? (readlink out2) file) + (equal? refs (list (dirname (dirname guile)))) + (equal? refs2 (list file)) + (null? (derivation-properties drv))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation properties location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:490 source: + (test-assert + "gexp->derivation properties" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet %store-monad + ((drv (gexp->derivation + "foo" + (gexp (mkdir (ungexp output))) + #:properties + '((type . test))))) + (return + (equal? + '((type . test)) + (derivation-properties drv)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation vs. grafts location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:497 source: + (test-assert + "gexp->derivation vs. grafts" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((graft? (set-grafting #f)) + (p0 -> + (dummy-package + "dummy" + (arguments '(#:implicit-inputs? #f)))) + (r -> (package (inherit p0) (name "DuMMY"))) + (p1 -> (package (inherit p0) (replacement r))) + (exp0 -> + (gexp (frob (ungexp p0) (ungexp output)))) + (exp1 -> + (gexp (frob (ungexp p1) (ungexp output)))) + (void (set-guile-for-build %bootstrap-guile)) + (drv0 (gexp->derivation "t" exp0 #:graft? #t)) + (drv1 (gexp->derivation "t" exp1 #:graft? #t)) + (drv1* (gexp->derivation "t" exp1 #:graft? #f)) + (_ (set-grafting graft?))) + (return + (and (not (string=? + (derivation->output-path drv0) + (derivation->output-path drv1))) + (string=? + (derivation->output-path drv0) + (derivation->output-path drv1*))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation, composed gexps location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:516 source: + (test-assert + "gexp->derivation, composed gexps" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((exp0 -> + (gexp (begin + (mkdir (ungexp output)) + (chdir (ungexp output))))) + (exp1 -> + (gexp (symlink + (string-append + (ungexp %bootstrap-guile) + "/bin/guile") + "foo"))) + (exp -> + (gexp (begin (ungexp exp0) (ungexp exp1)))) + (drv (gexp->derivation "foo" exp)) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv))) + (guile (package-file %bootstrap-guile "bin/guile"))) + (return + (string=? + (readlink (string-append out "/foo")) + guile))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation, default system location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:532 source: + (test-assert + "gexp->derivation, default system" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (let ((system (%current-system)) + (mdrv (parameterize + ((%current-system "foobar64-linux")) + (gexp->derivation + "foo" + (gexp (mkdir (ungexp output))))))) + (mlet %store-monad + ((drv mdrv)) + (return + (string=? system (derivation-system drv))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation, local-file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:543 source: + (test-assert + "gexp->derivation, local-file" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((file -> (search-path %load-path "guix.scm")) + (intd (interned-file file #:recursive? #f)) + (local -> (local-file file)) + (exp -> + (gexp (begin + (stat (ungexp local)) + (symlink (ungexp local) (ungexp output))))) + (drv (gexp->derivation "local-file" exp))) + (mbegin + %store-monad + (built-derivations (list drv)) + (return + (string=? + (readlink (derivation->output-path drv)) + intd)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation, cross-compilation location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:557 source: + (test-assert + "gexp->derivation, cross-compilation" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((target -> "mips64el-linux") + (exp -> + (gexp (list (ungexp coreutils) (ungexp output)))) + (xdrv (gexp->derivation "foo" exp #:target target)) + (refs (references* (derivation-file-name xdrv))) + (xcu (package->cross-derivation coreutils target)) + (cu (package->derivation coreutils))) + (return + (and (member (derivation-file-name xcu) refs) + (not (member (derivation-file-name cu) refs))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation, ungexp-native location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:571 source: + (test-assert + "gexp->derivation, ungexp-native" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((target -> "mips64el-linux") + (exp -> + (gexp (list (ungexp-native coreutils) + (ungexp output)))) + (xdrv (gexp->derivation "foo" exp #:target target)) + (drv (gexp->derivation "foo" exp))) + (return + (string=? + (derivation-file-name drv) + (derivation-file-name xdrv)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation, ungexp + ungexp-native location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:581 source: + (test-assert + "gexp->derivation, ungexp + ungexp-native" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((target -> "mips64el-linux") + (exp -> + (gexp (list (ungexp-native coreutils) + (ungexp glibc) + (ungexp output)))) + (xdrv (gexp->derivation "foo" exp #:target target)) + (refs (references* (derivation-file-name xdrv))) + (xglibc (package->cross-derivation glibc target)) + (cu (package->derivation coreutils))) + (return + (and (member (derivation-file-name cu) refs) + (member (derivation-file-name xglibc) refs)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: ("/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/m77j1nw1csw6ajhag8gsxijgi3rg18lp-glibc-2.29.drv" "/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/qjwnkn193sf2nmj93ms03s6pws8db6vh-foo-builder") result: PASS test-name: gexp->derivation, ungexp-native + composed gexps location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:595 source: + (test-assert + "gexp->derivation, ungexp-native + composed gexps" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((target -> "mips64el-linux") + (exp0 -> (gexp (list 1 2 (ungexp coreutils)))) + (exp -> (gexp (list 0 (ungexp-native exp0)))) + (xdrv (gexp->derivation "foo" exp #:target target)) + (drv (gexp->derivation "foo" exp))) + (return + (string=? + (derivation-file-name drv) + (derivation-file-name xdrv)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation, store copy location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:606 source: + (test-assert + "gexp->derivation, store copy" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (let ((build-one + (gexp (call-with-output-file + (ungexp output) + (lambda (port) + (display "This is the one." port))))) + (build-two + (lambda (one) + (gexp (begin + (mkdir (ungexp output)) + (symlink + (ungexp one) + (string-append (ungexp output) "/one")) + (call-with-output-file + (string-append (ungexp output) "/two") + (lambda (port) + (display + "This is the second one." + port))))))) + (build-drv + (gexp (begin + (use-modules (guix build store-copy)) + (mkdir (ungexp output)) + (populate-store '("graph") (ungexp output)))))) + (mlet* %store-monad + ((one (gexp->derivation "one" build-one)) + (two (gexp->derivation "two" (build-two one))) + (drv (gexp->derivation + "store-copy" + build-drv + #:references-graphs + `(("graph" ,two)) + #:modules + '((guix build store-copy) + (guix progress) + (guix records) + (guix sets) + (guix build utils)))) + (ok? (built-derivations (list drv))) + (out -> (derivation->output-path drv))) + (let ((one (derivation->output-path one)) + (two (derivation->output-path two))) + (return + (and ok? + (file-exists? (string-append out "/" one)) + (file-exists? (string-append out "/" two)) + (file-exists? (string-append out "/" two "/two")) + (string=? + (readlink (string-append out "/" two "/one")) + one)))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: imported-files location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:644 source: + (test-assert + "imported-files" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((files -> + `(("x" + unquote + (search-path %load-path "ice-9/q.scm")) + ("a/b/c" + unquote + (search-path %load-path "guix/derivations.scm")) + ("p/q" + unquote + (search-path %load-path "guix.scm")) + ("p/z" + unquote + (search-path %load-path "guix/store.scm")))) + (dir (imported-files files))) + (mbegin + %store-monad + (return + (every (match-lambda + ((path . source) + (equal? + (call-with-input-file + (string-append dir "/" path) + get-bytevector-all) + (call-with-input-file + source + get-bytevector-all)))) + files)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: imported-files with file-like objects location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:662 source: + (test-assert + "imported-files with file-like objects" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((plain -> (plain-file "foo" "bar!")) + (q-scm -> (search-path %load-path "ice-9/q.scm")) + (files -> + `(("a/b/c" unquote q-scm) ("p/q" unquote plain))) + (drv (imported-files files))) + (define (file=? file1 file2) + (= (stat:ino (stat file1)) + (stat:ino (stat file2)))) + (mbegin + %store-monad + (built-derivations (list (pk 'drv drv))) + (mlet %store-monad + ((dir -> (derivation->output-path drv)) + (plain* (text-file "foo" "bar!")) + (q-scm* (interned-file q-scm "c"))) + (return + (and (file=? (string-append dir "/a/b/c") q-scm*) + (file=? + (string-append dir "/p/q") + plain*)))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) ;;; (drv # /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/ac6nqb847yv4a7kslzqaga7f0vh3mdgc-file-import 7f94b97c4fa0>) actual-value: #t result: PASS test-name: gexp-modules & ungexp location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:682 source: + (test-equal + "gexp-modules & ungexp" + '((bar) (foo)) + ((@@ (guix gexp) gexp-modules) + (gexp (foo (ungexp + (with-imported-modules '((foo)) (gexp +))) + (ungexp-native + (with-imported-modules '((bar)) (gexp -))))))) expected-value: ((bar) (foo)) actual-value: ((bar) (foo)) result: PASS test-name: gexp-modules & ungexp-splicing location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:688 source: + (test-equal + "gexp-modules & ungexp-splicing" + '((foo) (bar)) + ((@@ (guix gexp) gexp-modules) + (gexp (foo (ungexp-splicing + (list (with-imported-modules '((foo)) (gexp +)) + (with-imported-modules '((bar)) (gexp -)))))))) expected-value: ((foo) (bar)) actual-value: ((foo) (bar)) result: PASS test-name: gexp-modules deletes duplicates location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:694 source: + (test-assert + "gexp-modules deletes duplicates" + (let ((make-file + (lambda () + (eval '(scheme-file + "bar.scm" + (gexp (define-module (bar)))) + (current-module))))) + (define result + ((@@ (guix gexp) gexp-modules) + (with-imported-modules + `(((bar) => ,(make-file)) + ((bar) => ,(make-file)) + (foo) + (foo)) + (gexp +)))) + (match result + (((('bar) '=> (? scheme-file?)) ('foo)) #t)))) actual-value: #t result: PASS test-name: gexp-modules and literal Scheme object location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:710 source: + (test-equal + "gexp-modules and literal Scheme object" + '() + (gexp-modules #t)) expected-value: () actual-value: () result: PASS test-name: gexp->derivation #:modules location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:714 source: + (test-assert + "gexp->derivation #:modules" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((build -> + (gexp (begin + (use-modules (guix build utils)) + (mkdir-p + (string-append + (ungexp output) + "/guile/guix/nix")) + #t))) + (drv (gexp->derivation + "test-with-modules" + build + #:modules + '((guix build utils))))) + (mbegin + %store-monad + (built-derivations (list drv)) + (let* ((p (derivation->output-path drv)) + (s (stat (string-append p "/guile/guix/nix")))) + (return (eq? (stat:type s) 'directory))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation & with-imported-modules location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:728 source: + (test-assert + "gexp->derivation & with-imported-modules" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((build -> + (with-imported-modules + '((guix build utils)) + (gexp (begin + (use-modules (guix build utils)) + (mkdir-p + (string-append + (ungexp output) + "/guile/guix/nix")) + #t)))) + (drv (gexp->derivation "test-with-modules" build))) + (mbegin + %store-monad + (built-derivations (list drv)) + (let* ((p (derivation->output-path drv)) + (s (stat (string-append p "/guile/guix/nix")))) + (return (eq? (stat:type s) 'directory))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation & nested with-imported-modules location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:743 source: + (test-assert + "gexp->derivation & nested with-imported-modules" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((build1 + -> + (with-imported-modules + '((guix build utils)) + (gexp (begin + (use-modules (guix build utils)) + (mkdir-p + (string-append + (ungexp output) + "/guile/guix/nix")) + #t)))) + (build2 + -> + (with-imported-modules + '((guix build bournish)) + (gexp (begin + (use-modules + (guix build bournish) + (system base compile)) + (ungexp-native build1) + (call-with-output-file + (string-append (ungexp output) "/b") + (lambda (port) + (write (read-and-compile + (open-input-string "cd /foo") + #:from + %bournish-language + #:to + 'scheme) + port))))))) + (drv (gexp->derivation "test-with-modules" build2))) + (mbegin + %store-monad + (built-derivations (list drv)) + (let* ((p (derivation->output-path drv)) + (s (stat (string-append p "/guile/guix/nix"))) + (b (string-append p "/b"))) + (return + (and (eq? (stat:type s) 'directory) + (equal? + '(chdir "/foo") + (call-with-input-file b read))))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation & with-imported-module & computed module location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:772 source: + (test-assert + "gexp->derivation & with-imported-module & computed module" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((module + -> + (scheme-file + "x" + (gexp ((define-module (foo bar) #:export (the-answer)) + (define the-answer 42))) + #:splice? + #t)) + (build -> + (with-imported-modules + `(((foo bar) => ,module) (guix build utils)) + (gexp (begin + (use-modules (guix build utils) (foo bar)) + mkdir-p + (call-with-output-file + (ungexp output) + (lambda (port) + (write the-answer port))))))) + (drv (gexp->derivation "thing" build)) + (out -> (derivation->output-path drv))) + (mbegin + %store-monad + (built-derivations (list drv)) + (return (= 42 (call-with-input-file out read))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp-extensions & ungexp location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:795 source: + (test-equal + "gexp-extensions & ungexp" + (list sed grep) + ((@@ (guix gexp) gexp-extensions) + (gexp (foo (ungexp (with-extensions (list grep) (gexp +))) + (ungexp-native + (with-extensions (list sed) (gexp -))))))) expected-value: (# #) actual-value: (# #) result: PASS test-name: gexp-extensions & ungexp-splicing location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:801 source: + (test-equal + "gexp-extensions & ungexp-splicing" + (list grep sed) + ((@@ (guix gexp) gexp-extensions) + (gexp (foo (ungexp-splicing + (list (with-extensions (list grep) (gexp +)) + (with-imported-modules + '((foo)) + (with-extensions (list sed) (gexp -))))))))) expected-value: (# #) actual-value: (# #) result: PASS test-name: gexp-extensions and literal Scheme object location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:808 source: + (test-equal + "gexp-extensions and literal Scheme object" + '() + ((@@ (guix gexp) gexp-extensions) #t)) expected-value: () actual-value: () result: PASS test-name: gexp->derivation & with-extensions location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:812 source: + (test-assert + "gexp->derivation & with-extensions" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((extension -> %extension-package) + (module + -> + (scheme-file + "x" + (gexp ((define-module + (foo) + #:use-module + (hg2g) + #:export + (multiply)) + (define (multiply x) (* the-answer x)))) + #:splice? + #t)) + (build -> + (with-extensions + (list extension) + (with-imported-modules + `((guix build utils) ((foo) => ,module)) + (gexp (begin + (use-modules + (guix build utils) + (hg2g) + (foo)) + (call-with-output-file + (ungexp output) + (lambda (port) + (write (list the-answer + (multiply 2)) + port)))))))) + (drv (gexp->derivation + "thingie" + build + #:effective-version + "2.0")) + (out -> (derivation->output-path drv))) + (mbegin + %store-monad + (built-derivations (list drv)) + (return + (equal? '(42 84) (call-with-input-file out read))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: lower-gexp location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:843 source: + (test-assert + "lower-gexp" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((extension -> %extension-package) + (extension-drv + (package->derivation %extension-package)) + (coreutils-drv (package->derivation coreutils)) + (exp -> + (with-extensions + (list extension) + (with-imported-modules + `((guix build utils)) + (gexp (begin + (use-modules (guix build utils) (hg2g)) + (ungexp coreutils "debug") + mkdir-p + the-answer))))) + (lexp (lower-gexp exp #:effective-version "2.0"))) + (define (matching-input drv output) + (lambda (input) + (and (eq? (derivation-input-derivation input) drv) + (equal? + (derivation-input-sub-derivations input) + (list output))))) + (mbegin + %store-monad + (return + (and (find (matching-input extension-drv "out") + (lowered-gexp-inputs (pk 'lexp lexp))) + (find (matching-input coreutils-drv "debug") + (lowered-gexp-inputs lexp)) + (member + (string-append + (derivation->output-path extension-drv) + "/share/guile/site/2.0") + (lowered-gexp-load-path lexp)) + (= 2 (length (lowered-gexp-load-path lexp))) + (member + (string-append + (derivation->output-path extension-drv) + "/lib/guile/2.0/site-ccache") + (lowered-gexp-load-compiled-path lexp)) + (= 2 + (length (lowered-gexp-load-compiled-path lexp))) + (eq? (derivation-input-derivation + (lowered-gexp-guile lexp)) + (%guile-for-build)))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) ;;; (lexp #< sexp: (begin (use-modules (guix build utils) (hg2g)) "/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/3z59474a4vlqi6fqrbmbkv6cxy86qnq1-coreutils-8.31-debug" mkdir-p the-answer) inputs: (#< drv: # /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/h2vlbyx0jv0xq0dafdgl2q1x1g1mmpdv-module-import-compiled 7f94b9cfa4b0> sub-derivations: ("out")> #< drv: # /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/6vb93rg7jsiyy5a9x1ikpf00cj02klgj-extension-0 7f94b9cfadc0> sub-derivations: ("out")> #< drv: # /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/3z59474a4vlqi6fqrbmbkv6cxy86qnq1-coreutils-8.31-debug /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/qnz2s0iy18wk253kr68870x0vphfca38-coreutils-8.31 7f94c657c870> sub-derivations: ("debug")>) sources: ("/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/qmn7qpbikn1qsjd1m1qbfrk8lvbhxizq-module-import") guile: #< drv: # /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/hw791qm45b11l7jhplxxdilgq6x0lmq0-guile-bootstrap-2.0 7f94c6507eb0> sub-derivations: ("out")> load-path: ("/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/qmn7qpbikn1qsjd1m1qbfrk8lvbhxizq-module-import" "/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/6vb93rg7jsiyy5a9x1ikpf00cj02klgj-extension-0/share/guile/site/2.0") load-compiled-path: ("/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/h2vlbyx0jv0xq0dafdgl2q1x1g1mmpdv-module-import-compiled" "/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/6vb93rg7jsiyy5a9x1ikpf00cj02klgj-extension-0/lib/guile/2.0/site-ccache")>) actual-value: #t result: PASS test-name: lower-gexp, raw-derivation-file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:882 source: + (test-assert + "lower-gexp, raw-derivation-file" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((thing -> + (program-file "prog" (gexp (display "hi!")))) + (exp -> + (gexp (list (ungexp (raw-derivation-file thing))))) + (drv (lower-object thing)) + (lexp (lower-gexp exp #:effective-version "2.0"))) + (return + (and (equal? + `(list ,(derivation-file-name drv)) + (lowered-gexp-sexp lexp)) + (equal? + (list (derivation-file-name drv)) + (lowered-gexp-sources lexp)) + (null? (lowered-gexp-inputs lexp))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: lower-gexp, non-self-quoting input location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:893 source: + (test-eq + "lower-gexp, non-self-quoting input" + + + (guard (c ((gexp-input-error? c) + (gexp-error-invalid-input c))) + (run-with-store + %store + (lower-gexp (gexp (foo (ungexp +))))))) expected-value: # actual-value: # result: PASS test-name: lower-gexp, character literal location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:900 source: + (test-equal + "lower-gexp, character literal" + '(#\+) + (lowered-gexp-sexp + (run-with-store %store (lower-gexp (gexp (#\+)))))) expected-value: (#\+) actual-value: (#\+) result: PASS test-name: gexp->derivation #:references-graphs location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:906 source: + (test-assert + "gexp->derivation #:references-graphs" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((one (text-file "one" (random-text))) + (two (gexp->derivation + "two" + (gexp (symlink + (ungexp one) + (ungexp output "chbouib"))))) + (build -> + (with-imported-modules + '((guix build store-copy) + (guix progress) + (guix records) + (guix sets) + (guix build utils)) + (gexp (begin + (use-modules (guix build store-copy)) + (with-output-to-file + (ungexp output) + (lambda () + (write (map store-info-item + (call-with-input-file + "guile" + read-reference-graph))))) + (with-output-to-file + (ungexp output "one") + (lambda () + (write (map store-info-item + (call-with-input-file + "one" + read-reference-graph))))) + (with-output-to-file + (ungexp output "two") + (lambda () + (write (map store-info-item + (call-with-input-file + "two" + read-reference-graph))))))))) + (drv (gexp->derivation + "ref-graphs" + build + #:references-graphs + `(("one" ,one) + ("two" ,two "chbouib") + ("guile" ,%bootstrap-guile)))) + (ok? (built-derivations (list drv))) + (guile-drv + (package->derivation %bootstrap-guile)) + (bash (interned-file + (search-bootstrap-binary + "bash" + (%current-system)) + "bash" + #:recursive? + #t)) + (g-one -> (derivation->output-path drv "one")) + (g-two -> (derivation->output-path drv "two")) + (g-guile -> (derivation->output-path drv))) + (return + (and ok? + (equal? + (call-with-input-file g-one read) + (list one)) + (lset= string=? + (call-with-input-file g-two read) + (list one + (derivation->output-path + two + "chbouib"))) + (lset= string=? + (call-with-input-file g-guile read) + (list (derivation->output-path guile-drv) + bash))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) random seed for tests: 1578403010 @ build-started /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/z95k7724w8q9wy06xn72g3wdkr2j12v9-two.drv - x86_64-linux /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/var/log/guix/drvs/z9//5k7724w8q9wy06xn72g3wdkr2j12v9-two.drv.bz2 28410 @ build-succeeded /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/z95k7724w8q9wy06xn72g3wdkr2j12v9-two.drv - @ build-started /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/2zkflf9x7d17ql2586819w45vfzpyql3-ref-graphs.drv - x86_64-linux /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/var/log/guix/drvs/2z//kflf9x7d17ql2586819w45vfzpyql3-ref-graphs.drv.bz2 28423 @ build-succeeded /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/2zkflf9x7d17ql2586819w45vfzpyql3-ref-graphs.drv - actual-value: #t result: PASS test-name: gexp->derivation #:allowed-references location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:956 source: + (test-assert + "gexp->derivation #:allowed-references" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet %store-monad + ((drv (gexp->derivation + "allowed-refs" + (gexp (begin + (mkdir (ungexp output)) + (chdir (ungexp output)) + (symlink (ungexp output) "self") + (symlink (ungexp %bootstrap-guile) "guile"))) + #:allowed-references + (list "out" %bootstrap-guile)))) + (built-derivations (list drv))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation #:allowed-references, specific output location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:968 source: + (test-assert + "gexp->derivation #:allowed-references, specific output" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((in (gexp->derivation + "thing" + (gexp (begin + (mkdir (ungexp output "ok")) + (mkdir (ungexp output "not-ok")))))) + (drv (gexp->derivation + "allowed-refs" + (gexp (begin + (pk (ungexp in "not-ok")) + (mkdir (ungexp output)) + (chdir (ungexp output)) + (symlink (ungexp output) "self") + (symlink (ungexp in "ok") "ok"))) + #:allowed-references + (list "out" (gexp-input in "ok"))))) + (built-derivations (list drv))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation #:allowed-references, disallowed location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:985 source: + (test-assert + "gexp->derivation #:allowed-references, disallowed" + (let ((drv (run-with-store + %store + (gexp->derivation + "allowed-refs" + (gexp (begin + (mkdir (ungexp output)) + (chdir (ungexp output)) + (symlink (ungexp %bootstrap-guile) "guile"))) + #:allowed-references + '())))) + (guard (c ((store-protocol-error? c) #t)) + (build-derivations %store (list drv)) + #f))) @ build-started /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/d8ygc3rndcn9a05wzhfvn83kpzzqhfyx-allowed-refs.drv - x86_64-linux /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/var/log/guix/drvs/d8//ygc3rndcn9a05wzhfvn83kpzzqhfyx-allowed-refs.drv.bz2 28477 output (`/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/jdm154cnp32ysi7vphrmwryhc5yyfavl-allowed-refs') is not allowed to refer to path `/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/hw791qm45b11l7jhplxxdilgq6x0lmq0-guile-bootstrap-2.0' @ build-failed /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/d8ygc3rndcn9a05wzhfvn83kpzzqhfyx-allowed-refs.drv - 1 output (`/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/jdm154cnp32ysi7vphrmwryhc5yyfavl-allowed-refs') is not allowed to refer to path `/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/hw791qm45b11l7jhplxxdilgq6x0lmq0-guile-bootstrap-2.0' actual-value: #t result: PASS test-name: gexp->derivation #:disallowed-references, allowed location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:997 source: + (test-assert + "gexp->derivation #:disallowed-references, allowed" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet %store-monad + ((drv (gexp->derivation + "disallowed-refs" + (gexp (begin + (mkdir (ungexp output)) + (chdir (ungexp output)) + (symlink (ungexp output) "self") + (symlink (ungexp %bootstrap-guile) "guile"))) + #:disallowed-references + '()))) + (built-derivations (list drv))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation #:disallowed-references location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1009 source: + (test-assert + "gexp->derivation #:disallowed-references" + (let ((drv (run-with-store + %store + (gexp->derivation + "disallowed-refs" + (gexp (begin + (mkdir (ungexp output)) + (chdir (ungexp output)) + (symlink (ungexp %bootstrap-guile) "guile"))) + #:disallowed-references + (list %bootstrap-guile))))) + (guard (c ((store-protocol-error? c) #t)) + (build-derivations %store (list drv)) + #f))) @ build-started /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/7qqy2wsbbx2dsxvls3ipsmgiky5mhmi8-disallowed-refs.drv - x86_64-linux /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/var/log/guix/drvs/7q//qy2wsbbx2dsxvls3ipsmgiky5mhmi8-disallowed-refs.drv.bz2 28553 output (`/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/vhw0waak9kz9g44w2xrzgxpprwi4f692-disallowed-refs') is not allowed to refer to path `/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/hw791qm45b11l7jhplxxdilgq6x0lmq0-guile-bootstrap-2.0' @ build-failed /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/7qqy2wsbbx2dsxvls3ipsmgiky5mhmi8-disallowed-refs.drv - 1 output (`/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/vhw0waak9kz9g44w2xrzgxpprwi4f692-disallowed-refs') is not allowed to refer to path `/home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/hw791qm45b11l7jhplxxdilgq6x0lmq0-guile-bootstrap-2.0' actual-value: #t result: PASS test-name: gexp->script location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1029 source: + (test-assert + "gexp->script" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((n -> (random (expt 2 50))) + (exp -> + (gexp (system* + (string-append + (ungexp %bootstrap-guile) + "/bin/guile") + "-c" + (object->string + '(display (expt (ungexp n) 2)))))) + (drv (gexp->script + "guile-thing" + exp + #:guile + %bootstrap-guile)) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv)))) + (let* ((pipe (open-input-pipe out)) + (str (get-string-all pipe))) + (return + (and (zero? (close-pipe pipe)) + (= (expt n 2) (string->number str)))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) result: SKIP test-name: gexp->script #:module-path location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1046 source: + (test-assert + "gexp->script #:module-path" + (call-with-temporary-directory + (lambda (directory) + (define str "Fake (guix base32) module!") + (mkdir (string-append directory "/guix")) + (call-with-output-file + (string-append directory "/guix/base32.scm") + (lambda (port) + (write `(begin + (define-module (guix base32)) + (define-public %fake! ,str)) + port))) + (run-with-store + %store + (mlet* %store-monad + ((exp -> + (with-imported-modules + '((guix base32)) + (gexp (begin + (use-modules (guix base32)) + (write (list %load-path %fake!)))))) + (drv (gexp->script + "guile-thing" + exp + #:guile + %bootstrap-guile + #:module-path + (list directory))) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv)))) + (let* ((pipe (open-input-pipe out)) (data (read pipe))) + (return + (and (zero? (close-pipe pipe)) + (match data + ((load-path str*) + (and (string=? str* str) + (not (member + directory + load-path))))))))))))) result: SKIP test-name: program-file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1078 source: + (test-assert + "program-file" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (let* ((n (random (expt 2 50))) + (exp (with-imported-modules + '((guix build utils)) + (gexp (begin + (use-modules (guix build utils)) + (display (ungexp n)))))) + (file (program-file + "program" + exp + #:guile + %bootstrap-guile))) + (mlet* %store-monad + ((drv (lower-object file)) + (out -> (derivation->output-path drv))) + (mbegin + %store-monad + (built-derivations (list drv)) + (let* ((pipe (open-input-pipe out)) + (str (get-string-all pipe))) + (return + (and (zero? (close-pipe pipe)) + (= n (string->number str)))))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: program-file #:module-path location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1095 source: + (test-assert + "program-file #:module-path" + (call-with-temporary-directory + (lambda (directory) + (define text (random-text)) + (call-with-output-file + (string-append directory "/stupid-module.scm") + (lambda (port) + (write `(begin + (define-module (stupid-module)) + (define-public %stupid-thing ,text)) + port))) + (let* ((exp (with-imported-modules + '((stupid-module)) + (gexp (begin + (use-modules (stupid-module)) + (display %stupid-thing))))) + (file (program-file + "program" + exp + #:guile + %bootstrap-guile + #:module-path + (list directory)))) + (run-with-store + %store + (mlet* %store-monad + ((drv (lower-object file)) + (out -> (derivation->output-path drv))) + (mbegin + %store-monad + (built-derivations (list drv)) + (let* ((pipe (open-input-pipe out)) + (str (get-string-all pipe))) + (return + (and (zero? (close-pipe pipe)) + (string=? text str))))))))))) @ build-started /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/ng58dw2gklnkqcihn5yhzapjrgqyqn2l-module-import-compiled.drv - x86_64-linux /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/var/log/guix/drvs/ng//58dw2gklnkqcihn5yhzapjrgqyqn2l-module-import-compiled.drv.bz2 28611 [ 1/ 2] Loading './stupid-module.scm'... [ 2/ 2] Compiling './stupid-module.scm'... @ build-succeeded /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/ng58dw2gklnkqcihn5yhzapjrgqyqn2l-module-import-compiled.drv - @ build-started /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/nzlfddwym57wd2hzw2x0xmd3vmcrn6dx-program.drv - x86_64-linux /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/var/log/guix/drvs/nz//lfddwym57wd2hzw2x0xmd3vmcrn6dx-program.drv.bz2 28670 @ build-succeeded /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/nzlfddwym57wd2hzw2x0xmd3vmcrn6dx-program.drv - actual-value: #t result: PASS test-name: program-file & with-extensions location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1123 source: + (test-assert + "program-file & with-extensions" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (let* ((exp (with-extensions + (list %extension-package) + (gexp (begin + (use-modules (hg2g)) + (display the-answer))))) + (file (program-file + "program" + exp + #:guile + %bootstrap-guile))) + (mlet* %store-monad + ((drv (lower-object file)) + (out -> (derivation->output-path drv))) + (mbegin + %store-monad + (built-derivations (list drv)) + (let* ((pipe (open-input-pipe out)) + (str (get-string-all pipe))) + (return + (and (zero? (close-pipe pipe)) + (= 42 (string->number str)))))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: program-file #:system location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1139 source: + (test-assert + "program-file #:system" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (let* ((exp (with-imported-modules + '((guix build utils)) + (gexp (begin + (use-modules (guix build utils)) + (display "hi!"))))) + (system + (if (string=? (%current-system) "x86_64-linux") + "armhf-linux" + "x86_64-linux")) + (file (program-file "program" exp))) + (mlet %store-monad + ((drv (lower-object file system))) + (return + (and (string=? (derivation-system drv) system) + (find (lambda (input) + (let ((drv (pk (derivation-input-derivation + input)))) + (and (string=? + (derivation-name drv) + "module-import-compiled") + (string=? + (derivation-system drv) + system)))) + (derivation-inputs drv)))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) ;;; (# /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/h21mvfzrilf7a781diha4lqlrv5vvvhw-guile-2.2.6-debug /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/rp215an8gqc2z41p3xpsqd20410q8kny-guile-2.2.6 7f94b9580c30>) ;;; (# /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/hw791qm45b11l7jhplxxdilgq6x0lmq0-guile-bootstrap-2.0 7f94c6507eb0>) ;;; (# /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/j4mh64qv6d7mjmg3bnhdl568z5wprxa4-module-import-compiled 7f94b9132b90>) actual-value: #< drv: # /home/brown/src/repos/git.savannah.gnu/guix/test-tmp/store/j4mh64qv6d7mjmg3bnhdl568z5wprxa4-module-import-compiled 7f94b9132b90> sub-derivations: ("out")> result: PASS test-name: scheme-file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1158 source: + (test-assert + "scheme-file" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (let* ((text (plain-file "foo" "Hello, world!")) + (scheme + (scheme-file + "bar" + (gexp (list "foo" (ungexp text)))))) + (mlet* %store-monad + ((drv (lower-object scheme)) + (text (lower-object text)) + (out -> (derivation->output-path drv))) + (mbegin + %store-monad + (built-derivations (list drv)) + (mlet %store-monad + ((refs (references* out))) + (return + (and (equal? refs (list text)) + (equal? + `(list "foo" ,text) + (call-with-input-file out read)))))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: raw-derivation-file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1171 source: + (test-assert + "raw-derivation-file" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (let* ((exp (gexp (let ((drv (ungexp + (raw-derivation-file coreutils)))) + (when (file-exists? drv) + (symlink drv (ungexp output))))))) + (mlet* %store-monad + ((dep (lower-object coreutils)) + (drv (gexp->derivation "drv-ref" exp)) + (out -> (derivation->output-path drv))) + (mbegin + %store-monad + (built-derivations (list drv)) + (mlet %store-monad + ((refs (references* out))) + (return + (and (member + (derivation-file-name dep) + (derivation-sources drv)) + (not (member + (derivation-file-name dep) + (map derivation-input-path + (derivation-inputs drv)))) + (equal? + (readlink out) + (derivation-file-name dep)) + (equal? + refs + (list (derivation-file-name dep))))))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: text-file* location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1189 source: + (test-assert + "text-file*" + (run-with-store + %store + (mlet* %store-monad + ((drv (package->derivation %bootstrap-guile)) + (guile -> (derivation->output-path drv)) + (file (text-file "bar" "This is bar.")) + (text (text-file* + "foo" + %bootstrap-guile + "/bin/guile " + (gexp-input %bootstrap-guile "out") + "/bin/guile " + drv + "/bin/guile " + file)) + (done (built-derivations (list text))) + (out -> (derivation->output-path text)) + (refs (references* out))) + (return + (and (lset= string=? refs (list guile file)) + (equal? + (call-with-input-file out get-string-all) + (string-append + guile + "/bin/guile " + guile + "/bin/guile " + guile + "/bin/guile " + file))))) + #:guile-for-build + (package-derivation %store %bootstrap-guile))) actual-value: #t result: PASS test-name: mixed-text-file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1212 source: + (test-assert + "mixed-text-file" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((file -> + (mixed-text-file + "mixed" + "export PATH=" + %bootstrap-guile + "/bin")) + (drv (lower-object file)) + (out -> (derivation->output-path drv)) + (guile-drv + (package->derivation %bootstrap-guile)) + (guile -> (derivation->output-path guile-drv))) + (mbegin + %store-monad + (built-derivations (list drv)) + (mlet %store-monad + ((refs (references* out))) + (return + (and (string=? + (string-append "export PATH=" guile "/bin") + (call-with-input-file out get-string-all)) + (equal? refs (list guile))))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: file-union location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1227 source: + (test-assert + "file-union" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet* %store-monad + ((union -> + (file-union + "union" + `(("a" ,(plain-file "a" "1")) + ("b/c/d" ,(plain-file "d" "2")) + ("e" ,(plain-file "e" "3"))))) + (drv (lower-object union)) + (out -> (derivation->output-path drv))) + (define (contents=? file str) + (string=? + (call-with-input-file + (string-append out "/" file) + get-string-all) + str)) + (mbegin + %store-monad + (built-derivations (list drv)) + (return + (and (contents=? "a" "1") + (contents=? "b/c/d" "2") + (contents=? "e" "3"))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: gexp->derivation vs. %current-target-system location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1245 source: + (test-assert + "gexp->derivation vs. %current-target-system" + (let ((mval (gexp->derivation + "foo" + (gexp (begin + (mkdir (ungexp output)) + (foo (ungexp-native gnu-make)))) + #:target + #f))) + (parameterize + ((%current-target-system "fooooo")) + (derivation? (run-with-store %store mval))))) actual-value: #t result: PASS test-name: lower-object location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1256 source: + (test-assert + "lower-object" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (mlet %store-monad + ((drv1 (lower-object %bootstrap-guile)) + (drv2 (lower-object (package-source coreutils))) + (item (lower-object (plain-file "foo" "Hello!")))) + (return + (and (derivation? drv1) + (derivation? drv2) + (store-path? item)))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: lower-object, computed-file location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1263 source: + (test-assert + "lower-object, computed-file" + (let ((store (open-connection-for-tests))) + (dynamic-wind + (const #t) + (lambda () + (run-with-store + store + (let* ((text (plain-file "foo" "Hello!")) + (exp (gexp (begin + (mkdir (ungexp output)) + (symlink + (ungexp %bootstrap-guile) + (string-append (ungexp output) "/guile")) + (symlink + (ungexp text) + (string-append (ungexp output) "/text"))))) + (computed (computed-file "computed" exp))) + (mlet* %store-monad + ((text (lower-object text)) + (guile-drv (lower-object %bootstrap-guile)) + (comp-drv (lower-object computed)) + (comp -> (derivation->output-path comp-drv))) + (mbegin + %store-monad + (built-derivations (list comp-drv)) + (return + (and (string=? + (readlink (string-append comp "/guile")) + (derivation->output-path guile-drv)) + (string=? + (readlink (string-append comp "/text")) + text)))))) + #:guile-for-build + (%guile-for-build))) + (lambda () (close-connection store))))) actual-value: #t result: PASS test-name: lower-object, computed-file, #:system location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1282 source: + (test-equal + "lower-object, computed-file, #:system" + '("mips64el-linux") + (run-with-store + %store + (let* ((exp (gexp (symlink (ungexp coreutils) (ungexp output)))) + (computed + (computed-file + "computed" + exp + #:guile + %bootstrap-guile))) + (mlet* %store-monad + ((drv (lower-object computed "mips64el-linux")) + (refs (references* (derivation-file-name drv)))) + (return + (delete-duplicates + (filter-map + (lambda (file) + (and (string-suffix? ".drv" file) + (let ((drv (read-derivation-from-file file))) + (derivation-system drv)))) + (cons (derivation-file-name drv) refs)))))))) expected-value: ("mips64el-linux") actual-value: ("mips64el-linux") result: PASS test-name: lower-object & gexp-input-error? location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1300 source: + (test-assert + "lower-object & gexp-input-error?" + (guard (c ((gexp-input-error? c) + (gexp-error-invalid-input c))) + (run-with-store + %store + (lower-object (current-module)) + #:guile-for-build + (%guile-for-build)))) actual-value: # result: PASS test-name: printer location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1307 source: + (test-assert + "printer" + (string-match + "^#$" + (with-output-to-string + (lambda () + (write (gexp (string-append (ungexp coreutils) "/bin/uname"))))))) actual-value: #("#:out> \"/bin/uname\") 7f94b916e840>" (0 . 132)) result: PASS test-name: printer vs. ungexp-splicing location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1316 source: + (test-assert + "printer vs. ungexp-splicing" + (string-match + "^#$" + (with-output-to-string + (lambda () + (write (gexp (begin (ungexp-splicing (gexp ()))))))))) actual-value: #("#" (0 . 21)) result: PASS test-name: sugar location: /home/brown/src/repos/git.savannah.gnu/guix/tests/gexp.scm:1324 source: + (test-equal + "sugar" + '(gexp (foo (ungexp bar) + (ungexp baz "out") + (ungexp (chbouib 42)) + (ungexp-splicing (list x y z)) + (ungexp-native foo) + (ungexp-native foo "out") + (ungexp-native (chbouib 42)) + (ungexp-native-splicing (list x y z)))) + '(gexp (foo (ungexp bar) + (ungexp baz "out") + (ungexp (chbouib 42)) + (ungexp-splicing (list x y z)) + (ungexp-native foo) + (ungexp-native foo "out") + (ungexp-native (chbouib 42)) + (ungexp-native-splicing (list x y z))))) expected-value: (gexp (foo (ungexp bar) (ungexp baz "out") (ungexp (chbouib 42)) (ungexp-splicing (list x y z)) (ungexp-native foo) (ungexp-native foo "out") (ungexp-native (chbouib 42)) (ungexp-native-splicing (list x y z)))) actual-value: (gexp (foo (ungexp bar) (ungexp baz "out") (ungexp (chbouib 42)) (ungexp-splicing (list x y z)) (ungexp-native foo) (ungexp-native foo "out") (ungexp-native (chbouib 42)) (ungexp-native-splicing (list x y z)))) result: PASS SKIP: tests/hackage =================== test-name: hackage->guix-package test 1 location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:192 source: + (test-assert + "hackage->guix-package test 1" + (eval-test-with-cabal test-cabal-1 match-ghc-foo)) random seed for tests: 1578402711 Starting download of /tmp/guix-file.tWrGhD From https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz... download failed "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" 404 "Not Found" failed to download "/tmp/guix-file.tWrGhD" from "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" actual-value: #t result: PASS test-name: hackage->guix-package test 2 location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:195 source: + (test-assert + "hackage->guix-package test 2" + (eval-test-with-cabal test-cabal-2 match-ghc-foo)) Starting download of /tmp/guix-file.12bOdW From https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz... download failed "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" 404 "Not Found" failed to download "/tmp/guix-file.12bOdW" from "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" actual-value: #t result: PASS test-name: hackage->guix-package test 3 location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:198 source: + (test-assert + "hackage->guix-package test 3" + (eval-test-with-cabal + test-cabal-3 + match-ghc-foo + #:cabal-environment + '(("impl" . "ghc-7.8")))) Starting download of /tmp/guix-file.NLdV3f From https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz... download failed "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" 404 "Not Found" failed to download "/tmp/guix-file.NLdV3f" from "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" actual-value: #t result: PASS test-name: hackage->guix-package test 4 location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:202 source: + (test-assert + "hackage->guix-package test 4" + (eval-test-with-cabal + test-cabal-4 + match-ghc-foo + #:cabal-environment + '(("impl" . "ghc-7.8")))) Starting download of /tmp/guix-file.Fx69AA From https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz... download failed "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" 404 "Not Found" failed to download "/tmp/guix-file.Fx69AA" from "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" actual-value: #t result: PASS test-name: hackage->guix-package test 5 location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:206 source: + (test-assert + "hackage->guix-package test 5" + (eval-test-with-cabal + test-cabal-5 + match-ghc-foo + #:cabal-environment + '(("impl" . "ghc-7.8")))) Starting download of /tmp/guix-file.l6yOPV From https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz... download failed "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" 404 "Not Found" failed to download "/tmp/guix-file.l6yOPV" from "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" actual-value: #t result: PASS test-name: hackage->guix-package test 6 location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:237 source: + (test-assert + "hackage->guix-package test 6" + (eval-test-with-cabal + test-cabal-6 + match-ghc-foo-6)) Starting download of /tmp/guix-file.dfqAgi From https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz... download failed "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" 404 "Not Found" failed to download "/tmp/guix-file.dfqAgi" from "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" actual-value: #t result: PASS test-name: hackage->guix-package test multiline desc (layout) location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:255 source: + (test-assert + "hackage->guix-package test multiline desc (layout)" + (eval-test-with-cabal + test-cabal-multiline-layout + match-ghc-foo)) Starting download of /tmp/guix-file.TW8jqF From https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz... download failed "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" 404 "Not Found" failed to download "/tmp/guix-file.TW8jqF" from "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" actual-value: #t result: PASS test-name: hackage->guix-package test multiline desc (braced) location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:275 source: + (test-assert + "hackage->guix-package test multiline desc (braced)" + (eval-test-with-cabal + test-cabal-multiline-braced + match-ghc-foo)) Starting download of /tmp/guix-file.jXVOg3 From https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz... download failed "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" 404 "Not Found" failed to download "/tmp/guix-file.jXVOg3" from "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" actual-value: #t result: PASS test-name: hackage->guix-package test mixed layout location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:295 source: + (test-assert + "hackage->guix-package test mixed layout" + (eval-test-with-cabal + test-cabal-mixed-layout + match-ghc-foo)) Syntax error: unexpected token : (ghc-options (-Wall)) (at line 11, column 2) Syntax error: unexpected end of input ;;; (fail #f #f) actual-value: #f result: XFAIL test-name: hackage->guix-package test flag executable location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:322 source: + (test-assert + "hackage->guix-package test flag executable" + (eval-test-with-cabal + test-cabal-flag-executable + match-ghc-foo)) Syntax error: unexpected token : (buildable (False)) (at line 12, column 4) Syntax error: unexpected end of input ;;; (fail #f #f) actual-value: #f result: XFAIL test-name: hackage->guix-package test cabal revision location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:367 source: + (test-assert + "hackage->guix-package test cabal revision" + (eval-test-with-cabal + test-cabal-revision + match-ghc-foo-revision)) Starting download of /tmp/guix-file.9DiU8r From https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz... download failed "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" 404 "Not Found" failed to download "/tmp/guix-file.9DiU8r" from "https://hackage.haskell.org/package/foo/foo-1.0.0.tar.gz" actual-value: #t result: PASS test-name: read-cabal test 1 location: /home/brown/src/repos/git.savannah.gnu/guix/tests/hackage.scm:370 source: + (test-assert + "read-cabal test 1" + (match (call-with-input-string + test-read-cabal-1 + read-cabal) + ((("name" ("test-me")) + ('section + 'library + (('if + ('flag "base4point8") + (("build-depends" ("base >= 4.8 && < 5"))) + (('if + ('flag "base4") + (("build-depends" ("base >= 4 && < 4.8"))) + (('if + ('flag "base3") + (("build-depends" ("base >= 3 && < 4"))) + (("build-depends" ("base < 3")))))))) + ('if + ('or + ('flag "base4point8") + ('and ('flag "base4") ('flag "base3"))) + (("build-depends" ("random"))) + ()) + ("build-depends" ("containers")) + ("exposed-modules" ("Test.QuickCheck.Exception"))))) + #t) + (x (pk 'fail x #f)))) actual-value: #t result: PASS SKIP: tests/pypi ================ test-name: guix-package->pypi-name, old URL style location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:122 source: + (test-equal + "guix-package->pypi-name, old URL style" + "psutil" + (guix-package->pypi-name + (dummy-package + "foo" + (source + (dummy-origin + (uri "https://pypi.org/packages/source/p/psutil/psutil-4.3.0.tar.gz")))))) expected-value: "psutil" actual-value: "psutil" result: PASS test-name: guix-package->pypi-name, new URL style location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:130 source: + (test-equal + "guix-package->pypi-name, new URL style" + "certbot" + (guix-package->pypi-name + (dummy-package + "foo" + (source + (dummy-origin + (uri "https://pypi.org/packages/a2/3b/4756e6a0ceb14e084042a2a65c615d68d25621c6fd446d0fc10d14c4ce7d/certbot-0.8.1.tar.gz")))))) expected-value: "certbot" actual-value: "certbot" result: PASS test-name: guix-package->pypi-name, several URLs location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:138 source: + (test-equal + "guix-package->pypi-name, several URLs" + "cram" + (guix-package->pypi-name + (dummy-package + "foo" + (source + (dummy-origin + (uri (list "https://bitheap.org/cram/cram-0.7.tar.gz" + (pypi-uri "cram" "0.7")))))))) expected-value: "cram" actual-value: "cram" result: PASS test-name: specification->requirement-name location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:147 source: + (test-equal + "specification->requirement-name" + '("Fizzy" + "PickyThing" + "SomethingWithMarker" + "requests" + "pip") + (map specification->requirement-name + test-specifications)) expected-value: ("Fizzy" "PickyThing" "SomethingWithMarker" "requests" "pip") actual-value: ("Fizzy" "PickyThing" "SomethingWithMarker" "requests" "pip") result: PASS test-name: parse-requires.txt location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:151 source: + (test-equal + "parse-requires.txt" + (list '("foo" "bar") '("pytest")) + (mock ((ice-9 ports) + call-with-input-file + call-with-input-string) + (parse-requires.txt test-requires.txt))) expected-value: (("foo" "bar") ("pytest")) actual-value: (("foo" "bar") ("pytest")) result: PASS test-name: parse-requires.txt - Beaker location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:157 source: + (test-equal + "parse-requires.txt - Beaker" + (list '() '("Mock" "coverage")) + (mock ((ice-9 ports) + call-with-input-file + call-with-input-string) + (parse-requires.txt test-requires.txt-beaker))) expected-value: (() ("Mock" "coverage")) actual-value: (() ("Mock" "coverage")) result: PASS test-name: parse-wheel-metadata, with extras location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:163 source: + (test-equal + "parse-wheel-metadata, with extras" + (list '("wrapt" "bar") '("tox" "bumpversion")) + (mock ((ice-9 ports) + call-with-input-file + call-with-input-string) + (parse-wheel-metadata test-metadata-with-extras))) expected-value: (("wrapt" "bar") ("tox" "bumpversion")) actual-value: (("wrapt" "bar") ("tox" "bumpversion")) result: PASS test-name: parse-wheel-metadata, with extras - Jedi location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:169 source: + (test-equal + "parse-wheel-metadata, with extras - Jedi" + (list '("parso") '("pytest")) + (mock ((ice-9 ports) + call-with-input-file + call-with-input-string) + (parse-wheel-metadata + test-metadata-with-extras-jedi))) expected-value: (("parso") ("pytest")) actual-value: (("parso") ("pytest")) result: PASS test-name: pypi->guix-package, no wheel location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:175 source: + (test-assert + "pypi->guix-package, no wheel" + (mock ((guix import utils) + url-fetch + (lambda (url file-name) + (match url + ("https://example.com/foo-1.0.0.tar.gz" + (begin + (mkdir-p "foo-1.0.0/src/bizarre.egg-info") + (with-output-to-file + "foo-1.0.0/src/bizarre.egg-info/requires.txt" + (lambda () (display test-requires.txt))) + (parameterize + ((current-output-port (%make-void-port "rw+"))) + (system* "tar" "czvf" file-name "foo-1.0.0/")) + (delete-file-recursively "foo-1.0.0") + (set! test-source-hash + (call-with-input-file file-name port-sha256)))) + ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" + #f) + (_ (error "Unexpected URL: " url))))) + (mock ((guix http-client) + http-fetch + (lambda (url . rest) + (match url + ("https://pypi.org/pypi/foo/json" + (values + (open-input-string test-json) + (string-length test-json))) + ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" + #f) + (_ (error "Unexpected URL: " url))))) + (match (pypi->guix-package "foo") + (('package + ('name "python-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('pypi-uri "foo" 'version)) + ('sha256 ('base32 (? string? hash))))) + ('build-system 'python-build-system) + ('propagated-inputs + ('quasiquote + (("python-bar" ('unquote 'python-bar)) + ("python-foo" ('unquote 'python-foo))))) + ('native-inputs + ('quasiquote + (("python-pytest" ('unquote 'python-pytest))))) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license 'license:lgpl2.0)) + (string=? + (bytevector->nix-base32-string test-source-hash) + hash)) + (x (pk 'fail x #f)))))) actual-value: #t result: PASS test-name: pypi->guix-package, wheels location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:231 source: + (test-assert + "pypi->guix-package, wheels" + (mock ((guix import utils) + url-fetch + (lambda (url file-name) + (match url + ("https://example.com/foo-1.0.0.tar.gz" + (begin + (mkdir-p "foo-1.0.0/foo.egg-info/") + (with-output-to-file + "foo-1.0.0/foo.egg-info/requires.txt" + (lambda () + (display + "wrong data to make sure we're testing wheels "))) + (parameterize + ((current-output-port (%make-void-port "rw+"))) + (system* "tar" "czvf" file-name "foo-1.0.0/")) + (delete-file-recursively "foo-1.0.0") + (set! test-source-hash + (call-with-input-file file-name port-sha256)))) + ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" + (begin + (mkdir "foo-1.0.0.dist-info") + (with-output-to-file + "foo-1.0.0.dist-info/METADATA" + (lambda () (display test-metadata))) + (let ((zip-file (string-append file-name ".zip"))) + (system* + "zip" + "-q" + zip-file + "foo-1.0.0.dist-info/METADATA") + (rename-file zip-file file-name)) + (delete-file-recursively "foo-1.0.0.dist-info"))) + (_ (error "Unexpected URL: " url))))) + (mock ((guix http-client) + http-fetch + (lambda (url . rest) + (match url + ("https://pypi.org/pypi/foo/json" + (values + (open-input-string test-json) + (string-length test-json))) + ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" + #f) + (_ (error "Unexpected URL: " url))))) + (invalidate-memoization! pypi->guix-package) + (match (pypi->guix-package "foo") + (('package + ('name "python-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('pypi-uri "foo" 'version)) + ('sha256 ('base32 (? string? hash))))) + ('build-system 'python-build-system) + ('propagated-inputs + ('quasiquote + (("python-bar" ('unquote 'python-bar)) + ("python-baz" ('unquote 'python-baz))))) + ('native-inputs + ('quasiquote + (("python-pytest" ('unquote 'python-pytest))))) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license 'license:lgpl2.0)) + (string=? + (bytevector->nix-base32-string test-source-hash) + hash)) + (x (pk 'fail x #f)))))) result: SKIP test-name: pypi->guix-package, no usable requirement file. location: /home/brown/src/repos/git.savannah.gnu/guix/tests/pypi.scm:299 source: + (test-assert + "pypi->guix-package, no usable requirement file." + (mock ((guix import utils) + url-fetch + (lambda (url file-name) + (match url + ("https://example.com/foo-1.0.0.tar.gz" + (mkdir-p "foo-1.0.0/foo.egg-info/") + (parameterize + ((current-output-port (%make-void-port "rw+"))) + (system* "tar" "czvf" file-name "foo-1.0.0/")) + (delete-file-recursively "foo-1.0.0") + (set! test-source-hash + (call-with-input-file file-name port-sha256))) + ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" + #f) + (_ (error "Unexpected URL: " url))))) + (mock ((guix http-client) + http-fetch + (lambda (url . rest) + (match url + ("https://pypi.org/pypi/foo/json" + (values + (open-input-string test-json) + (string-length test-json))) + ("https://example.com/foo-1.0.0-py2.py3-none-any.whl" + #f) + (_ (error "Unexpected URL: " url))))) + (invalidate-memoization! pypi->guix-package) + (match (pypi->guix-package "foo") + (('package + ('name "python-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('pypi-uri "foo" 'version)) + ('sha256 ('base32 (? string? hash))))) + ('build-system 'python-build-system) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license 'license:lgpl2.0)) + (string=? + (bytevector->nix-base32-string test-source-hash) + hash)) + (x (pk 'fail x #f)))))) actual-value: #t result: PASS random seed for tests: 1578409666 warning: Cannot guess requirements from source archive: no requires.txt file found. SKIP: tests/snix ================ test-name: factorize-uri location: /home/brown/src/repos/git.savannah.gnu/guix/tests/snix.scm:36 source: + (test-assert + "factorize-uri" + (every? + (match-lambda + ((uri version '-> expected) + (equal? (factorize-uri uri version) expected))) + '(("http://example.com/foo.tgz" + "1.0" + -> + "http://example.com/foo.tgz") + ("http://example.com/foo-2.8.tgz" + "2.8" + -> + ("http://example.com/foo-" version ".tgz")) + ("http://example.com/2.8/foo-2.8.tgz" + "2.8" + -> + ("http://example.com/" + version + "/foo-" + version + ".tgz"))))) actual-value: #t result: PASS test-name: nixpkgs->guix-package location: /home/brown/src/repos/git.savannah.gnu/guix/tests/snix.scm:54 source: + (test-assert + "nixpkgs->guix-package" + (match (nixpkgs->guix-package + %nixpkgs-directory + "guile") + (('package + ('name "guile") + ('version (? string?)) + ('source ('origin _ ...)) + ('build-system _) + ('inputs ('quasiquote (inputs ...))) + ('propagated-inputs ('quasiquote (pinputs ...))) + ('home-page (? string?)) + ('synopsis (? string?)) + ('description (? string?)) + ('license (? symbol?))) + (and (member '("libffi" ,libffi) inputs) + (member '("gmp" ,gmp) pinputs) + #t)) + (x (pk 'fail x #f)))) result: SKIP SKIP: tests/syscalls ==================== test-name: mount, ENOENT location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:40 source: + (test-equal + "mount, ENOENT" + ENOENT + (catch 'system-error + (lambda () + (mount "/dev/null" "/does-not-exist" "ext2") + #f) + (compose system-error-errno list))) expected-value: 2 actual-value: 2 result: PASS test-name: umount, ENOENT/EPERM location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:48 source: + (test-assert + "umount, ENOENT/EPERM" + (catch 'system-error + (lambda () (umount "/does-not-exist") #f) + (lambda args + (memv (system-error-errno args) + (list EPERM ENOENT))))) actual-value: (1 2) result: PASS test-name: mount-points location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:57 source: + (test-assert + "mount-points" + (any (cute member <> (mount-points)) + '("/" "/proc" "/sys" "/dev"))) actual-value: ("/" "/boot/efi" "/mnt/commons" "/dev/pts" "/dev/shm" "/gnu/store") result: PASS test-name: utime with AT_SYMLINK_NOFOLLOW location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:64 source: + (test-equal + "utime with AT_SYMLINK_NOFOLLOW" + '(0 0) + (begin + (symlink "/nowhere" temp-file) + (utime temp-file 0 0 0 0 AT_SYMLINK_NOFOLLOW) + (let ((st (lstat temp-file))) + (delete-file temp-file) + (list (stat:mtime st) (stat:atime st))))) expected-value: (0 0) actual-value: (0 0) result: PASS test-name: swapon, ENOENT/EPERM location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:76 source: + (test-assert + "swapon, ENOENT/EPERM" + (catch 'system-error + (lambda () (swapon "/does-not-exist") #f) + (lambda args + (memv (system-error-errno args) + (list EPERM ENOENT))))) actual-value: (1 2) result: PASS test-name: swapoff, ENOENT/EINVAL/EPERM location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:84 source: + (test-assert + "swapoff, ENOENT/EINVAL/EPERM" + (catch 'system-error + (lambda () (swapoff "/does-not-exist") #f) + (lambda args + (memv (system-error-errno args) + (list EPERM EINVAL ENOENT))))) actual-value: (1 22 2) result: PASS test-name: mkdtemp! location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:92 source: + (test-assert + "mkdtemp!" + (let* ((tmp (or (getenv "TMPDIR") "/tmp")) + (dir (mkdtemp! + (string-append tmp "/guix-test-XXXXXX")))) + (and (file-exists? dir) (begin (rmdir dir) #t)))) actual-value: #t result: PASS test-name: statfs, ENOENT location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:100 source: + (test-equal + "statfs, ENOENT" + ENOENT + (catch 'system-error + (lambda () (statfs "/does-not-exist")) + (compose system-error-errno list))) expected-value: 2 actual-value: 2 result: PASS test-name: statfs location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:107 source: + (test-assert + "statfs" + (let ((fs (statfs "/"))) + (and (file-system? fs) + (> (file-system-block-size fs) 0) + (>= (file-system-blocks-available fs) 0) + (>= (file-system-blocks-free fs) + (file-system-blocks-available fs))))) actual-value: #t result: PASS test-name: clone location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:124 source: + (test-assert + "clone" + (match (clone (logior CLONE_NEWUSER SIGCHLD)) + (0 (primitive-exit 42)) + (pid (and (not (equal? + (readlink (user-namespace pid)) + (readlink (user-namespace (getpid))))) + (match (waitpid pid) + ((_ . status) (= 42 (status:exit-val status)))))))) actual-value: #t result: PASS test-name: setns location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:137 source: + (test-assert + "setns" + (match (clone (logior CLONE_NEWUSER SIGCHLD)) + (0 (primitive-exit 0)) + (clone-pid + (match (pipe) + ((in . out) + (match (primitive-fork) + (0 + (close in) + (call-with-input-file + (user-namespace clone-pid) + (lambda (port) (setns (port->fdes port) 0))) + (write 'done out) + (close out) + (primitive-exit 0)) + (fork-pid + (close out) + (read in) + (let ((result + (and (equal? + (readlink + (user-namespace clone-pid)) + (readlink + (user-namespace fork-pid)))))) + (waitpid clone-pid) + (waitpid fork-pid) + result)))))))) actual-value: #t result: PASS test-name: pivot-root location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:175 source: + (test-equal + "pivot-root" + #t + (match (pipe) + ((in . out) + (match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD)) + (0 + (dynamic-wind + (const #t) + (lambda () + (close in) + (call-with-temporary-directory + (lambda (root) + (let ((put-old (string-append root "/real-root"))) + (mount "none" root "tmpfs") + (mkdir put-old) + (call-with-output-file + (string-append root "/test") + (lambda (port) (display "testing\n" port))) + (pivot-root root put-old) + (write (file-exists? "/test") out) + (close out))))) + (lambda () (primitive-exit 0)))) + (pid (close out) + (let ((result (read in))) + (close in) + (and (zero? (match (waitpid pid) + ((_ . status) + (status:exit-val status)))) + (eq? #t result)))))))) result: SKIP test-name: scandir*, ENOENT location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:208 source: + (test-equal + "scandir*, ENOENT" + ENOENT + (catch 'system-error + (lambda () (scandir* "/does/not/exist")) + (lambda args (system-error-errno args)))) expected-value: 2 actual-value: 2 result: PASS test-name: scandir*, ASCII file names location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:216 source: + (test-equal + "scandir*, ASCII file names" + (scandir + (dirname + (search-path %load-path "guix/base32.scm")) + (const #t) + stringprocedure + int + (dynamic-func "creat" (dynamic-link)) + (list '* int)))) + (creat (string->pointer + (string-append directory "/α") + "UTF-8") + 420) + (creat (string->pointer + (string-append directory "/λ") + "UTF-8") + 420) + (let ((locale (setlocale LC_ALL))) + (dynamic-wind + (lambda () (setlocale LC_ALL "C")) + (lambda () + (match (scandir* directory) + (((names . properties) ...) names))) + (lambda () (setlocale LC_ALL locale)))))))) expected-value: ("." ".." "α" "λ") actual-value: ("." ".." "α" "λ") result: PASS test-name: scandir*, properties location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:250 source: + (test-assert + "scandir*, properties" + (let ((directory + (dirname + (search-path %load-path "guix/base32.scm")))) + (every (lambda (entry name) + (match entry + ((name2 . properties) + (and (string=? name2 name) + (let* ((full (string-append directory "/" name)) + (stat (lstat full)) + (inode (assoc-ref properties 'inode)) + (type (assoc-ref properties 'type))) + (and (= inode (stat:ino stat)) + (or (eq? type 'unknown) + (eq? type (stat:type stat))))))))) + (scandir* directory) + (scandir directory (const #t) string (termios-input-speed termios) 0) + (> (termios-output-speed termios) 0)))) result: SKIP test-name: tcsetattr location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:518 source: + (test-assert + "tcsetattr" + (let ((first (tcgetattr 0))) + (tcsetattr 0 (tcsetattr-action TCSANOW) first) + (equal? first (tcgetattr 0)))) result: SKIP test-name: terminal-window-size ENOTTY location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:523 source: + (test-assert + "terminal-window-size ENOTTY" + (call-with-input-file + "/dev/null" + (lambda (port) + (catch 'system-error + (lambda () (terminal-window-size port)) + (lambda args + (memv (system-error-errno args) + (list ENOTTY EINVAL))))))) actual-value: (25 22) result: PASS test-name: terminal-columns location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:534 source: + (test-assert + "terminal-columns" + (> (terminal-columns) 0)) actual-value: #t result: PASS test-name: terminal-columns non-file port location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:537 source: + (test-assert + "terminal-columns non-file port" + (> (terminal-columns + (open-input-string + "Join us now, share the software!")) + 0)) actual-value: #t result: PASS test-name: terminal-rows location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:541 source: + (test-assert + "terminal-rows" + (> (terminal-rows) 0)) actual-value: #t result: PASS test-name: utmpx-entries location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:544 source: + (test-assert + "utmpx-entries" + (match (utmpx-entries) + (((? utmpx? entries) ...) + (every (lambda (entry) + (match (utmpx-user entry) + ((? string?) + (or (not (memv (utmpx-login-type entry) + (list (login-type INIT_PROCESS) + (login-type LOGIN_PROCESS) + (login-type USER_PROCESS)))) + (> (utmpx-pid entry) 0))) + (#f #t))) + entries)))) actual-value: #t result: PASS test-name: read-utmpx, EOF location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:561 source: + (test-assert + "read-utmpx, EOF" + (eof-object? (read-utmpx (%make-void-port "r")))) actual-value: #t result: PASS test-name: read-utmpx location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:566 source: + (test-assert + "read-utmpx" + (let ((result + (call-with-input-file + "/var/run/utmpx" + read-utmpx))) + (or (utmpx? result) (eof-object? result)))) actual-value: #t result: PASS test-name: add-to-entropy-count location: /home/brown/src/repos/git.savannah.gnu/guix/tests/syscalls.scm:572 source: + (test-equal + "add-to-entropy-count" + EPERM + (call-with-output-file + "/dev/urandom" + (lambda (port) + (catch 'system-error + (lambda () (add-to-entropy-count port 77) #f) + (lambda args (system-error-errno args)))))) expected-value: 1 actual-value: 1 result: PASS SKIP: tests/upstream ==================== test-name: coalesce-sources same version location: /home/brown/src/repos/git.savannah.gnu/guix/tests/upstream.scm:30 source: + (test-equal + "coalesce-sources same version" + (list (upstream-source + (package "foo") + (version "1") + (urls '("ftp://example.org/foo-1.tar.xz" + "ftp://example.org/foo-1.tar.gz")) + (signature-urls + '("ftp://example.org/foo-1.tar.xz.sig" + "ftp://example.org/foo-1.tar.gz.sig")))) + (coalesce-sources + (list (upstream-source + (package "foo") + (version "1") + (urls '("ftp://example.org/foo-1.tar.gz")) + (signature-urls + '("ftp://example.org/foo-1.tar.gz.sig"))) + (upstream-source + (package "foo") + (version "1") + (urls '("ftp://example.org/foo-1.tar.xz")) + (signature-urls + '("ftp://example.org/foo-1.tar.xz.sig")))))) result: SKIP random seed for tests: 1578408316 FAIL: tests/guix-system ======================= + set -e + guix system --version guix system (GNU Guix) 1.0.1.9150-a230-dirty Copyright (C) 2020 the Guix authors License GPLv3+: GNU GPL version 3 or later This is free software: you are free to change and redistribute it. There is NO WARRANTY, to the extent permitted by law. + tmpfile=t-guix-system-585 + errorfile=t-guix-system-error-585 + tmpdir=/tmp/t-guix-system-585 + mkdir /tmp/t-guix-system-585 + trap 'rm -f "$tmpfile" "$errorfile" "$tmpdir"/*; rmdir "$tmpdir"' EXIT + cat + guix system vm t-guix-system-585 + grep 't-guix-system-585:2:3:.*missing.* initializers' t-guix-system-error-585 t-guix-system-585:2:3: error: missing field initializers (bootloader host-name file-systems timezone) + cat + guix system vm t-guix-system-585 + grep 't-guix-system-585:4:1: missing closing paren' t-guix-system-error-585 t-guix-system-585:4:1: missing closing parenthesis + cat + guix system build t-guix-system-585 -n + grep 't-guix-system-585:3:2: .*module .*openssh.*not found' t-guix-system-error-585 t-guix-system-585:3:2: error: module (gnu services openssh) not found + grep 'Try.*use-service-modules ssh' t-guix-system-error-585 hint: Try adding `(use-service-modules ssh)'. + cat + guix system build t-guix-system-585 -n + grep 't-guix-system-585:3:2: .*module .*qemu.*not found' t-guix-system-error-585 t-guix-system-585:3:2: error: module (gnu packages qemu) not found + grep 'Try.*use-package-modules virtualization' t-guix-system-error-585 hint: Try adding `(use-package-modules virtualization)'. + cat + guix system build t-guix-system-585 -n ++ guile -c '(display (effective-version))' + test 2.2 = 2.2 + grep 't-guix-system-585:[49]:[0-9]\+:.*GRUB-config.*[Uu]nbound variable' t-guix-system-error-585 t-guix-system-585:4:0: error: GRUB-config: unbound variable + OS_BASE=' (host-name "antelope") (timezone "Europe/Paris") (locale "en_US.UTF-8") (bootloader (bootloader-configuration (bootloader grub-bootloader) (target "/dev/sdX"))) (file-systems (cons (file-system (device (file-system-label "root")) (mount-point "/") (type "ext4")) %base-file-systems)) ' + cat + guix system vm t-guix-system-585 accepted connection from pid 2511, user brown + grep 'service '\''networking'\''.*more than once' t-guix-system-error-585 + rm -f t-guix-system-585 t-guix-system-error-585 '/tmp/t-guix-system-585/*' + rmdir /tmp/t-guix-system-585 FAIL tests/guix-system.sh (exit status: 1)