#24937 "deleting unused links" GC phase is too slow

Message #67 received at 24937@debbugs.gnu.org (full text, mbox, reply):

Received: (at 24937) by debbugs.gnu.org; 13 Nov 2021 21:38:03 +0000
From debbugs-submit-bounces@debbugs.gnu.org Sat Nov 13 16:38:03 2021
Received: from localhost ([127.0.0.1]:48324 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces@debbugs.gnu.org>)
	id 1mm0ip-0003sk-2E
	for submit@debbugs.gnu.org; Sat, 13 Nov 2021 16:38:03 -0500
Received: from eggs.gnu.org ([209.51.188.92]:45512)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <ludo@gnu.org>) id 1mm0im-0003s8-Fe
 for 24937@debbugs.gnu.org; Sat, 13 Nov 2021 16:38:01 -0500
Received: from [2001:470:142:3::e] (port=33780 helo=fencepost.gnu.org)
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@gnu.org>)
 id 1mm0if-0001f1-Sd; Sat, 13 Nov 2021 16:37:53 -0500
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=FHqfOWStYk1HIj1WZ2uIv2f9VooCa9RpmIq3P6FYsRg=; b=NuGbXEEV0dnB2vm8wNVm
 n0RKAuOUvw6CIHPJOn0s7WWQUiFrFKLUSyWQZSEOYXmN9Vya5cSetsXrkGa2J5XACNryBUF2Atr0O
 ORdH0a4acU0Wqzz6hrV1K7W0cZZR2uItMZYw0LCUUxidCNqRSy6ISvj0Zu5m/7kN7wdJzvzl6ob1a
 XuycPHi6cmRc6NS/4GvaHcSFVydwlGd/ryRwXAroy6EA95zcFfX11fNmN+W1fPSJDKSiBF5AdB9jI
 3pFB2rntB1ZKWD7WzISkwnbnCD1+iYktYmGcl/gKhQMOW4fBQ4oVuIp8gALoICFFUySXSMuMFrr4V
 E1C7pa+0TB7M6A==;
Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:63350
 helo=gnu.org)
 by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.90_1) (envelope-from <ludo@gnu.org>)
 id 1mm0if-0000wh-KE; Sat, 13 Nov 2021 16:37:53 -0500
From: Ludovic Courtès <ludo@gnu.org>
To: 24937@debbugs.gnu.org
Subject: [PATCH 1/2] =?UTF-8?q?tests:=20Factorize=20'file=3D=3F'.?=
Date: Sat, 13 Nov 2021 22:37:44 +0100
Message-Id: <20211113213745.2601-1-ludo@gnu.org>
X-Mailer: git-send-email 2.33.0
In-Reply-To: <87v90wat9n.fsf@gnu.org>
References: <87v90wat9n.fsf@gnu.org>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 24937
Cc: Ludovic Courtès <ludo@gnu.org>
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request@debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit@debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request@debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request@debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces@debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

* guix/tests.scm (file=?): Add optional 'stat' parameter.  Add fast
patch comparing inode numbers.
* tests/gexp.scm ("imported-files with file-like objects"): Remove
'file=?' procedure and use the one from (guix tests).
---
 guix/tests.scm | 30 +++++++++++++++++-------------
 tests/gexp.scm | 11 +++--------
 2 files changed, 20 insertions(+), 21 deletions(-)

diff --git a/guix/tests.scm b/guix/tests.scm
index fc3d521163..e1c194340c 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -182,18 +182,22 @@ (define (random-bytevector n)
             (loop (1+ i)))
           bv))))
 
-(define (file=? a b)
-  "Return true if files A and B have the same type and same content."
-  (and (eq? (stat:type (lstat a)) (stat:type (lstat b)))
-       (case (stat:type (lstat a))
-         ((regular)
-          (equal?
-           (call-with-input-file a get-bytevector-all)
-           (call-with-input-file b get-bytevector-all)))
-         ((symlink)
-          (string=? (readlink a) (readlink b)))
-         (else
-          (error "what?" (lstat a))))))
+(define* (file=? a b #:optional (stat lstat))
+  "Return true if files A and B have the same type and same content.  Call
+STAT to obtain file metadata."
+  (let ((sta (stat a)) (stb (stat b)))
+    (and (eq? (stat:type sta) (stat:type stb))
+         (case (stat:type sta)
+           ((regular)
+            (or (and (= (stat:ino sta) (stat:ino stb))
+                     (= (stat:dev sta) (stat:dev stb)))
+                (equal?
+                 (call-with-input-file a get-bytevector-all)
+                 (call-with-input-file b get-bytevector-all))))
+           ((symlink)
+            (string=? (readlink a) (readlink b)))
+           (else
+            (error "what?" (stat a)))))))
 
 (define (canonical-file? file)
   "Return #t if FILE is in the store, is read-only, and its mtime is 1."
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 39a47d4e8c..0758a49f5f 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -827,19 +827,14 @@ (define (canonical-file? file)
                        (files -> `(("a/b/c" . ,q-scm)
                                    ("p/q"   . ,plain)))
                        (drv      (imported-files files)))
-    (define (file=? file1 file2)
-      ;; Assume deduplication is in place.
-      (= (stat:ino (stat file1))
-         (stat:ino (stat file2))))
-
     (mbegin %store-monad
       (built-derivations (list (pk 'drv drv)))
       (mlet %store-monad ((dir -> (derivation->output-path drv))
                           (plain* (text-file "foo" "bar!"))
                           (q-scm* (interned-file q-scm "c")))
         (return
-         (and (file=? (string-append dir "/a/b/c") q-scm*)
-              (file=? (string-append dir "/p/q") plain*)))))))
+         (and (file=? (string-append dir "/a/b/c") q-scm* stat)
+              (file=? (string-append dir "/p/q") plain* stat)))))))
 
 (test-equal "gexp-modules & ungexp"
   '((bar) (foo))
-- 
2.33.0

Send a report that this bug log contains spam.