derivations: Add 'offloadable-derivation?' and 'substitutable-derivation?'.

* guix/derivations.scm (offloadable-derivation?,
  substitutable-derivation?): New procedures.
* tests/derivations.scm ("offloadable-derivation?"): New test.
This commit is contained in:
Ludovic Courtès 2014-10-28 18:05:17 +01:00
parent 31a123fe00
commit fc93e30919
2 changed files with 20 additions and 0 deletions

View File

@ -57,6 +57,8 @@
derivation-input-output-paths derivation-input-output-paths
fixed-output-derivation? fixed-output-derivation?
offloadable-derivation?
substitutable-derivation?
derivation-hash derivation-hash
read-derivation read-derivation
@ -156,6 +158,18 @@ download with a fixed hash (aka. `fetchurl')."
read-derivation)) read-derivation))
inputs))))) inputs)))))
(define (offloadable-derivation? drv)
"Return true if DRV can be offloaded, false otherwise."
(match (assoc "preferLocalBuild"
(derivation-builder-environment-vars drv))
(("preferLocalBuild" . "1") #f)
(_ #t)))
(define substitutable-derivation?
;; Return #t if the derivation can be substituted. Currently the two are
;; synonymous, see <http://bugs.gnu.org/18747>.
offloadable-derivation?)
(define* (derivation-prerequisites-to-build store drv (define* (derivation-prerequisites-to-build store drv
#:key #:key
(outputs (outputs

View File

@ -173,6 +173,12 @@
(= (stat:ino (lstat file1)) (= (stat:ino (lstat file1))
(stat:ino (lstat file2)))))))) (stat:ino (lstat file2))))))))
(test-assert "offloadable-derivation?"
(and (offloadable-derivation? (derivation %store "foo" %bash '()))
(not (offloadable-derivation?
(derivation %store "foo" %bash '()
#:local-build? #t)))))
(test-assert "fixed-output-derivation?" (test-assert "fixed-output-derivation?"
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo -n hello > $out" '())) "echo -n hello > $out" '()))