me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2020-07-30 16:37:19 +02:00
parent c9c8c6331e
commit a127e52f60
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 50 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
gnu/packages.scm
View File

@ -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