From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:56210) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gROjb-00051Y-Jt for guix-patches@gnu.org; Mon, 26 Nov 2018 16:48:04 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gROja-0005RA-Jt for guix-patches@gnu.org; Mon, 26 Nov 2018 16:48:03 -0500 Received: from debbugs.gnu.org ([208.118.235.43]:45952) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gROja-0005Qq-Gv for guix-patches@gnu.org; Mon, 26 Nov 2018 16:48:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1gROja-0004pT-ER for guix-patches@gnu.org; Mon, 26 Nov 2018 16:48:02 -0500 Subject: [bug#33519] [PATCH 2/4] grafts: Record metadata as derivation properties. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Mon, 26 Nov 2018 22:47:07 +0100 Message-Id: <20181126214709.27856-2-ludo@gnu.org> In-Reply-To: <20181126214709.27856-1-ludo@gnu.org> References: <20181126214709.27856-1-ludo@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 33519@debbugs.gnu.org Cc: rekado@elephly.net * 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'. --- guix/grafts.scm | 7 ++++++- tests/grafts.scm | 13 ++++++++----- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/guix/grafts.scm b/guix/grafts.scm index 01e245d8eb..63f384555b 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -123,6 +123,10 @@ are not recursively applied to dependencies of DRV." (define add-label (cut cons "x" <>)) + (define properties + `((type . graft) + (graft (count . ,(length grafts))))) + (match grafts ((($ sources source-outputs targets target-outputs) ...) (let ((sources (zip sources source-outputs)) @@ -140,7 +144,8 @@ are not recursively applied to dependencies of DRV." ,@(append (map add-label sources) (map add-label targets))) #:outputs outputs - #:local-build? #t))))) + #:local-build? #t + #:properties properties))))) (define (item->deriver store item) "Return two values: the derivation that led to ITEM (a store item), and the name of the output of that derivation ITEM corresponds to (for example diff --git a/tests/grafts.scm b/tests/grafts.scm index abb074d628..f85f3c6913 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; 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 -- 2.19.1