From a127e52f601ee73f675d5d28eac2388bb1ad11b0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 30 Jul 2020 16:37:19 +0200
Subject: [PATCH] packages: 'generate-package-cache' is deterministic.
Fixes <https://bugs.gnu.org/42009>.
Reported by Marinus <marinus.savoritias@disroot.org>.
* gnu/packages.scm (generate-package-cache)[entry-key, entry<?]
[variables]: New variables.
[expand-cache]: Change to take two arguments.
[exp]: Fold over VARIABLES.
---
gnu/packages.scm | 82 ++++++++++++++++++++++++++++++------------------
1 file changed, 51 insertions(+), 31 deletions(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 4e4282645ad..ccfc83dd117 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -381,39 +381,59 @@ (define (generate-package-cache directory)
(define cache-file
(string-append directory %package-cache-file))
- (define (expand-cache module symbol variable result+seen)
- (match (false-if-exception (variable-ref variable))
- ((? package? package)
- (match result+seen
- ((result . seen)
- (if (or (vhash-assq package seen)
- (hidden-package? package))
- (cons result seen)
- (cons (cons `#(,(package-name package)
- ,(package-version package)
- ,(module-name module)
- ,symbol
- ,(package-outputs package)
- ,(->bool (supported-package? package))
- ,(->bool (package-superseded package))
- ,@(let ((loc (package-location package)))
- (if loc
- `(,(location-file loc)
- ,(location-line loc)
- ,(location-column loc))
- '(#f #f #f))))
- result)
- (vhash-consq package #t seen))))))
- (_
- result+seen)))
-
- (define exp
- (first
- (fold-module-public-variables* expand-cache
- (cons '() vlist-null)
+ (define expand-cache
+ (match-lambda*
+ (((module symbol variable) (result . seen))
+ (let ((package (variable-ref variable)))
+ (if (or (vhash-assq package seen)
+ (hidden-package? package))
+ (cons result seen)
+ (cons (cons `#(,(package-name package)
+ ,(package-version package)
+ ,(module-name module)
+ ,symbol
+ ,(package-outputs package)
+ ,(->bool (supported-package? package))
+ ,(->bool (package-superseded package))
+ ,@(let ((loc (package-location package)))
+ (if loc
+ `(,(location-file loc)
+ ,(location-line loc)
+ ,(location-column loc))
+ '(#f #f #f))))
+ result)
+ (vhash-consq package #t seen)))))))
+
+ (define entry-key
+ (match-lambda
+ ((module symbol variable)
+ (let ((value (variable-ref variable)))
+ (string-append (package-name value) (package-version value)
+ (object->string module)
+ (symbol->string symbol))))))
+
+ (define (entry<? a b)
+ (string<? (entry-key a) (entry-key b)))
+
+ (define variables
+ ;; First sort variables so that 'expand-cache' later dismisses
+ ;; already-seen package objects in a deterministic fashion.
+ (sort
+ (fold-module-public-variables* (lambda (module symbol variable lst)
+ (let ((value (false-if-exception
+ (variable-ref variable))))
+ (if (package? value)
+ (cons (list module symbol variable)
+ lst)
+ lst)))
+ '()
(all-modules (%package-module-path)
#:warn
- warn-about-load-error))))
+ warn-about-load-error))
+ entry<?))
+
+ (define exp
+ (first (fold expand-cache (cons '() vlist-null) variables)))
(mkdir-p (dirname cache-file))
(call-with-output-file cache-file
--
GitLab