mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-11 21:59:08 -05:00
store: Make 'direct-store-path?' public.
* guix/store.scm (direct-store-path?): New procedure. * guix/derivations.scm (derivation)[direct-store-path?]: Remove. * tests/store.scm ("direct-store-path?"): New test.
This commit is contained in:
parent
e387ab7c10
commit
9336e5b5e7
3 changed files with 18 additions and 9 deletions
|
@ -541,15 +541,6 @@ (define* (derivation store name builder args
|
|||
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
|
||||
pairs. In that case, the reference graph of each store path is exported in
|
||||
the build environment in the corresponding file, in a simple text format."
|
||||
(define direct-store-path?
|
||||
(let ((len (+ 1 (string-length (%store-prefix)))))
|
||||
(lambda (p)
|
||||
;; Return #t if P is a store path, and not a sub-directory of a
|
||||
;; store path. This predicate is needed because files *under* a
|
||||
;; store path are not valid inputs.
|
||||
(and (store-path? p)
|
||||
(not (string-index (substring p len) #\/))))))
|
||||
|
||||
(define (add-output-paths drv)
|
||||
;; Return DRV with an actual store path for each of its output and the
|
||||
;; corresponding environment variable.
|
||||
|
|
|
@ -85,6 +85,7 @@ (define-module (guix store)
|
|||
|
||||
%store-prefix
|
||||
store-path?
|
||||
direct-store-path?
|
||||
derivation-path?
|
||||
store-path-package-name
|
||||
store-path-hash-part
|
||||
|
@ -640,6 +641,14 @@ (define (store-path? path)
|
|||
;; `isStorePath' in Nix does something similar.
|
||||
(string-prefix? (%store-prefix) path))
|
||||
|
||||
(define (direct-store-path? path)
|
||||
"Return #t if PATH is a store path, and not a sub-directory of a store path.
|
||||
This predicate is sometimes needed because files *under* a store path are not
|
||||
valid inputs."
|
||||
(and (store-path? path)
|
||||
(let ((len (+ 1 (string-length (%store-prefix)))))
|
||||
(not (string-index (substring path len) #\/)))))
|
||||
|
||||
(define (derivation-path? path)
|
||||
"Return #t if PATH is a derivation path."
|
||||
(and (store-path? path) (string-suffix? ".drv" path)))
|
||||
|
|
|
@ -65,6 +65,15 @@ (define (random-text)
|
|||
(string-append (%store-prefix)
|
||||
"/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
|
||||
|
||||
(test-assert "direct-store-path?"
|
||||
(and (direct-store-path?
|
||||
(string-append (%store-prefix)
|
||||
"/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))
|
||||
(not (direct-store-path?
|
||||
(string-append
|
||||
(%store-prefix)
|
||||
"/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile")))))
|
||||
|
||||
(test-skip (if %store 0 10))
|
||||
|
||||
(test-assert "dead-paths"
|
||||
|
|
Loading…
Reference in a new issue