committer: Avoid // in xpath.

When using // we assume that the package definition's S-expression is a
nesting of proper lists.  This is not guaranteed to be true, because a package
definition may contain alists.  By using an explicit path to the field of
interest we avoid recursion through all child nodes, thus avoiding child nodes
that are more likely to contain improper lists.

* etc/committer.scm.in (change-commit-message): Replace // with a path for the
PACKAGE symbol.

Change-Id: Idefaec9f5c3538484432e15a5865a68fc16e7369
This commit is contained in:
Ricardo Wurmus 2024-08-25 22:35:47 +02:00
parent a2e10e2878
commit a7db59b3fd
No known key found for this signature in database
GPG key ID: 197A5888235FACAC

View file

@ -3,7 +3,7 @@
!# !#
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020, 2021, 2022, 2023 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@ -255,10 +255,18 @@ (define (new-sexp hunk)
(define* (change-commit-message file-name old new #:optional (port (current-output-port))) (define* (change-commit-message file-name old new #:optional (port (current-output-port)))
"Print ChangeLog commit message for changes between OLD and NEW." "Print ChangeLog commit message for changes between OLD and NEW."
(define (get-values expr field) (define (get-values expr field)
(match ((xpath:sxpath `(// ,field quasiquote *)) expr) (match ((xpath:node-or
(xpath:sxpath `(*any* *any* package ,field quasiquote *))
;; For let binding
(xpath:sxpath `(*any* *any* (*any*) package ,field quasiquote *)))
(cons '*TOP* expr))
(() (()
;; New-style plain lists ;; New-style plain lists
(match ((xpath:sxpath `(// ,field list *)) expr) (match ((xpath:node-or
(xpath:sxpath `(*any* *any* package ,field list *))
;; For let binding
(xpath:sxpath `(*any* *any* (*any*) package ,field list *)))
(cons '*TOP* expr))
((inner) inner) ((inner) inner)
(_ '()))) (_ '())))
;; Old-style labelled inputs ;; Old-style labelled inputs
@ -275,7 +283,11 @@ (define (listify items)
(define variable-name (define variable-name
(second old)) (second old))
(define version (define version
(and=> ((xpath:sxpath '(// version *any*)) new) (and=> ((xpath:node-or
(xpath:sxpath '(*any* *any* package version *any*))
;; For let binding
(xpath:sxpath '(*any* *any* (*any*) package version *any*)))
(cons '*TOP* new))
first)) first))
(format port (format port
"gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%" "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%"