diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2023-05-17 16:52:54 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2023-05-31 23:25:25 +0200 |
| commit | ec0a2fc87bd651ebc8f253f6369ba4485912d9b2 (patch) | |
| tree | 1aff0cf18ee1ba57147b3c3bd972d1118cf51d2b | |
| parent | 9f3ea03516b506d7c0440867b9db08898390a981 (diff) | |
upstream: 'update-package-source' edits input fields.
Previously, 'guix refresh r-ggplot2 -u' and similar commands would print
of list of input changes that would have to be made manually. With this
change, 'guix refresh -u' takes care of updating input fields
automatically.
* guix/upstream.scm (update-package-inputs): New procedure.
(update-package-source): Call it when 'upstream-source-inputs' returns
true.
* guix/scripts/refresh.scm (update-package): Remove iteration over the
result of 'changed-inputs'.
* guix/import/test.scm (available-updates): Add support for input
lists.
* tests/guix-refresh.sh (GUIX_TEST_UPDATER_TARGETS): Add input list for
"the-test-package".
Make sure 'guix refresh -u' updates 'inputs' accordingly.
* doc/guix.texi (Invoking guix refresh): Mention it.
| -rw-r--r-- | doc/guix.texi | 5 | ||||
| -rw-r--r-- | guix/import/test.scm | 13 | ||||
| -rw-r--r-- | guix/scripts/refresh.scm | 36 | ||||
| -rw-r--r-- | guix/upstream.scm | 56 | ||||
| -rw-r--r-- | tests/guix-refresh.sh | 7 |
5 files changed, 72 insertions, 45 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 943e9bf526b..b83767aaf48 100644 --- a/doc/guix.texi +++ b/doc/guix.texi | |||
| @@ -14309,8 +14309,9 @@ to that effect: | |||
| 14309 | @end lisp | 14309 | @end lisp |
| 14310 | 14310 | ||
| 14311 | When passed @option{--update}, it modifies distribution source files to | 14311 | When passed @option{--update}, it modifies distribution source files to |
| 14312 | update the version numbers and source tarball hashes of those package | 14312 | update the version numbers and source code hashes of those package |
| 14313 | recipes (@pxref{Defining Packages}). This is achieved by downloading | 14313 | definitions, as well as possibly their inputs (@pxref{Defining Packages}). |
| 14314 | This is achieved by downloading | ||
| 14314 | each package's latest source tarball and its associated OpenPGP | 14315 | each package's latest source tarball and its associated OpenPGP |
| 14315 | signature, authenticating the downloaded tarball against its signature | 14316 | signature, authenticating the downloaded tarball against its signature |
| 14316 | using @command{gpgv}, and finally computing its hash---note that GnuPG must be | 14317 | using @command{gpgv}, and finally computing its hash---note that GnuPG must be |
diff --git a/guix/import/test.scm b/guix/import/test.scm index b1ed0b455d0..4bd356bddc1 100644 --- a/guix/import/test.scm +++ b/guix/import/test.scm | |||
| @@ -52,7 +52,18 @@ | |||
| 52 | (upstream-source | 52 | (upstream-source |
| 53 | (package (package-name package)) | 53 | (package (package-name package)) |
| 54 | (version version) | 54 | (version version) |
| 55 | (urls (list url))))) | 55 | (urls (list url)))) |
| 56 | ((version url (inputs ...)) | ||
| 57 | (upstream-source | ||
| 58 | (package (package-name package)) | ||
| 59 | (version version) | ||
| 60 | (urls (list url)) | ||
| 61 | (inputs | ||
| 62 | (map (lambda (name) | ||
| 63 | (upstream-input | ||
| 64 | (name name) | ||
| 65 | (downstream-name name))) | ||
| 66 | inputs))))) | ||
| 56 | updates) | 67 | updates) |
| 57 | result) | 68 | result) |
| 58 | result)))) | 69 | result)))) |
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index d838a4aca2b..96762715426 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm | |||
| @@ -369,42 +369,6 @@ warn about packages that have no matching updater." | |||
| 369 | (G_ "~a: updating from version ~a to version ~a...~%") | 369 | (G_ "~a: updating from version ~a to version ~a...~%") |
| 370 | (package-name package) | 370 | (package-name package) |
| 371 | (package-version package) version) | 371 | (package-version package) version) |
| 372 | (for-each | ||
| 373 | (lambda (change) | ||
| 374 | (define field | ||
| 375 | (match (upstream-input-change-type change) | ||
| 376 | ('native 'native-inputs) | ||
| 377 | ('propagated 'propagated-inputs) | ||
| 378 | (_ 'inputs))) | ||
| 379 | |||
| 380 | (define name | ||
| 381 | (package-name package)) | ||
| 382 | (define loc | ||
| 383 | (package-field-location package field)) | ||
| 384 | (define change-name | ||
| 385 | (upstream-input-change-name change)) | ||
| 386 | |||
| 387 | (match (list (upstream-input-change-action change) | ||
| 388 | (upstream-input-change-type change)) | ||
| 389 | (('add 'regular) | ||
| 390 | (info loc (G_ "~a: consider adding this input: ~a~%") | ||
| 391 | name change-name)) | ||
| 392 | (('add 'native) | ||
| 393 | (info loc (G_ "~a: consider adding this native input: ~a~%") | ||
| 394 | name change-name)) | ||
| 395 | (('add 'propagated) | ||
| 396 | (info loc (G_ "~a: consider adding this propagated input: ~a~%") | ||
| 397 | name change-name)) | ||
| 398 | (('remove 'regular) | ||
| 399 | (info loc (G_ "~a: consider removing this input: ~a~%") | ||
| 400 | name change-name)) | ||
| 401 | (('remove 'native) | ||
| 402 | (info loc (G_ "~a: consider removing this native input: ~a~%") | ||
| 403 | name change-name)) | ||
| 404 | (('remove 'propagated) | ||
| 405 | (info loc (G_ "~a: consider removing this propagated input: ~a~%") | ||
| 406 | name change-name)))) | ||
| 407 | (changed-inputs package source)) | ||
| 408 | (let ((hash (file-hash* output))) | 372 | (let ((hash (file-hash* output))) |
| 409 | (update-package-source package source hash))) | 373 | (update-package-source package source hash))) |
| 410 | (warning (G_ "~a: version ~a could not be \ | 374 | (warning (G_ "~a: version ~a could not be \ |
diff --git a/guix/upstream.scm b/guix/upstream.scm index 4ae2d1c8c89..7d9ae70eda8 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm | |||
| @@ -38,6 +38,7 @@ | |||
| 38 | #:use-module (guix hash) | 38 | #:use-module (guix hash) |
| 39 | #:use-module (guix store) | 39 | #:use-module (guix store) |
| 40 | #:use-module ((guix derivations) #:select (built-derivations derivation->output-path)) | 40 | #:use-module ((guix derivations) #:select (built-derivations derivation->output-path)) |
| 41 | #:autoload (guix read-print) (object->string*) | ||
| 41 | #:autoload (gcrypt hash) (port-sha256) | 42 | #:autoload (gcrypt hash) (port-sha256) |
| 42 | #:use-module (guix monads) | 43 | #:use-module (guix monads) |
| 43 | #:use-module (srfi srfi-1) | 44 | #:use-module (srfi srfi-1) |
| @@ -583,6 +584,52 @@ this method: ~s") | |||
| 583 | (package-name package))) | 584 | (package-name package))) |
| 584 | (values #f #f #f)))) | 585 | (values #f #f #f)))) |
| 585 | 586 | ||
| 587 | (define (update-package-inputs package source) | ||
| 588 | "Update the input fields of the definition of PACKAGE according to those | ||
| 589 | specified in SOURCE, an <upstream-source>." | ||
| 590 | (define (update-field field source-inputs package-inputs) | ||
| 591 | (define loc | ||
| 592 | (package-field-location package field)) | ||
| 593 | |||
| 594 | (define new | ||
| 595 | (map (compose string->symbol upstream-input-downstream-name) | ||
| 596 | (source-inputs source))) | ||
| 597 | |||
| 598 | (define old | ||
| 599 | (match (package-inputs package) | ||
| 600 | (((labels (? package? packages)) ...) | ||
| 601 | labels) | ||
| 602 | (_ | ||
| 603 | '()))) | ||
| 604 | |||
| 605 | (define unchanged? | ||
| 606 | (equal? new old)) | ||
| 607 | |||
| 608 | (if (and loc (not unchanged?)) | ||
| 609 | (edit-expression (location->source-properties | ||
| 610 | (absolute-location loc)) | ||
| 611 | (lambda (str) | ||
| 612 | (object->string* `(list ,@new) | ||
| 613 | (location-column loc)))) | ||
| 614 | (unless unchanged? | ||
| 615 | ;; XXX: Bail out when FIELD isn't already present in the source. | ||
| 616 | ;; TODO: Add the field if it's missing. | ||
| 617 | (warning (package-location package) | ||
| 618 | (G_ "~a: '~a' field not found; leaving it unchanged~%") | ||
| 619 | (package-name package) field) | ||
| 620 | (warning (package-location package) | ||
| 621 | (G_ "~a: expected '~a' value: ~s~%") | ||
| 622 | (package-name package) field new)))) | ||
| 623 | |||
| 624 | (for-each update-field | ||
| 625 | '(inputs native-inputs propagated-inputs) | ||
| 626 | (list upstream-source-regular-inputs | ||
| 627 | upstream-source-native-inputs | ||
| 628 | upstream-source-propagated-inputs) | ||
| 629 | (list package-inputs | ||
| 630 | package-native-inputs | ||
| 631 | package-propagated-inputs))) | ||
| 632 | |||
| 586 | (define* (update-package-source package source hash) | 633 | (define* (update-package-source package source hash) |
| 587 | "Modify the source file that defines PACKAGE to refer to SOURCE, an | 634 | "Modify the source file that defines PACKAGE to refer to SOURCE, an |
| 588 | <upstream-source> whose tarball has SHA256 HASH (a bytevector). Return the | 635 | <upstream-source> whose tarball has SHA256 HASH (a bytevector). Return the |
| @@ -637,9 +684,7 @@ new version string if an update was made, and #f otherwise." | |||
| 637 | ;; function of the person who uploads the package. Note that | 684 | ;; function of the person who uploads the package. Note that |
| 638 | ;; package definitions usually concatenate fragments of the URL, | 685 | ;; package definitions usually concatenate fragments of the URL, |
| 639 | ;; which is why we only attempt to replace a subset of the URL. | 686 | ;; which is why we only attempt to replace a subset of the URL. |
| 640 | (let ((properties (location->source-properties | 687 | (let ((replacements `((,old-version . ,version) |
| 641 | (absolute-location loc))) | ||
| 642 | (replacements `((,old-version . ,version) | ||
| 643 | (,old-hash . ,hash) | 688 | (,old-hash . ,hash) |
| 644 | ,@(if (and old-commit new-commit) | 689 | ,@(if (and old-commit new-commit) |
| 645 | `((,old-commit . ,new-commit)) | 690 | `((,old-commit . ,new-commit)) |
| @@ -648,8 +693,11 @@ new version string if an update was made, and #f otherwise." | |||
| 648 | `((,(dirname old-url) . | 693 | `((,(dirname old-url) . |
| 649 | ,(dirname new-url))) | 694 | ,(dirname new-url))) |
| 650 | '())))) | 695 | '())))) |
| 651 | (and (edit-expression properties | 696 | (and (edit-expression (location->source-properties |
| 697 | (absolute-location loc)) | ||
| 652 | (cut update-expression <> replacements)) | 698 | (cut update-expression <> replacements)) |
| 699 | (or (not (upstream-source-inputs source)) | ||
| 700 | (update-package-inputs package source)) | ||
| 653 | version)) | 701 | version)) |
| 654 | (begin | 702 | (begin |
| 655 | (warning (G_ "~a: could not locate source file") | 703 | (warning (G_ "~a: could not locate source file") |
diff --git a/tests/guix-refresh.sh b/tests/guix-refresh.sh index 691020b0310..9d7a57a36eb 100644 --- a/tests/guix-refresh.sh +++ b/tests/guix-refresh.sh | |||
| @@ -34,7 +34,8 @@ GUIX_TEST_UPDATER_TARGETS=' | |||
| 34 | ("1.6.4" "file:///dev/null"))) | 34 | ("1.6.4" "file:///dev/null"))) |
| 35 | ("libreoffice" "" (("1.0" "file:///dev/null"))) | 35 | ("libreoffice" "" (("1.0" "file:///dev/null"))) |
| 36 | ("idutils" "" (("'$idutils_version'" "file:///dev/null"))) | 36 | ("idutils" "" (("'$idutils_version'" "file:///dev/null"))) |
| 37 | ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"))))' | 37 | ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source" |
| 38 | ("grep" "sed")))))' | ||
| 38 | 39 | ||
| 39 | # No newer version available. | 40 | # No newer version available. |
| 40 | guix refresh -t test idutils # XXX: should return non-zero? | 41 | guix refresh -t test idutils # XXX: should return non-zero? |
| @@ -91,13 +92,15 @@ cat > "$module_dir/sample.scm"<<EOF | |||
| 91 | ".tar.gz")) | 92 | ".tar.gz")) |
| 92 | (sha256 | 93 | (sha256 |
| 93 | (base32 | 94 | (base32 |
| 94 | "086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd")))))) | 95 | "086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd")))) |
| 96 | (inputs (list coreutils tar)))) | ||
| 95 | EOF | 97 | EOF |
| 96 | guix refresh -t test -L "$module_dir" the-test-package | 98 | guix refresh -t test -L "$module_dir" the-test-package |
| 97 | guix refresh -t test -L "$module_dir" the-test-package -u \ | 99 | guix refresh -t test -L "$module_dir" the-test-package -u \ |
| 98 | --keyring="$module_dir/keyring.kbx" # so we don't create $HOME/.config | 100 | --keyring="$module_dir/keyring.kbx" # so we don't create $HOME/.config |
| 99 | grep 'version "5.5"' "$module_dir/sample.scm" | 101 | grep 'version "5.5"' "$module_dir/sample.scm" |
| 100 | grep "$(guix hash -H sha256 -f nix-base32 "$module_dir/source")" "$module_dir/sample.scm" | 102 | grep "$(guix hash -H sha256 -f nix-base32 "$module_dir/source")" "$module_dir/sample.scm" |
| 103 | grep '(inputs (list grep sed))' "$module_dir/sample.scm" | ||
| 101 | 104 | ||
| 102 | # Specifying a target version. | 105 | # Specifying a target version. |
| 103 | guix refresh -t test guile=2.0.0 # XXX: should return non-zero? | 106 | guix refresh -t test guile=2.0.0 # XXX: should return non-zero? |
