;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(package-derivation %store coreutils)))
(gexp->sexp* exp)))))
+(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 . ,(derivation->output-path
+ (package-derivation %store coreutils)))
+ (gexp->sexp* exp)))))
+
(test-assert "one input origin"
(let ((exp (gexp (display (ungexp (package-source coreutils))))))
(and (gexp? exp)
(ungexp %bootstrap-guile)))))
(list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
+(test-equal "ungexp + ungexp-native, nested, special mixture"
+ `(() <> ((,coreutils "out")))
+
+ ;; (gexp-native-inputs exp) used to return '(), wrongfully.
+ (let* ((foo (gexp (foo (ungexp-native coreutils))))
+ (exp (gexp (bar (ungexp foo)))))
+ (list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
+
(test-assert "input list"
(let ((exp (gexp (display
'(ungexp (list %bootstrap-guile coreutils)))))
`(list ,@(cons 5 outputs))))))
(test-assert "input list splicing + ungexp-native-splicing"
- (let* ((inputs (list (gexp-input glibc "debug") %bootstrap-guile))
+ (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"))
(equal? (gexp->sexp* exp) ;native
(gexp->sexp* exp "mips64el-linux")))))
+(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) ;native
+ (gexp->sexp* exp "mips64el-linux")))))
+
(test-equal "output list"
2
(let ((exp (gexp (begin (mkdir (ungexp output))
get-bytevector-all))))
files))))))
+(test-assertm "imported-files with file-like objects"
+ (mlet* %store-monad ((plain -> (plain-file "foo" "bar!"))
+ (q-scm -> (search-path %load-path "ice-9/q.scm"))
+ (files -> `(("a/b/c" . ,q-scm)
+ ("p/q" . ,plain)))
+ (drv (imported-files files)))
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (mlet %store-monad ((dir -> (derivation->output-path drv))
+ (plain* (text-file "foo" "bar!"))
+ (q-scm* (interned-file q-scm "c")))
+ (return
+ (and (string=? (readlink (string-append dir "/a/b/c"))
+ q-scm*)
+ (string=? (readlink (string-append dir "/p/q"))
+ plain*)))))))
+
(test-equal "gexp-modules & ungexp"
'((bar) (foo))
((@@ (guix gexp) gexp-modules)
#~(foo #$@(list (with-imported-modules '((foo)) #~+)
(with-imported-modules '((bar)) #~-)))))
+(test-equal "gexp-modules and literal Scheme object"
+ '()
+ (gexp-modules #t))
+
(test-assertm "gexp->derivation #:modules"
(mlet* %store-monad
((build -> #~(begin
(equal? '(chdir "/foo")
(call-with-input-file b read))))))))
+(test-assertm "gexp->derivation & with-imported-module & computed module"
+ (mlet* %store-monad
+ ((module -> (scheme-file "x" #~(begin
+ (define-module (foo bar)
+ #:export (the-answer))
+
+ (define the-answer 42))))
+ (build -> (with-imported-modules `(((foo bar) => ,module)
+ (guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (foo bar))
+ mkdir-p
+ (call-with-output-file #$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))))))
+
(test-assertm "gexp->derivation #:references-graphs"
(mlet* %store-monad
((one (text-file "one" (random-text)))
(string=? (readlink (string-append comp "/text"))
text)))))))
+(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))))
+
(test-assert "printer"
(string-match "^#<gexp \\(string-append .*#<package coreutils.*\
\"/bin/uname\"\\) [[:xdigit:]]+>$"