gexp: Add tests for 'gexp-outputs'.

* tests/gexp.scm (gexp-outputs): New procedure.
  ("output list", "output list, combined gexps"): New tests.
This commit is contained in:
Ludovic Courtès 2015-02-27 22:01:54 +01:00
parent c9727aac40
commit 4b23c4664e
1 changed files with 16 additions and 0 deletions

View File

@ -42,6 +42,7 @@
;; For white-box testing. ;; For white-box testing.
(define gexp-inputs (@@ (guix gexp) gexp-inputs)) (define gexp-inputs (@@ (guix gexp) gexp-inputs))
(define gexp-native-inputs (@@ (guix gexp) gexp-native-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 (@@ (guix gexp) gexp->sexp))
(define* (gexp->sexp* exp #:optional target) (define* (gexp->sexp* exp #:optional target)
@ -214,6 +215,21 @@
(equal? (gexp->sexp* exp) ;native (equal? (gexp->sexp* exp) ;native
(gexp->sexp* exp "mips64el-linux"))))) (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" (test-assertm "gexp->file"
(mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile))))
(guile (package-file %bootstrap-guile)) (guile (package-file %bootstrap-guile))