~ruther/guix-local

4b23c4664ec67b8c6329c4aa82a331d2e48341cb — Ludovic Courtès 11 years ago c9727aa
gexp: Add tests for 'gexp-outputs'.

* tests/gexp.scm (gexp-outputs): New procedure.
  ("output list", "output list, combined gexps"): New tests.
1 files changed, 16 insertions(+), 0 deletions(-)

M tests/gexp.scm
M tests/gexp.scm => tests/gexp.scm +16 -0
@@ 42,6 42,7 @@
;; For white-box testing.
(define gexp-inputs (@@ (guix gexp) gexp-inputs))
(define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs))
(define gexp-outputs (@@ (guix gexp) gexp-outputs))
(define gexp->sexp  (@@ (guix gexp) gexp->sexp))

(define* (gexp->sexp* exp #:optional target)


@@ 214,6 215,21 @@
         (equal? (gexp->sexp* exp)                ;native
                 (gexp->sexp* exp "mips64el-linux")))))

(test-equal "output list"
  2
  (let ((exp (gexp (begin (mkdir (ungexp output))
                          (mkdir (ungexp output "bar"))))))
    (length (gexp-outputs exp))))                ;XXX: <output-ref> is private

(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))))))

(test-assertm "gexp->file"
  (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile))))
                       (guile  (package-file %bootstrap-guile))