summary refs log tree commit diff
path: root/tests/packages.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-02-01 16:07:18 +0100
committerLudovic Courtès <ludo@gnu.org>2021-02-01 16:07:18 +0100
commit73744725dd0a65cddaa9251f104f17ca27756479 (patch)
tree2966045fae60d99a9785f61e0580556653afc68e /tests/packages.scm
parent93af2ac871addc7755ea542928124d416f1a0361 (diff)
downloadguix-73744725dd0a65cddaa9251f104f17ca27756479.tar.gz
tests: Optimize 'fold-available-packages' test.
This test goes from 58s to 10s wall-clock time.

Reported by Maxim Cournoyer <maxim.cournoyer@gmail.com>.

* tests/packages.scm ("fold-available-packages with/without cache"):
Remove 'find-duplicates'.  Add 'list->set*' and use it instead of
'find-duplicates', 'delete-duplicates', and 'lset='.
Diffstat (limited to 'tests/packages.scm')
-rw-r--r--tests/packages.scm36
1 files changed, 24 insertions, 12 deletions
diff --git a/tests/packages.scm b/tests/packages.scm
index 18e8e16e74..2a290bc353 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -42,6 +42,7 @@
   #:use-module (guix memoization)
   #:use-module (guix profiles)
   #:use-module (guix scripts package)
+  #:use-module (guix sets)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages guile)
@@ -54,6 +55,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-71)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 vlist)
@@ -1549,17 +1551,27 @@
                                                       result))
                                               '()))))))
 
-    (define (find-duplicates l)
-      (match l
-        (() '())
-        ((head . tail)
-         (if (member head tail)
-             (cons head (find-duplicates tail))
-             (find-duplicates tail)))))
-
-    (pk (find-duplicates from-cache))
-    (and (equal? (delete-duplicates from-cache) from-cache)
-         (lset= equal? no-cache from-cache))))
+    (define (list->set* lst)
+      ;; Return two values: LST represented as a set and the list of
+      ;; duplicates in LST.
+      (let loop ((lst        lst)
+                 (duplicates '())
+                 (seen       (set)))
+        (match lst
+          (()
+           (values seen duplicates))
+          ((head . tail)
+           (if (set-contains? seen head)
+               (loop tail (cons head duplicates) seen)
+               (loop tail duplicates (set-insert head seen)))))))
+
+    ;; Compare FROM-CACHE and NO-CACHE but avoid 'lset=', which exhibits
+    ;; exponential behavior.
+    (let ((set1 duplicates1 (list->set* from-cache))
+          (set2 duplicates2 (list->set* no-cache)))
+      (and (null? duplicates1) (null? duplicates2)
+           (every (cut set-contains? set1 <>) no-cache)
+           (every (cut set-contains? set2 <>) from-cache)))))
 
 (test-assert "find-packages-by-name"
   (match (find-packages-by-name "hello")