diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-03-28 09:50:28 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-03-28 10:00:05 +0200 |
| commit | bdb59b331bac0dea4a75b055334313ddc7bfecc8 (patch) | |
| tree | 6315b51845afcab931955a4a229b81602b277665 /tests | |
| parent | 7aeb4ffa5828206f89ec62226863c27f7c1c028d (diff) | |
| download | patches-bdb59b331bac0dea4a75b055334313ddc7bfecc8.tar patches-bdb59b331bac0dea4a75b055334313ddc7bfecc8.tar.gz | |
derivations: Do not fetch narinfos for non-substitutable items.
This avoids connections to substitute servers for derivations that are
not substitutable anyway, such as profiles.
Reported by Andy Wingo.
* guix/derivations.scm (substitution-oracle): Skip derivations that do
not pass 'substitutable-derivation?'.
* tests/derivations.scm ("substitution-oracle and #:substitute? #f"):
New test.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index 3fbfec3793..75c8d1dfb1 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -888,6 +888,35 @@ (string=? (derivation-input-path input) (derivation-file-name dep)))))))) +(test-assert "substitution-oracle and #:substitute? #f" + (with-store store + (let* ((dep (build-expression->derivation store "dep" + `(begin ,(random-text) + (mkdir %output)))) + (drv (build-expression->derivation store "not-subst" + `(begin ,(random-text) + (mkdir %output)) + #:substitutable? #f + #:inputs `(("dep" ,dep)))) + (query #f)) + (define (record-substitutable-path-query store paths) + (when query + (error "already called!" query)) + (set! query paths) + '()) + + (mock ((guix store) substitutable-paths + record-substitutable-path-query) + + (let ((pred (substitution-oracle store (list drv)))) + (pred (derivation->output-path drv)))) + + ;; Make sure the oracle didn't try to get substitute info for DRV since + ;; DRV is mark as non-substitutable. Assume that GUILE-FOR-BUILD is + ;; already in store and thus not part of QUERY. + (equal? (pk 'query query) + (list (derivation->output-path dep)))))) + (test-assert "build-expression->derivation with expression returning #f" (let* ((builder '(begin (mkdir %output) |