gnu-maintenance: update-package-source: Only update the desired package.

Fixes <http://bugs.gnu.org/22693>.
Suggested by Andy Wingo.

* guix/upstream.scm (update-package-source): Rewrite in terms of 'edit-expression'.
master
宋文武 2016-04-06 18:32:20 +08:00
parent f7df1e3efb
commit 2b8e9d9ed4
1 changed files with 22 additions and 44 deletions

View File

@ -22,8 +22,6 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix download) #:use-module ((guix download)
#:select (download-to-store)) #:select (download-to-store))
#:use-module ((guix build utils)
#:select (substitute))
#:use-module (guix gnupg) #:use-module (guix gnupg)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix ui) #:use-module (guix ui)
@ -205,52 +203,32 @@ and 'interactive' (default)."
"Modify the source file that defines PACKAGE to refer to VERSION, "Modify the source file that defines PACKAGE to refer to VERSION,
whose tarball has SHA256 HASH (a bytevector). Return the new version string whose tarball has SHA256 HASH (a bytevector). Return the new version string
if an update was made, and #f otherwise." if an update was made, and #f otherwise."
(define (new-line line matches replacement) (define (update-expression expr old-version version old-hash hash)
;; Iterate over MATCHES and return the modified line based on LINE. ;; Update package expression EXPR, replacing occurrences OLD-VERSION by
;; Replace each match with REPLACEMENT. ;; VERSION and occurrences of OLD-HASH by HASH (base32 representation
(let loop ((m* matches) ; matches ;; thereof).
(o 0) ; offset in L
(r '())) ; result
(match m*
(()
(let ((r (cons (substring line o) r)))
(string-concatenate-reverse r)))
((m . rest)
(loop rest
(match:end m)
(cons* replacement
(substring line o (match:start m))
r))))))
(define (update-source file old-version version
old-hash hash)
;; Update source file FILE, replacing occurrences OLD-VERSION by VERSION
;; and occurrences of OLD-HASH by HASH (base32 representation thereof).
;; TODO: Currently this is a bit of a sledgehammer: if VERSION occurs in
;; different unrelated places, we may modify it more than needed, for
;; instance. We should try to make changes only within the sexp that
;; corresponds to the definition of PACKAGE.
(let ((old-hash (bytevector->nix-base32-string old-hash)) (let ((old-hash (bytevector->nix-base32-string old-hash))
(hash (bytevector->nix-base32-string hash))) (hash (bytevector->nix-base32-string hash)))
(substitute file (string-replace-substring
`((,(regexp-quote old-version) (string-replace-substring expr old-hash hash)
. ,(cut new-line <> <> version)) old-version version)))
(,(regexp-quote old-hash)
. ,(cut new-line <> <> hash))))
version))
(let ((name (package-name package)) (let ((name (package-name package))
(loc (package-field-location package 'version))) (version-loc (package-field-location package 'version)))
(if loc (if version-loc
(let ((old-version (package-version package)) (let* ((loc (package-location package))
(old-hash (origin-sha256 (package-source package))) (old-version (package-version package))
(file (and=> (location-file loc) (old-hash (origin-sha256 (package-source package)))
(cut search-path %load-path <>)))) (file (and=> (location-file loc)
(cut search-path %load-path <>))))
(if file (if file
(update-source file (and (edit-expression
old-version version ;; Be sure to use absolute filename.
old-hash hash) (assq-set! (location->source-properties loc)
'filename file)
(cut update-expression <>
old-version version old-hash hash))
version)
(begin (begin
(warning (_ "~a: could not locate source file") (warning (_ "~a: could not locate source file")
(location-file loc)) (location-file loc))