ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

store: Add `store-path-hash-part'.

Browse source 
* guix/store.scm (store-path-hash-part): New procedure.
* tests/store.scm ("store-path-hash-part", "store-path-hash-part #f"):
  New tests.
This commit is contained in:
Ludovic Courtès 2013-04-01 16:08:31 +02:00
parent ef8c03407d
commit 2c6ab6ccd4
2 changed files with 23 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
guix/store.scm
View file

@ -83,7 +83,8 @@ (define-module (guix store)
%store-prefix
store-path?
derivation-path?
store-path-package-name))
store-path-package-name
store-path-hash-part))
(define %protocol-version #x10c)
@ -751,3 +752,12 @@ (define store-path-rx
(and=> (regexp-exec store-path-rx path)
(cut match:substring <> 1)))
(define (store-path-hash-part path)
"Return the hash part of PATH as a base32 string, or #f if PATH is not a
syntactically valid store path."
(let ((path-rx (make-regexp
(string-append"^" (regexp-quote (%store-prefix))
"/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
(and=> (regexp-exec path-rx path)
(cut match:substring <> 1))))

12
tests/store.scm
View file

@ -48,6 +48,18 @@ (define (random-text)
(test-begin "store")
(test-equal "store-path-hash-part"
"283gqy39v3g9dxjy26rynl0zls82fmcg"
(store-path-hash-part
(string-append (%store-prefix)
"/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
(test-equal "store-path-hash-part #f"
#f
(store-path-hash-part
(string-append (%store-prefix)
"/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
(test-skip (if %store 0 10))
(test-assert "dead-paths"