gexp: Add tests for 'gexp-outputs'.
* tests/gexp.scm (gexp-outputs): New procedure. ("output list", "output list, combined gexps"): New tests.master
parent
c9727aac40
commit
4b23c4664e
|
@ -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))
|
||||||
|
|
Reference in New Issue