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 | 80 ++++++++++++++++++++++++++++++------------------
 1 file changed, 50 insertions(+), 30 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 4e4282645a..ccfc83dd11 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -381,39 +381,59 @@ reducing the memory footprint."
   (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 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 exp
-    (first
-     (fold-module-public-variables* expand-cache
-                                    (cons '() vlist-null)
+  (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