diff options
| -rw-r--r-- | guix/scripts/environment.scm | 6 | ||||
| -rw-r--r-- | guix/scripts/gc.scm | 3 | ||||
| -rw-r--r-- | guix/scripts/size.scm | 2 | ||||
| -rw-r--r-- | guix/store.scm | 14 | ||||
| -rw-r--r-- | tests/store.scm | 10 |
5 files changed, 19 insertions, 16 deletions
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 9ba487d1eb..ebe966f9cf 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -333,11 +333,11 @@ requisite store items i.e. the union closure of all the inputs." (requisites* (match input ((drv output) - (derivation->output-path drv output)) + (list (derivation->output-path drv output))) ((drv) - (derivation->output-path drv)) + (list (derivation->output-path drv))) ((? direct-store-path? path) - path)))) + (list path))))) (mlet %store-monad ((reqs (sequence %store-monad (map input->requisites inputs)))) diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 4ec9ff9dca..8db28138c8 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -229,7 +229,8 @@ Invoke the garbage collector.\n")) ((list-references) (list-relatives references)) ((list-requisites) - (list-relatives requisites)) + (list-relatives (lambda (store item) + (requisites store (list item))))) ((list-referrers) (list-relatives referrers)) ((optimize) diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm index 843213834e..c9725aee4c 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -122,7 +122,7 @@ substitutes." (guard (c ((nix-protocol-error? c) (values (substitutable-requisites store item) store))) - (values (requisites store item) store)))) + (values (requisites store (list item)) store)))) (define (mappend-map mproc lst) "Apply MPROC to each item of LST and concatenate the resulting list." diff --git a/guix/store.scm b/guix/store.scm index 4d89f4a413..e3033ee61a 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -803,12 +803,12 @@ the list of references") (loop items tail (cons head result))))))))) -(define* (fold-path store proc seed path +(define* (fold-path store proc seed paths #:optional (relatives (cut references store <>))) - "Call PROC for each of the RELATIVES of PATH, exactly once, and return the + "Call PROC for each of the RELATIVES of PATHS, exactly once, and return the result formed from the successive calls to PROC, the first of which is passed SEED." - (let loop ((paths (list path)) + (let loop ((paths paths) (result seed) (seen vlist-null)) (match paths @@ -822,10 +822,10 @@ SEED." (() result)))) -(define (requisites store path) - "Return the requisites of PATH, including PATH---i.e., its closure (all its -references, recursively)." - (fold-path store cons '() path)) +(define (requisites store paths) + "Return the requisites of PATHS, including PATHS---i.e., their closures (all +its references, recursively)." + (fold-path store cons '() paths)) (define (topologically-sorted store paths) "Return a list containing PATHS and all their references sorted in diff --git a/tests/store.scm b/tests/store.scm index eeadcb94f8..3c2c247561 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -244,10 +244,12 @@ (and (= (length x) (length y)) (lset= equal? x y))) - (and (same? (requisites %store t1) (list t1)) - (same? (requisites %store t2) (list t1 t2)) - (same? (requisites %store t3) (list t1 t2 t3)) - (same? (requisites %store t4) (list t1 t2 t3 t4))))) + (and (same? (requisites %store (list t1)) (list t1)) + (same? (requisites %store (list t2)) (list t1 t2)) + (same? (requisites %store (list t3)) (list t1 t2 t3)) + (same? (requisites %store (list t4)) (list t1 t2 t3 t4)) + (same? (requisites %store (list t1 t2 t3 t4)) + (list t1 t2 t3 t4))))) (test-assert "derivers" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) |