From patchwork Wed Apr 27 16:56:21 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 38934 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 7889D27BBEA; Wed, 27 Apr 2022 17:58:07 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id E6AE827BBE9 for ; Wed, 27 Apr 2022 17:58:06 +0100 (BST) Received: from localhost ([::1]:54476 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1njkzO-00042b-1G for patchwork@mira.cbaines.net; Wed, 27 Apr 2022 12:58:06 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34530) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1njkyL-0003RA-T5 for guix-patches@gnu.org; Wed, 27 Apr 2022 12:57:01 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:50206) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1njkyL-00055G-IT for guix-patches@gnu.org; Wed, 27 Apr 2022 12:57:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1njkyL-0003oi-Hs for guix-patches@gnu.org; Wed, 27 Apr 2022 12:57:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#54997] [PATCH v2 01/15] gexp: Add 'references-file'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 27 Apr 2022 16:57:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54997 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54997@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 54997-submit@debbugs.gnu.org id=B54997.165107861714642 (code B ref 54997); Wed, 27 Apr 2022 16:57:01 +0000 Received: (at 54997) by debbugs.gnu.org; 27 Apr 2022 16:56:57 +0000 Received: from localhost ([127.0.0.1]:44097 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1njkyG-0003nv-IB for submit@debbugs.gnu.org; Wed, 27 Apr 2022 12:56:57 -0400 Received: from eggs.gnu.org ([209.51.188.92]:41142) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1njkyE-0003nQ-Us for 54997@debbugs.gnu.org; Wed, 27 Apr 2022 12:56:55 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:60000) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1njky9-00052q-EK; Wed, 27 Apr 2022 12:56:49 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=6C7LeNL03xVd+APXYMwW88t6a93WeJO2sRkdPIwKDwE=; b=BYtpsqMfot7vpl5DD09m ADXppDCTgfUvy9nJgww1rf4jEUuqGBl7/Ne0SvJWtNVJwnhhdW2BpBh8W3xmd9amQgBwtVvxBaX4Q wQJe9QY5wkazUw4IXiRy1flIwo3MpBdEDHv/EbQeZf+8lN2cMlrLAUncOKj0sGG7vh69Qo/bkhkEG c14L2kvguVK0WQiybT6NOkZMlGP+vtfCaMHSiu5DPzH21DpR7qHZeuvYymB5iCiRQktMr4EOJ22iW +IdLpAIg2YvqRVVkzcJUuzFPslwZhYX30286c2SsYsbYBPLdoj0JUeahq31KR7HbVKylxU9VQlJRv 4QfXjePv5qp++A==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:64439 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1njky8-0000Hl-VF; Wed, 27 Apr 2022 12:56:49 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Wed, 27 Apr 2022 18:56:21 +0200 Message-Id: <20220427165635.8015-2-ludo@gnu.org> X-Mailer: git-send-email 2.35.1 In-Reply-To: <20220427165635.8015-1-ludo@gnu.org> References: <878rrrk1v1.fsf_-_@gnu.org> <20220427165635.8015-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/services/base.scm (references-file): Remove. * guix/gexp.scm (references-file): New procedure. * tests/gexp.scm ("references-file"): New test. --- gnu/services/base.scm | 22 ---------------------- guix/gexp.scm | 44 +++++++++++++++++++++++++++++++++++++++++++ tests/gexp.scm | 18 ++++++++++++++++++ 3 files changed, 62 insertions(+), 22 deletions(-) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 5d7c69a9cd..182badd97f 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -219,8 +219,6 @@ (define-module (gnu services base) pam-limits-service-type pam-limits-service - references-file - %base-services)) ;;; Commentary: @@ -1768,26 +1766,6 @@ (define (guix-activation config) (substitute-key-authorization authorized-keys guix) #~#f)))) -(define* (references-file item #:optional (name "references")) - "Return a file that contains the list of references of ITEM." - (if (struct? item) ;lowerable object - (computed-file name - (with-extensions (list guile-gcrypt) ;for store-copy - (with-imported-modules (source-module-closure - '((guix build store-copy))) - #~(begin - (use-modules (guix build store-copy)) - - (call-with-output-file #$output - (lambda (port) - (write (map store-info-item - (call-with-input-file "graph" - read-reference-graph)) - port)))))) - #:options `(#:local-build? #f - #:references-graphs (("graph" ,item)))) - (plain-file name "()"))) - (define guix-service-type (service-type (name 'guix) diff --git a/guix/gexp.scm b/guix/gexp.scm index 9fdb7a30be..ef92223048 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -118,6 +118,7 @@ (define-module (guix gexp) mixed-text-file file-union directory-union + references-file imported-files imported-modules @@ -2173,6 +2174,49 @@ (define log-port #:resolve-collision (ungexp resolve-collision))))))))) +(define* (references-file item #:optional (name "references") + #:key guile) + "Return a file that contains the list of direct and indirect references (the +closure) of ITEM." + (if (struct? item) ;lowerable object + (computed-file name + (gexp (begin + (use-modules (srfi srfi-1) + (ice-9 rdelim) + (ice-9 match)) + + (define (drop-lines port n) + ;; Drop N lines read from PORT. + (let loop ((n n)) + (unless (zero? n) + (read-line port) + (loop (- n 1))))) + + (define (read-graph port) + ;; Return the list of references read from + ;; PORT. This is a stripped-down version of + ;; 'read-reference-graph'. + (let loop ((items '())) + (match (read-line port) + ((? eof-object?) + (delete-duplicates items)) + ((? string? item) + (let ((deriver (read-line port)) + (count + (string->number (read-line port)))) + (drop-lines port count) + (loop (cons item items))))))) + + (call-with-output-file (ungexp output) + (lambda (port) + (write (call-with-input-file "graph" + read-graph) + port))))) + #:guile guile + #:options `(#:local-build? #t + #:references-graphs (("graph" ,item)))) + (plain-file name "()"))) + ;;; ;;; Syntactic sugar. diff --git a/tests/gexp.scm b/tests/gexp.scm index c80ca13fab..35bd99e6d4 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1606,6 +1606,24 @@ (define (contents=? file str) (not (member (derivation-file-name native) refs)) (member (derivation-file-name cross) refs)))))) +(test-assertm "references-file" + (let* ((exp #~(symlink #$%bootstrap-guile #$output)) + (computed (computed-file "computed" exp + #:guile %bootstrap-guile)) + (refs (references-file computed "refs" + #:guile %bootstrap-guile))) + (mlet* %store-monad ((drv0 (lower-object %bootstrap-guile)) + (drv1 (lower-object computed)) + (drv2 (lower-object refs))) + (mbegin %store-monad + (built-derivations (list drv2)) + (mlet %store-monad ((refs ((store-lift requisites) + (list (derivation->output-path drv1))))) + (return (lset= string=? + (call-with-input-file (derivation->output-path drv2) + read) + refs))))))) + (test-assert "lower-object & gexp-input-error?" (guard (c ((gexp-input-error? c) (gexp-error-invalid-input c)))