mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
build-expression->derivation: Have the build fail when EXP returns #f.
* guix/derivations.scm (build-expression->derivation)[builder]: Pass the result of EXP to `exit'. * tests/derivations.scm ("build-expression->derivation with expression returning #f"): New test.
This commit is contained in:
parent
9f55cf8d56
commit
db393b333f
2 changed files with 21 additions and 2 deletions
|
@ -446,7 +446,9 @@ (define* (build-expression->derivation store name system exp inputs
|
||||||
when SUB-DRV is omitted, \"out\" is assumed. EXP is evaluated in an
|
when SUB-DRV is omitted, \"out\" is assumed. EXP is evaluated in an
|
||||||
environment where %OUTPUT is bound to the main output path, %OUTPUTS is bound
|
environment where %OUTPUT is bound to the main output path, %OUTPUTS is bound
|
||||||
to a list of output/path pairs, and where %BUILD-INPUTS is bound to an alist
|
to a list of output/path pairs, and where %BUILD-INPUTS is bound to an alist
|
||||||
of string/output-path pairs made from INPUTS."
|
of string/output-path pairs made from INPUTS. The builder terminates by
|
||||||
|
passing the result of EXP to `exit'; thus, when EXP returns #f, the build is
|
||||||
|
considered to have failed."
|
||||||
(define guile
|
(define guile
|
||||||
(string-append (derivation-path->output-path (%guile-for-build))
|
(string-append (derivation-path->output-path (%guile-for-build))
|
||||||
"/bin/guile"))
|
"/bin/guile"))
|
||||||
|
@ -472,7 +474,8 @@ (define %build-inputs
|
||||||
(builder (add-text-to-store store
|
(builder (add-text-to-store store
|
||||||
(string-append name "-guile-builder")
|
(string-append name "-guile-builder")
|
||||||
(string-append (object->string prologue)
|
(string-append (object->string prologue)
|
||||||
(object->string exp))
|
(object->string
|
||||||
|
`(exit ,exp)))
|
||||||
(map second inputs)))
|
(map second inputs)))
|
||||||
(mod-drv (if (null? modules)
|
(mod-drv (if (null? modules)
|
||||||
#f
|
#f
|
||||||
|
|
|
@ -29,6 +29,7 @@ (define-module (test-derivations)
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
|
#:use-module (ice-9 regex)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:use-module (ice-9 match))
|
#:use-module (ice-9 match))
|
||||||
|
|
||||||
|
@ -181,6 +182,20 @@ (define %coreutils
|
||||||
(equal? '(hello guix)
|
(equal? '(hello guix)
|
||||||
(call-with-input-file (string-append p "/test") read))))))
|
(call-with-input-file (string-append p "/test") read))))))
|
||||||
|
|
||||||
|
(test-assert "build-expression->derivation with expression returning #f"
|
||||||
|
(let* ((builder '(begin
|
||||||
|
(mkdir %output)
|
||||||
|
#f)) ; fail!
|
||||||
|
(drv-path (build-expression->derivation %store "fail" (%current-system)
|
||||||
|
builder '())))
|
||||||
|
(guard (c ((nix-protocol-error? c)
|
||||||
|
;; Note that the output path may exist at this point, but it
|
||||||
|
;; is invalid.
|
||||||
|
(not (not (string-match "build .* failed"
|
||||||
|
(nix-protocol-error-message c))))))
|
||||||
|
(build-derivations %store (list drv-path))
|
||||||
|
#f)))
|
||||||
|
|
||||||
(test-assert "build-expression->derivation with two outputs"
|
(test-assert "build-expression->derivation with two outputs"
|
||||||
(let* ((builder '(begin
|
(let* ((builder '(begin
|
||||||
(call-with-output-file (assoc-ref %outputs "out")
|
(call-with-output-file (assoc-ref %outputs "out")
|
||||||
|
@ -265,4 +280,5 @@ (define %coreutils
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
;;; eval: (put 'test-assert 'scheme-indent-function 1)
|
;;; eval: (put 'test-assert 'scheme-indent-function 1)
|
||||||
|
;;; eval: (put 'guard 'scheme-indent-function 1)
|
||||||
;;; End:
|
;;; End:
|
||||||
|
|
Loading…
Reference in a new issue