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

derivations: Add 'derivation-name'.

Browse source 
* guix/derivations.scm (derivation-name): New procedure.
* tests/derivations.scm ("derivation-name"): New test.
This commit is contained in:
Ludovic Courtès 2014-10-17 20:58:02 +02:00
parent 5c2033f864
commit e786293e76
2 changed files with 11 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
guix/derivations.scm
View file

@ -56,6 +56,7 @@ (define-module (guix derivations)
derivation-input-sub-derivations
derivation-input-output-paths
derivation-name
fixed-output-derivation?
offloadable-derivation?
substitutable-derivation?
@ -128,6 +129,11 @@ (define-record-type <derivation-input>
(derivation-outputs drv)))
(number->string (object-address drv) 16))))
(define (derivation-name drv)
"Return the base name of DRV."
(let ((base (store-path-package-name (derivation-file-name drv))))
(string-drop-right base 4)))
(define (fixed-output-derivation? drv)
"Return #t if DRV is a fixed-output derivation, such as the result of a
download with a fixed hash (aka. `fetchurl')."

5
tests/derivations.scm
View file

@ -173,6 +173,11 @@ (define prefix-len (string-length dir))
(= (stat:ino (lstat file1))
(stat:ino (lstat file2))))))))
(test-equal "derivation-name"
"foo-0.0"
(let ((drv (derivation %store "foo-0.0" %bash '())))
(derivation-name drv)))
(test-assert "offloadable-derivation?"
(and (offloadable-derivation? (derivation %store "foo" %bash '()))
(not (offloadable-derivation?