me
/
guix
Archived
1
0
Fork 0
Code

packages: 'package->bag' keys cache by replacement. 

* guix/packages.scm (package->bag): When GRAFT? is true, use PACKAGE's
replacement as the cache key.  Remove GRAFT? from the list of
secondary cache keys.
master
Ludovic Courtès 2020-03-29 16:14:14 +02:00
parent 18c8a4396b
commit 9f78552996
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 33 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
guix/packages.scm
View File

@ -1029,39 +1029,39 @@ information in exceptions."
#:key (graft? (%graft?))) #:key (graft? (%graft?)))
"Compile PACKAGE into a bag for SYSTEM, possibly cross-compiled to TARGET, "Compile PACKAGE into a bag for SYSTEM, possibly cross-compiled to TARGET,
and return it." and return it."
(cached (=> %bag-cache) (let ((package (or (and graft? (package-replacement package))
package (list system target graft?) package)))
;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked (cached (=> %bag-cache)
;; field values can refer to it. package (list system target)
(parameterize ((%current-system system) ;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked
(%current-target-system target)) ;; field values can refer to it.
(match (if graft? (parameterize ((%current-system system)
(or (package-replacement package) package) (%current-target-system target))
package) (match package
((and self ((and self
($ <package> name version source build-system ($ <package> name version source build-system
args inputs propagated-inputs native-inputs args inputs propagated-inputs native-inputs
outputs)) outputs))
;; Even though we prefer to use "@" to separate the package ;; Even though we prefer to use "@" to separate the package
;; name from the package version in various user-facing parts ;; name from the package version in various user-facing parts
;; of Guix, checkStoreName (in nix/libstore/store-api.cc) ;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
;; prohibits the use of "@", so use "-" instead. ;; prohibits the use of "@", so use "-" instead.
(or (make-bag build-system (string-append name "-" version) (or (make-bag build-system (string-append name "-" version)
#:system system #:system system
#:target target #:target target
#:source source #:source source
#:inputs (append (inputs self) #:inputs (append (inputs self)
(propagated-inputs self)) (propagated-inputs self))
#:outputs outputs #:outputs outputs
#:native-inputs (native-inputs self) #:native-inputs (native-inputs self)
#:arguments (args self)) #:arguments (args self))
(raise (if target (raise (if target
(condition (condition
(&package-cross-build-system-error (&package-cross-build-system-error
(package package))) (package package)))
(condition (condition
(&package-error (&package-error
(package package))))))))))) (package package))))))))))))
(define %graft-cache (define %graft-cache
;; 'eq?' cache mapping package objects to a graft corresponding to their ;; 'eq?' cache mapping package objects to a graft corresponding to their