derivations: Add 'derivation-name'.
* guix/derivations.scm (derivation-name): New procedure. * tests/derivations.scm ("derivation-name"): New test.
This commit is contained in:
parent
5c2033f864
commit
e786293e76
@ -56,6 +56,7 @@
|
||||
derivation-input-sub-derivations
|
||||
derivation-input-output-paths
|
||||
|
||||
derivation-name
|
||||
fixed-output-derivation?
|
||||
offloadable-derivation?
|
||||
substitutable-derivation?
|
||||
@ -128,6 +129,11 @@
|
||||
(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')."
|
||||
|
@ -173,6 +173,11 @@
|
||||
(= (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?
|
||||
|
Loading…
Reference in New Issue
Block a user