1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 13:10:33 +02:00

grafts: Record metadata as derivation properties.

* guix/grafts.scm (graft-derivation/shallow): Pass #:properties to
'build-expression->derivation'.
* tests/grafts.scm ("graft-derivation, grafted item is a direct
dependency"): Check the value returned by 'derivation-properties'.
This commit is contained in:
Ludovic Courtès
2018-11-26 22:27:39 +01:00
parent 8856f409d1
commit 64fd1c01bc
2 changed files with 14 additions and 6 deletions

View File

@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,7 +51,8 @@
(test-begin "grafts")
(test-assert "graft-derivation, grafted item is a direct dependency"
(test-equal "graft-derivation, grafted item is a direct dependency"
'((type . graft) (graft (count . 2)))
(let* ((build `(begin
(mkdir %output)
(chdir %output)
@@ -76,14 +77,16 @@
(origin %mkdir)
(replacement two))))))
(and (build-derivations %store (list grafted))
(let ((two (derivation->output-path two))
(grafted (derivation->output-path grafted)))
(let ((properties (derivation-properties grafted))
(two (derivation->output-path two))
(grafted (derivation->output-path grafted)))
(and (string=? (format #f "foo/~a/bar" two)
(call-with-input-file (string-append grafted "/text")
get-string-all))
(string=? (readlink (string-append grafted "/sh")) one)
(string=? (readlink (string-append grafted "/self"))
grafted))))))
grafted)
properties)))))
(test-assert "graft-derivation, grafted item uses a different name"
(let* ((build `(begin