ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-27 04:59:27 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

packages: 'generate-package-cache' is deterministic.

Browse source 
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.
This commit is contained in:
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 @@ (define (generate-package-cache directory)
(define cache-file (define cache-file
(string-append directory %package-cache-file)) (string-append directory %package-cache-file))
(define (expand-cache module symbol variable result+seen) (define expand-cache
(match (false-if-exception (variable-ref variable)) (match-lambda*
((? package? package) (((module symbol variable) (result . seen))
(match result+seen (let ((package (variable-ref variable)))
((result . seen) (if (or (vhash-assq package seen)
(if (or (vhash-assq package seen) (hidden-package? package))
(hidden-package? package)) (cons result seen)
(cons result seen) (cons (cons `#(,(package-name package)
(cons (cons `#(,(package-name package) ,(package-version package)
,(package-version package) ,(module-name module)
,(module-name module) ,symbol
,symbol ,(package-outputs package)
,(package-outputs package) ,(->bool (supported-package? package))
,(->bool (supported-package? package)) ,(->bool (package-superseded package))
,(->bool (package-superseded package)) ,@(let ((loc (package-location package)))
,@(let ((loc (package-location package))) (if loc
(if loc `(,(location-file loc)
`(,(location-file loc) ,(location-line loc)
,(location-line loc) ,(location-column loc))
,(location-column loc)) '(#f #f #f))))
'(#f #f #f)))) result)
result) (vhash-consq package #t seen)))))))
(vhash-consq package #t seen))))))
(_
result+seen)))
(define exp (define entry-key
(first (match-lambda
(fold-module-public-variables* expand-cache ((module symbol variable)
(cons '() vlist-null) (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) (all-modules (%package-module-path)
#:warn #: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)) (mkdir-p (dirname cache-file))
(call-with-output-file cache-file (call-with-output-file cache-file