* [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff. @ 2021-04-30 14:36 Maxime Devos 2021-05-06 7:50 ` [bug#48120] [PATCH] " Maxime Devos ` (3 more replies) 0 siblings, 4 replies; 9+ messages in thread From: Maxime Devos @ 2021-04-30 14:36 UTC (permalink / raw) To: 48120 [-- Attachment #1.1: Type: text/plain, Size: 945 bytes --] Hi Guix, I snarfed these from my cc-for-target branch. Examples of generated commit messages, without any massaging: <start snip> gnu: ufoai-data: Use 'cc-for-target' and friends. * gnu/packages/games.scm (ufoai-data) [arguments]<#:configure-flags>: Use the C cross-compiler, instead of hardcoding "gcc". Use the C++ cross-compiler, instead of hardcoding "g++". gnu: mlt: Use 'cc-for-target' and friends. * gnu/packages/video.scm (mlt) [arguments]<#:make-flags>: Use the C cross-compiler, instead of hardcoding "gcc". Use the C++ cross-compiler, instead of hardcoding "g++". gnu: theorafile: Use the C cross-compiler. * gnu/packages/video.scm (theorafile) [arguments]<#:make-flags>: Use the C cross-compiler, instead of hardcoding "gcc". [arguments]<#:phases>{check}: Only run tests when not requested. <end snip> etc/comitter.scm.in should probably do some line wrapping as well. WDYT? Greetings, Maxime. [-- Attachment #1.2: 0001-etc-Teach-committer.scm-about-CC-gcc-cc-for-target-a.patch --] [-- Type: text/x-patch, Size: 7065 bytes --] From 7752bce327d7daec5825d94d195046cf1f4d7fb9 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 11:21:03 +0200 Subject: [PATCH 1/6] etc: Teach committer.scm about CC=gcc -> cc-for-target and friends. * etc/committer.scm.in (keyword-list->alist): New procedure. (pairwise-foreach-keyword): Likewise. (explain-list-delta): New procedure, for explaining a delta between two lists. (change-commit-message)[get-values/list]: New procedure. (change-commit-message)[explain-make-flags/change]: New procedure, currently explaining a transition from "CC=gcc" to "CC=" (cc-for-target) in the make flags. (change-commit-message)[explain-argument]: New procedure for explaining a difference in the 'arguments' field. Currently only #:make-flags is supported, using the previous procedure. --- etc/committer.scm.in | 96 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 94 insertions(+), 2 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 801b5d195e..75c82c9019 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -4,6 +4,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,7 +37,8 @@ (ice-9 popen) (ice-9 match) (ice-9 rdelim) - (ice-9 textual-ports)) + (ice-9 textual-ports) + (rnrs control)) (define (read-excursion port) "Read an expression from PORT and reset the port position before returning @@ -173,6 +175,60 @@ corresponding to the top-level definition containing the staged changes." (+ (lines-to-first-change hunk) (hunk-new-line-number hunk)))))) +(define (keyword-list->alist kwlist) + (match kwlist + (() '()) + (((? keyword? k) object . rest) + `((,k . ,object) . ,(keyword-list->alist rest))))) + +(define (pairwise-foreach-keyword proc . arguments) + "Apply PROC with each keyword argument and corresponding values +in ARGUMENTS. If a value is not present in a argument, pass #f instead." + (let* ((alists (map keyword-list->alist arguments)) + (keywords (delete-duplicates + (apply append (map (cut map car <>) alists)) + eq?))) + (for-each (lambda (keyword) + (apply proc keyword + (map (cut assoc-ref <> keyword) alists))) + keywords))) + +(define* (explain-list-delta old new #:key pairwise/change) + "Try to explain the changes from the list OLD to NEW. + +If passed, the explainer @var{pairwise/change} must accept two +arguments: an entry of @var{old} and @var{new}. It can be called +for each pair of old and new entries. It should return truth if +the change could be explained, and false otherwise. + +Return false if all changes could be explained and truth otherwise." + (let* ((old-vector (list->vector old)) + (new-vector (list->vector new)) + (old-explained? (make-bitvector (vector-length old-vector) #f)) + (new-explained? (make-bitvector (vector-length new-vector) #f))) + (do ((i 0 (and (< (+ i 1) (vector-length old-vector)) + (bitvector-position old-explained? #f (+ 1 i))))) + ((not i)) + (do ((j 0 (and (< (+ j 1) (vector-length new-vector)) + (bitvector-position new-explained? #f (+ 1 j))))) + ((not j)) + (cond ((or (bitvector-bit-set? old-explained? i) + (bitvector-bit-set? new-explained? j))) + ;; If two entries are equal, there is no change. + ;; (Except possibly some reordering, which we currently + ;; do not check for.) + ((equal? (vector-ref old-vector i) + (vector-ref new-vector j)) + (bitvector-set-bit! old-explained? i) + (bitvector-set-bit! new-explained? j)) + ((and pairwise/change + (pairwise/change (vector-ref old-vector i) + (vector-ref new-vector j))) + (bitvector-set-bit! old-explained? i) + (bitvector-set-bit! new-explained? j))))) + (or (bitvector-position old-explained? #f) + (bitvector-position new-explained? #f)))) + (define* (change-commit-message file-name old new #:optional (port (current-output-port))) "Print ChangeLog commit message for changes between OLD and NEW." (define (get-values expr field) @@ -180,6 +236,14 @@ corresponding to the top-level definition containing the staged changes." (() '()) ((first . rest) (map cadadr first)))) + ;; Like get-values, but also allow quote and do not treat + ;; the value of the field as an alist. + (define (get-values/list expr field) + (match ((sxpath `(// ,field ,(node-or (sxpath '(quasiquote)) + (sxpath '(quote))))) expr) + (() '()) + ((first . rest) + (second first)))) (define (listify items) (match items ((one) one) @@ -216,7 +280,35 @@ corresponding to the top-level definition containing the staged changes." (format #f "Remove ~a; add ~a." (listify removed) (listify added))))))))) - '(inputs propagated-inputs native-inputs))) + '(inputs propagated-inputs native-inputs)) + (define (explain-make-flags/change x y) + (match (cons x y) + (("CC=gcc" . ',(string-append "CC=" (cc-for-target))) + (format port + " Use the C cross-compiler, instead of hardcoding \"gcc\".") + #t) + (("CXX=g++" . ',(string-append "CXX=" (cxx-for-target))) + (format port + " Use the C++ cross-compiler, instead of hardcoding \"g++\".") + #t) + (_ #f))) + (define (explain-argument keyword old new) + (unless (equal? old new) + (case keyword + ((#:make-flags) + (format port "[arguments]<#:make-flags>:") + ;; second: skip ' and ` + (if (explain-list-delta (second old) (second new) + #:pairwise/change explain-make-flags/change) + ;; There were some unexplained changes. + (format port " Update.~%") + (format port "~%"))) + ;; There were some unexplained changes. + (else (format port "[arguments]<~a>: Update.~%" keyword))))) + (let ((old-arguments (or (get-values/list old 'arguments) '())) + (new-arguments (or (get-values/list new 'arguments) '()))) + (pairwise-foreach-keyword explain-argument old-arguments + new-arguments))) (define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) "Print ChangeLog commit message for a change to FILE-NAME adding a definition." -- 2.31.1 [-- Attachment #1.3: 0002-etc-Teach-committer.scm-about-checking-tests-in-the-.patch --] [-- Type: text/x-patch, Size: 4208 bytes --] From ae06b43db712697f7080cc8e5f4d3eecd9350211 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 13:32:41 +0200 Subject: [PATCH 2/6] etc: Teach committer.scm about checking tests? in the 'check' phase. * etc/committer.scm.in (has-explicit-argument?): New procedure. (change-commit-message)[explain-argument]<#:phases>: New case, try explaining changes in #:phases. (explain-phases/change): New procedure, explain the patch makes sure 'tests?' is respected in the 'check' phase. --- etc/committer.scm.in | 46 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 75c82c9019..3fa70a81d0 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -229,6 +229,26 @@ Return false if all changes could be explained and truth otherwise." (or (bitvector-position old-explained? #f) (bitvector-position new-explained? #f)))) +(define (has-explicit-argument? argument-to-search-for argument-list) + "Test whether ARGUMENT-TO-SEARCH-FOR occurs in ARGUMENT-LIST." + (let loop ((argument-list argument-list)) + ;; (lambda () exp) + (cond ((null? argument-list) #f) + ;; (lambda (x . rest) exp) + ((pair? argument-list) + (let ((argument-in-list (car argument-list)) + (rest (cdr argument-list))) + (cond ((eq? argument-in-list argument-to-search-for) + #t) + ;; (lambda* (#:key (x . default) . rest) #f) + ((and (pair? argument-in-list) + (eq? (car argument-in-list) argument-to-search-for)) + #t) + (#t (loop rest))))) + ;; (lambda _ exp) + ((symbol? argument-list) #f) + (#t (error "the argument list seems to be incorrect!"))))) + (define* (change-commit-message file-name old new #:optional (port (current-output-port))) "Print ChangeLog commit message for changes between OLD and NEW." (define (get-values expr field) @@ -292,6 +312,21 @@ Return false if all changes could be explained and truth otherwise." " Use the C++ cross-compiler, instead of hardcoding \"g++\".") #t) (_ #f))) + (define (explain-phases/change x y) + (match (cons x y) + ;; "guix build" supports a --without-tests=PACKAGE option, + ;; for building a package without running tests. Also, tests + ;; can often not be run when cross-compiling. The 'check' + ;; phase needs to respect this, though. Maybe this patch is + ;; for ensuring the phase respects this. + ((('replace ''check ((or 'lambda* 'lambda) args/x . exps/x)) + . ('replace ''check ((or 'lambda* 'lambda) args/y . exps/y))) + (when (and (not (has-explicit-argument? 'tests? args/x)) + (has-explicit-argument? 'tests? args/y)) + (format port + "[arguments]<#:phases>{check}: Only run tests when not requested.~%") + #t)) + (_ #f))) (define (explain-argument keyword old new) (unless (equal? old new) (case keyword @@ -303,6 +338,17 @@ Return false if all changes could be explained and truth otherwise." ;; There were some unexplained changes. (format port " Update.~%") (format port "~%"))) + ((#:phases) + ;; For each phase, a separate line will be printed. + (match (cons old new) + ;; _ can be %standard-phases, for example + ((('modify-phases _ . rest/old) . ('modify-phases _ . rest/new)) + (if (explain-list-delta rest/old rest/new + #:pairwise/change explain-phases/change) + ;; There were some unexplained changes. + (format port "[arguments]<#:phases>: Update.~%"))) + ;; There were some unexplained changes. + (_ (format port "[arguments]<#:phases>: Update.~%")))) ;; There were some unexplained changes. (else (format port "[arguments]<~a>: Update.~%" keyword))))) (let ((old-arguments (or (get-values/list old 'arguments) '())) -- 2.31.1 [-- Attachment #1.4: 0003-etc-committer-Only-claim-to-be-updating-a-package-wh.patch --] [-- Type: text/x-patch, Size: 1806 bytes --] From 31c36574e73ba448b0a883f046dbb5021882273e Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 13:56:17 +0200 Subject: [PATCH 3/6] etc: committer: Only claim to be updating a package when it's true. * etc/committer.scm.in (change-commit-message): If the patch does not change the version, do not falsely say the package is updated, and instead output a placeholder to be filled in by the user. --- etc/committer.scm.in | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 3fa70a81d0..8027d9d0f1 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -274,12 +274,17 @@ Return false if all changes could be explained and truth otherwise." ", and " (first (take-right items 1)))))) (define variable-name (second old)) - (define version - (and=> ((sxpath '(// version *any*)) new) + (define (version exp) + (and=> ((sxpath '(// version *any*)) exp) first)) - (format port - "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%" - variable-name version file-name variable-name version) + (define old-version (version old)) + (define new-version (version new)) + (cond ((not (equal? old-version new-version)) + (format port "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%" + variable-name new-version file-name variable-name new-version)) + (#t + (format port "gnu: ~a: <FIXME you need to write something here>~%~%* ~a (~a): FIXME!.~%" + variable-name file-name variable-name))) (for-each (lambda (field) (let ((old-values (get-values old field)) (new-values (get-values new field))) -- 2.31.1 [-- Attachment #1.5: 0004-etc-committer-Automatically-generate-a-first-line-in.patch --] [-- Type: text/x-patch, Size: 6173 bytes --] From 4b158786136693d17517f5474f5cd054639c3cd2 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 15:02:20 +0200 Subject: [PATCH 4/6] etc: committer: Automatically generate a first line in more cases. * etc/committer.scm.in (<patch-summary>, make-patch-summary, patch-summary?) (patch-summary:cc-for-target, patch-summary:cxx-for-target) (set-patch-summary:cc-for-target!, set-patch-summary:cxx-for-target!) (set-patch-summary:respect-tests?!, patch-summary:respect-tests?): Define record type for keeping track of what the current patch is doing. (change-commit-message): Rename to ... (change-commit-message/one-pass): ... this, record information about the current patch in a <patch-summary> record, and use that information for creating the first line of the commit message. (change-commit-message): New procedure, with the same calling convention as the old change-commit-message. (change-commit-message)[explain-make-flags/change]: Populate the patch summary. (change-commit-message)[explain-phases/change]: Likewise. --- etc/committer.scm.in | 50 ++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 48 insertions(+), 2 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 8027d9d0f1..be23367f49 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -249,8 +249,29 @@ Return false if all changes could be explained and truth otherwise." ((symbol? argument-list) #f) (#t (error "the argument list seems to be incorrect!"))))) -(define* (change-commit-message file-name old new #:optional (port (current-output-port))) - "Print ChangeLog commit message for changes between OLD and NEW." +;; A machine-readable summary of changes made, +;; that are required for deciding on the first line +;; of the commit message. +(define-record-type <patch-summary> + (%make-patch-summary cc-for-target cxx-for-target respect-tests?) + patch-summary? + ;; #f | created | corrected + (cc-for-target patch-summary:cc-for-target set-patch-summary:cc-for-target!) + (cxx-for-target patch-summary:cxx-for-target set-patch-summary:cxx-for-target!) + ;; #f | #t + (respect-tests? patch-summary:respect-tests? set-patch-summary:respect-tests?!)) + +(define (make-patch-summary) + (%make-patch-summary #f #f #f)) + +(define* (change-commit-message/one-pass + file-name old new summary + #:optional (port (current-output-port))) + "Print ChangeLog commit message for changes between OLD and NEW. +Record information for deciding on the first line in SUMMARY. +As the information is only recorded after the first line has been written +to PORT, you should probably run this procedure twice, but with the same +SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (define (get-values expr field) (match ((sxpath `(// ,field quasiquote *)) expr) (() '()) @@ -282,6 +303,19 @@ Return false if all changes could be explained and truth otherwise." (cond ((not (equal? old-version new-version)) (format port "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%" variable-name new-version file-name variable-name new-version)) + ((and (patch-summary:cc-for-target summary) + (patch-summary:cxx-for-target summary)) + (format port "gnu: ~a: Use 'cc-for-target' and friends.~%~%* ~a (~a)~%" + variable-name file-name variable-name)) + ((patch-summary:cc-for-target summary) + (format port "gnu: ~a: Use the C cross-compiler.~%~%* ~a (~a)~%" + variable-name file-name variable-name)) + ((patch-summary:cxx-for-target summary) + (format port "gnu: ~a: Use the C cross-compiler.~%~%* ~a (~a)~%" + variable-name file-name variable-name)) + ((patch-summary:respect-tests? summary) + (format port "gnu: ~a: Only run tests when requested.~%~% ~a (~a)~%" + variable-name file-name variable-name)) (#t (format port "gnu: ~a: <FIXME you need to write something here>~%~%* ~a (~a): FIXME!.~%" variable-name file-name variable-name))) @@ -309,10 +343,12 @@ Return false if all changes could be explained and truth otherwise." (define (explain-make-flags/change x y) (match (cons x y) (("CC=gcc" . ',(string-append "CC=" (cc-for-target))) + (set-patch-summary:cc-for-target! summary 'changed) (format port " Use the C cross-compiler, instead of hardcoding \"gcc\".") #t) (("CXX=g++" . ',(string-append "CXX=" (cxx-for-target))) + (set-patch-summary:cxx-for-target! summary 'changed) (format port " Use the C++ cross-compiler, instead of hardcoding \"g++\".") #t) @@ -328,6 +364,7 @@ Return false if all changes could be explained and truth otherwise." . ('replace ''check ((or 'lambda* 'lambda) args/y . exps/y))) (when (and (not (has-explicit-argument? 'tests? args/x)) (has-explicit-argument? 'tests? args/y)) + (set-patch-summary:respect-tests?! summary #t) (format port "[arguments]<#:phases>{check}: Only run tests when not requested.~%") #t)) @@ -361,6 +398,15 @@ Return false if all changes could be explained and truth otherwise." (pairwise-foreach-keyword explain-argument old-arguments new-arguments))) +(define* (change-commit-message file-name old new + #:optional (port (current-output-port))) + "Like change-commit-message/one-pass, but without requiring to be run twice +for a correct header." + (let ((summary (make-patch-summary))) + (change-commit-message/one-pass file-name old new summary + (%make-void-port "w")) + (change-commit-message/one-pass file-name old new summary port))) + (define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) "Print ChangeLog commit message for a change to FILE-NAME adding a definition." (format port -- 2.31.1 [-- Attachment #1.6: 0005-etc-committer-Support-list-exp-.-in-make-flags.patch --] [-- Type: text/x-patch, Size: 1728 bytes --] From 061175155983d73f1488f2cf22d6d52bd5ed3054 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 15:32:08 +0200 Subject: [PATCH 5/6] etc: committer: Support (list exp ...) in #:make-flags. * etc/committer.scm.in (unwrap-list): New procedure, supporting 'quasiquote', 'quote' and 'list'. (change-commit-message/one-pass)[unwrap-list]: Use new procedure. --- etc/committer.scm.in | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index be23367f49..fc3c929f17 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -264,6 +264,15 @@ Return false if all changes could be explained and truth otherwise." (define (make-patch-summary) (%make-patch-summary #f #f #f)) +;; '(x ...) -> (x ...) +;; `(x ...) -> (x ...) +;; (list x ...) -> (x ...) +(define (unwrap-list list) + (case (car list) + ((quasiquote quote) (second list)) + ((list) (cdr list)) + (else (error "I can't interpret that as a list!")))) + (define* (change-commit-message/one-pass file-name old new summary #:optional (port (current-output-port))) @@ -374,8 +383,7 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (case keyword ((#:make-flags) (format port "[arguments]<#:make-flags>:") - ;; second: skip ' and ` - (if (explain-list-delta (second old) (second new) + (if (explain-list-delta (unwrap-list old) (unwrap-list new) #:pairwise/change explain-make-flags/change) ;; There were some unexplained changes. (format port " Update.~%") -- 2.31.1 [-- Attachment #1.7: 0006-etc-committer-Explain-changes-in-configure-flags.patch --] [-- Type: text/x-patch, Size: 1455 bytes --] From 295cca1e1745acfea49b54681d566dd3d0c1dd19 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 15:45:02 +0200 Subject: [PATCH 6/6] etc: committer: Explain changes in #:configure-flags. * etc/committer.scm.in (change-commit-message/one-pass)[explain-argument]: Handle #:configure-flags the same way as #:make-flags for now. --- etc/committer.scm.in | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index fc3c929f17..0fd383533d 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -381,8 +381,12 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (define (explain-argument keyword old new) (unless (equal? old new) (case keyword - ((#:make-flags) - (format port "[arguments]<#:make-flags>:") + ;; Sometimes, arguments like "CC=TARGET-gcc" are passed to the + ;; configure script. Their interpretation is sometimes the same + ;; as in makefiles. Hence, for now we unify the handling of + ;; #:make-flags and #:configure-flags. + ((#:make-flags #:configure-flags) + (format port "[arguments]<~a>:" keyword) (if (explain-list-delta (unwrap-list old) (unwrap-list new) #:pairwise/change explain-make-flags/change) ;; There were some unexplained changes. -- 2.31.1 [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply related [flat|nested] 9+ messages in thread
* [bug#48120] [PATCH] Teach etc/committer.scm.in some stuff 2021-04-30 14:36 [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff Maxime Devos @ 2021-05-06 7:50 ` Maxime Devos 2021-05-09 18:34 ` Xinglu Chen 2022-05-22 3:33 ` [bug#48120] [PATCH]: " Maxim Cournoyer 2021-06-17 13:36 ` [bug#48120] [PATCH] etc: committer: Read #~, #$ and #+ correctly Maxime Devos ` (2 subsequent siblings) 3 siblings, 2 replies; 9+ messages in thread From: Maxime Devos @ 2021-05-06 7:50 UTC (permalink / raw) To: 48120 [-- Attachment #1.1: Type: text/plain, Size: 242 bytes --] New patch series, handling more edge cases. It needs some changes in how it wraps lines now there is a break-string procedure, but I don't have time to work on this currently so I'll just submit it as-is for now. Greetings, Maxime. [-- Attachment #1.2: 0001-etc-Teach-committer.scm-about-CC-gcc-cc-for-target-a.patch --] [-- Type: text/x-patch, Size: 6976 bytes --] From 96d726cc163255eae16f761bdaf918733155cbc6 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 11:21:03 +0200 Subject: [PATCH 01/11] etc: Teach committer.scm about CC=gcc -> cc-for-target and friends. * etc/committer.scm.in (keyword-list->alist): New procedure. (pairwise-foreach-keyword): Likewise. (explain-list-delta): New procedure, for explaining a delta between two lists. (change-commit-message)[get-values/list]: New procedure. (change-commit-message)[explain-make-flags/change]: New procedure, currently explaining a transition from "CC=gcc" to "CC=" (cc-for-target) in the make flags. (change-commit-message)[explain-argument]: New procedure for explaining a difference in the 'arguments' field. Currently only #:make-flags is supported, using the previous procedure. --- etc/committer.scm.in | 94 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 93 insertions(+), 1 deletion(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 96cd1fbf0b..c2f27ef8c8 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -4,6 +4,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,7 +37,8 @@ (ice-9 popen) (ice-9 match) (ice-9 rdelim) - (ice-9 textual-ports)) + (ice-9 textual-ports) + (rnrs control)) (define* (break-string str #:optional (max-line-length 70)) "Break the string STR into lines that are no longer than MAX-LINE-LENGTH. @@ -200,6 +202,60 @@ corresponding to the top-level definition containing the staged changes." (+ (lines-to-first-change hunk) (hunk-new-line-number hunk)))))) +(define (keyword-list->alist kwlist) + (match kwlist + (() '()) + (((? keyword? k) object . rest) + `((,k . ,object) . ,(keyword-list->alist rest))))) + +(define (pairwise-foreach-keyword proc . arguments) + "Apply PROC with each keyword argument and corresponding values +in ARGUMENTS. If a value is not present in a argument, pass #f instead." + (let* ((alists (map keyword-list->alist arguments)) + (keywords (delete-duplicates + (apply append (map (cut map car <>) alists)) + eq?))) + (for-each (lambda (keyword) + (apply proc keyword + (map (cut assoc-ref <> keyword) alists))) + keywords))) + +(define* (explain-list-delta old new #:key pairwise/change) + "Try to explain the changes from the list OLD to NEW. + +If passed, the explainer @var{pairwise/change} must accept two +arguments: an entry of @var{old} and @var{new}. It can be called +for each pair of old and new entries. It should return truth if +the change could be explained, and false otherwise. + +Return false if all changes could be explained and truth otherwise." + (let* ((old-vector (list->vector old)) + (new-vector (list->vector new)) + (old-explained? (make-bitvector (vector-length old-vector) #f)) + (new-explained? (make-bitvector (vector-length new-vector) #f))) + (do ((i 0 (and (< (+ i 1) (vector-length old-vector)) + (bitvector-position old-explained? #f (+ 1 i))))) + ((not i)) + (do ((j 0 (and (< (+ j 1) (vector-length new-vector)) + (bitvector-position new-explained? #f (+ 1 j))))) + ((not j)) + (cond ((or (bitvector-bit-set? old-explained? i) + (bitvector-bit-set? new-explained? j))) + ;; If two entries are equal, there is no change. + ;; (Except possibly some reordering, which we currently + ;; do not check for.) + ((equal? (vector-ref old-vector i) + (vector-ref new-vector j)) + (bitvector-set-bit! old-explained? i) + (bitvector-set-bit! new-explained? j)) + ((and pairwise/change + (pairwise/change (vector-ref old-vector i) + (vector-ref new-vector j))) + (bitvector-set-bit! old-explained? i) + (bitvector-set-bit! new-explained? j))))) + (or (bitvector-position old-explained? #f) + (bitvector-position new-explained? #f)))) + (define* (change-commit-message file-name old new #:optional (port (current-output-port))) "Print ChangeLog commit message for changes between OLD and NEW." (define (get-values expr field) @@ -207,6 +263,14 @@ corresponding to the top-level definition containing the staged changes." (() '()) ((first . rest) (map cadadr first)))) + ;; Like get-values, but also allow quote and do not treat + ;; the value of the field as an alist. + (define (get-values/list expr field) + (match ((sxpath `(// ,field ,(node-or (sxpath '(quasiquote)) + (sxpath '(quote))))) expr) + (() '()) + ((first . rest) + (second first)))) (define (listify items) (match items ((one) one) @@ -245,6 +309,34 @@ corresponding to the top-level definition containing the staged changes." (listify removed) (listify added)))))))))) '(inputs propagated-inputs native-inputs))) + (define (explain-make-flags/change x y) + (match (cons x y) + (("CC=gcc" . ',(string-append "CC=" (cc-for-target))) + (format port + " Use the C cross-compiler, instead of hardcoding \"gcc\".") + #t) + (("CXX=g++" . ',(string-append "CXX=" (cxx-for-target))) + (format port + " Use the C++ cross-compiler, instead of hardcoding \"g++\".") + #t) + (_ #f))) + (define (explain-argument keyword old new) + (unless (equal? old new) + (case keyword + ((#:make-flags) + (format port "[arguments]<#:make-flags>:") + ;; second: skip ' and ` + (if (explain-list-delta (second old) (second new) + #:pairwise/change explain-make-flags/change) + ;; There were some unexplained changes. + (format port " Update.~%") + (format port "~%"))) + ;; There were some unexplained changes. + (else (format port "[arguments]<~a>: Update.~%" keyword))))) + (let ((old-arguments (or (get-values/list old 'arguments) '())) + (new-arguments (or (get-values/list new 'arguments) '()))) + (pairwise-foreach-keyword explain-argument old-arguments + new-arguments))) (define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) "Print ChangeLog commit message for a change to FILE-NAME adding a definition." -- 2.31.1 [-- Attachment #1.3: 0002-etc-Teach-committer.scm-about-checking-tests-in-the-.patch --] [-- Type: text/x-patch, Size: 4210 bytes --] From 894dde9febbecaedd1a9596ff66653f9c9249ef4 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 13:32:41 +0200 Subject: [PATCH 02/11] etc: Teach committer.scm about checking tests? in the 'check' phase. * etc/committer.scm.in (has-explicit-argument?): New procedure. (change-commit-message)[explain-argument]<#:phases>: New case, try explaining changes in #:phases. (explain-phases/change): New procedure, explain the patch makes sure 'tests?' is respected in the 'check' phase. --- etc/committer.scm.in | 46 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index c2f27ef8c8..1f25c424dd 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -256,6 +256,26 @@ Return false if all changes could be explained and truth otherwise." (or (bitvector-position old-explained? #f) (bitvector-position new-explained? #f)))) +(define (has-explicit-argument? argument-to-search-for argument-list) + "Test whether ARGUMENT-TO-SEARCH-FOR occurs in ARGUMENT-LIST." + (let loop ((argument-list argument-list)) + ;; (lambda () exp) + (cond ((null? argument-list) #f) + ;; (lambda (x . rest) exp) + ((pair? argument-list) + (let ((argument-in-list (car argument-list)) + (rest (cdr argument-list))) + (cond ((eq? argument-in-list argument-to-search-for) + #t) + ;; (lambda* (#:key (x . default) . rest) #f) + ((and (pair? argument-in-list) + (eq? (car argument-in-list) argument-to-search-for)) + #t) + (#t (loop rest))))) + ;; (lambda _ exp) + ((symbol? argument-list) #f) + (#t (error "the argument list seems to be incorrect!"))))) + (define* (change-commit-message file-name old new #:optional (port (current-output-port))) "Print ChangeLog commit message for changes between OLD and NEW." (define (get-values expr field) @@ -320,6 +340,21 @@ Return false if all changes could be explained and truth otherwise." " Use the C++ cross-compiler, instead of hardcoding \"g++\".") #t) (_ #f))) + (define (explain-phases/change x y) + (match (cons x y) + ;; "guix build" supports a --without-tests=PACKAGE option, + ;; for building a package without running tests. Also, tests + ;; can often not be run when cross-compiling. The 'check' + ;; phase needs to respect this, though. Maybe this patch is + ;; for ensuring the phase respects this. + ((('replace ''check ((or 'lambda* 'lambda) args/x . exps/x)) + . ('replace ''check ((or 'lambda* 'lambda) args/y . exps/y))) + (when (and (not (has-explicit-argument? 'tests? args/x)) + (has-explicit-argument? 'tests? args/y)) + (format port + "[arguments]<#:phases>{check}: Only run tests when not requested.~%") + #t)) + (_ #f))) (define (explain-argument keyword old new) (unless (equal? old new) (case keyword @@ -331,6 +366,17 @@ Return false if all changes could be explained and truth otherwise." ;; There were some unexplained changes. (format port " Update.~%") (format port "~%"))) + ((#:phases) + ;; For each phase, a separate line will be printed. + (match (cons old new) + ;; _ can be %standard-phases, for example + ((('modify-phases _ . rest/old) . ('modify-phases _ . rest/new)) + (if (explain-list-delta rest/old rest/new + #:pairwise/change explain-phases/change) + ;; There were some unexplained changes. + (format port "[arguments]<#:phases>: Update.~%"))) + ;; There were some unexplained changes. + (_ (format port "[arguments]<#:phases>: Update.~%")))) ;; There were some unexplained changes. (else (format port "[arguments]<~a>: Update.~%" keyword))))) (let ((old-arguments (or (get-values/list old 'arguments) '())) -- 2.31.1 [-- Attachment #1.4: 0003-etc-committer-Only-claim-to-be-updating-a-package-wh.patch --] [-- Type: text/x-patch, Size: 1808 bytes --] From d190b8088908518e51ac3e2b2bfa92747a506aba Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 13:56:17 +0200 Subject: [PATCH 03/11] etc: committer: Only claim to be updating a package when it's true. * etc/committer.scm.in (change-commit-message): If the patch does not change the version, do not falsely say the package is updated, and instead output a placeholder to be filled in by the user. --- etc/committer.scm.in | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 1f25c424dd..02f7817bde 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -301,12 +301,17 @@ Return false if all changes could be explained and truth otherwise." ", and " (first (take-right items 1)))))) (define variable-name (second old)) - (define version - (and=> ((sxpath '(// version *any*)) new) + (define (version exp) + (and=> ((sxpath '(// version *any*)) exp) first)) - (format port - "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%" - variable-name version file-name variable-name version) + (define old-version (version old)) + (define new-version (version new)) + (cond ((not (equal? old-version new-version)) + (format port "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%" + variable-name new-version file-name variable-name new-version)) + (#t + (format port "gnu: ~a: <FIXME you need to write something here>~%~%* ~a (~a): FIXME!.~%" + variable-name file-name variable-name))) (for-each (lambda (field) (let ((old-values (get-values old field)) (new-values (get-values new field))) -- 2.31.1 [-- Attachment #1.5: 0004-etc-committer-Automatically-generate-a-first-line-in.patch --] [-- Type: text/x-patch, Size: 6175 bytes --] From 7d4563a271fda000dca2845b068658b467c7e91d Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 15:02:20 +0200 Subject: [PATCH 04/11] etc: committer: Automatically generate a first line in more cases. * etc/committer.scm.in (<patch-summary>, make-patch-summary, patch-summary?) (patch-summary:cc-for-target, patch-summary:cxx-for-target) (set-patch-summary:cc-for-target!, set-patch-summary:cxx-for-target!) (set-patch-summary:respect-tests?!, patch-summary:respect-tests?): Define record type for keeping track of what the current patch is doing. (change-commit-message): Rename to ... (change-commit-message/one-pass): ... this, record information about the current patch in a <patch-summary> record, and use that information for creating the first line of the commit message. (change-commit-message): New procedure, with the same calling convention as the old change-commit-message. (change-commit-message)[explain-make-flags/change]: Populate the patch summary. (change-commit-message)[explain-phases/change]: Likewise. --- etc/committer.scm.in | 50 ++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 48 insertions(+), 2 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 02f7817bde..231f27fe4e 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -276,8 +276,29 @@ Return false if all changes could be explained and truth otherwise." ((symbol? argument-list) #f) (#t (error "the argument list seems to be incorrect!"))))) -(define* (change-commit-message file-name old new #:optional (port (current-output-port))) - "Print ChangeLog commit message for changes between OLD and NEW." +;; A machine-readable summary of changes made, +;; that are required for deciding on the first line +;; of the commit message. +(define-record-type <patch-summary> + (%make-patch-summary cc-for-target cxx-for-target respect-tests?) + patch-summary? + ;; #f | created | corrected + (cc-for-target patch-summary:cc-for-target set-patch-summary:cc-for-target!) + (cxx-for-target patch-summary:cxx-for-target set-patch-summary:cxx-for-target!) + ;; #f | #t + (respect-tests? patch-summary:respect-tests? set-patch-summary:respect-tests?!)) + +(define (make-patch-summary) + (%make-patch-summary #f #f #f)) + +(define* (change-commit-message/one-pass + file-name old new summary + #:optional (port (current-output-port))) + "Print ChangeLog commit message for changes between OLD and NEW. +Record information for deciding on the first line in SUMMARY. +As the information is only recorded after the first line has been written +to PORT, you should probably run this procedure twice, but with the same +SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (define (get-values expr field) (match ((sxpath `(// ,field quasiquote *)) expr) (() '()) @@ -309,6 +330,19 @@ Return false if all changes could be explained and truth otherwise." (cond ((not (equal? old-version new-version)) (format port "gnu: ~a: Update to ~a.~%~%* ~a (~a): Update to ~a.~%" variable-name new-version file-name variable-name new-version)) + ((and (patch-summary:cc-for-target summary) + (patch-summary:cxx-for-target summary)) + (format port "gnu: ~a: Use 'cc-for-target' and friends.~%~%* ~a (~a)~%" + variable-name file-name variable-name)) + ((patch-summary:cc-for-target summary) + (format port "gnu: ~a: Use the C cross-compiler.~%~%* ~a (~a)~%" + variable-name file-name variable-name)) + ((patch-summary:cxx-for-target summary) + (format port "gnu: ~a: Use the C cross-compiler.~%~%* ~a (~a)~%" + variable-name file-name variable-name)) + ((patch-summary:respect-tests? summary) + (format port "gnu: ~a: Only run tests when requested.~%~% ~a (~a)~%" + variable-name file-name variable-name)) (#t (format port "gnu: ~a: <FIXME you need to write something here>~%~%* ~a (~a): FIXME!.~%" variable-name file-name variable-name))) @@ -337,10 +371,12 @@ Return false if all changes could be explained and truth otherwise." (define (explain-make-flags/change x y) (match (cons x y) (("CC=gcc" . ',(string-append "CC=" (cc-for-target))) + (set-patch-summary:cc-for-target! summary 'changed) (format port " Use the C cross-compiler, instead of hardcoding \"gcc\".") #t) (("CXX=g++" . ',(string-append "CXX=" (cxx-for-target))) + (set-patch-summary:cxx-for-target! summary 'changed) (format port " Use the C++ cross-compiler, instead of hardcoding \"g++\".") #t) @@ -356,6 +392,7 @@ Return false if all changes could be explained and truth otherwise." . ('replace ''check ((or 'lambda* 'lambda) args/y . exps/y))) (when (and (not (has-explicit-argument? 'tests? args/x)) (has-explicit-argument? 'tests? args/y)) + (set-patch-summary:respect-tests?! summary #t) (format port "[arguments]<#:phases>{check}: Only run tests when not requested.~%") #t)) @@ -389,6 +426,15 @@ Return false if all changes could be explained and truth otherwise." (pairwise-foreach-keyword explain-argument old-arguments new-arguments))) +(define* (change-commit-message file-name old new + #:optional (port (current-output-port))) + "Like change-commit-message/one-pass, but without requiring to be run twice +for a correct header." + (let ((summary (make-patch-summary))) + (change-commit-message/one-pass file-name old new summary + (%make-void-port "w")) + (change-commit-message/one-pass file-name old new summary port))) + (define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) "Print ChangeLog commit message for a change to FILE-NAME adding a definition." (format port -- 2.31.1 [-- Attachment #1.6: 0005-etc-committer-Support-list-exp-.-in-make-flags.patch --] [-- Type: text/x-patch, Size: 1730 bytes --] From 1b8a1599c84f25bdca866fc4dc1a7f2217901c4f Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 15:32:08 +0200 Subject: [PATCH 05/11] etc: committer: Support (list exp ...) in #:make-flags. * etc/committer.scm.in (unwrap-list): New procedure, supporting 'quasiquote', 'quote' and 'list'. (change-commit-message/one-pass)[unwrap-list]: Use new procedure. --- etc/committer.scm.in | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 231f27fe4e..1f8f06b9f1 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -291,6 +291,15 @@ Return false if all changes could be explained and truth otherwise." (define (make-patch-summary) (%make-patch-summary #f #f #f)) +;; '(x ...) -> (x ...) +;; `(x ...) -> (x ...) +;; (list x ...) -> (x ...) +(define (unwrap-list list) + (case (car list) + ((quasiquote quote) (second list)) + ((list) (cdr list)) + (else (error "I can't interpret that as a list!")))) + (define* (change-commit-message/one-pass file-name old new summary #:optional (port (current-output-port))) @@ -402,8 +411,7 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (case keyword ((#:make-flags) (format port "[arguments]<#:make-flags>:") - ;; second: skip ' and ` - (if (explain-list-delta (second old) (second new) + (if (explain-list-delta (unwrap-list old) (unwrap-list new) #:pairwise/change explain-make-flags/change) ;; There were some unexplained changes. (format port " Update.~%") -- 2.31.1 [-- Attachment #1.7: 0006-etc-committer-Explain-changes-in-configure-flags.patch --] [-- Type: text/x-patch, Size: 1457 bytes --] From f55d1a148426fda3c1cbb16f93e36ef14a3be099 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 15:45:02 +0200 Subject: [PATCH 06/11] etc: committer: Explain changes in #:configure-flags. * etc/committer.scm.in (change-commit-message/one-pass)[explain-argument]: Handle #:configure-flags the same way as #:make-flags for now. --- etc/committer.scm.in | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 1f8f06b9f1..3c35074141 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -409,8 +409,12 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (define (explain-argument keyword old new) (unless (equal? old new) (case keyword - ((#:make-flags) - (format port "[arguments]<#:make-flags>:") + ;; Sometimes, arguments like "CC=TARGET-gcc" are passed to the + ;; configure script. Their interpretation is sometimes the same + ;; as in makefiles. Hence, for now we unify the handling of + ;; #:make-flags and #:configure-flags. + ((#:make-flags #:configure-flags) + (format port "[arguments]<~a>:" keyword) (if (explain-list-delta (unwrap-list old) (unwrap-list new) #:pairwise/change explain-make-flags/change) ;; There were some unexplained changes. -- 2.31.1 [-- Attachment #1.8: 0007-etc-committer-Read-correctly.patch --] [-- Type: text/x-patch, Size: 813 bytes --] From c6fd832887b271378b1cfc1909f233693ea70cb4 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 22:53:12 +0200 Subject: [PATCH 07/11] etc: committer: Read #~, #$, #+ correctly. * etc/committer.scm.in: Import (guix gexp). --- etc/committer.scm.in | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 3c35074141..f03f0daf2b 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -38,7 +38,8 @@ (ice-9 match) (ice-9 rdelim) (ice-9 textual-ports) - (rnrs control)) + (rnrs control) + (guix gexp)) (define* (break-string str #:optional (max-line-length 70)) "Break the string STR into lines that are no longer than MAX-LINE-LENGTH. -- 2.31.1 [-- Attachment #1.9: 0008-etc-committer-Perform-line-wrapping.patch --] [-- Type: text/x-patch, Size: 2295 bytes --] From e77fc1c06876bc65e0782af3bd1ebdbef4bc1ea3 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 22:55:41 +0200 Subject: [PATCH 08/11] etc: committer: Perform line-wrapping. * etc/committer.scm.in (change-commit-message): Perform line wrapping. --- etc/committer.scm.in | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index f03f0daf2b..de8f954f4e 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -39,7 +39,9 @@ (ice-9 rdelim) (ice-9 textual-ports) (rnrs control) - (guix gexp)) + (guix gexp) + (texinfo) + (texinfo plain-text)) (define* (break-string str #:optional (max-line-length 70)) "Break the string STR into lines that are no longer than MAX-LINE-LENGTH. @@ -442,11 +444,23 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (define* (change-commit-message file-name old new #:optional (port (current-output-port))) "Like change-commit-message/one-pass, but without requiring to be run twice -for a correct header." +for a correct header. Also perform line wrapping." (let ((summary (make-patch-summary))) (change-commit-message/one-pass file-name old new summary (%make-void-port "w")) - (change-commit-message/one-pass file-name old new summary port))) + (let* ((unwrapped-message + (call-with-output-string + (lambda (port) + (change-commit-message/one-pass + file-name old new summary port)))) + ;; Hack: use (texinfo) and (texinfo plain-text) for + ;; line wraping. Suggested by rekado on #guix. + (raw-message/stexi (texi-fragment->stexi unwrapped-message)) + (wrapped-message + (with-fluid* *line-width* 70 + (lambda () + (stexi->plain-text raw-message/stexi))))) + (put-string port wrapped-message)))) (define* (add-commit-message file-name variable-name #:optional (port (current-output-port))) "Print ChangeLog commit message for a change to FILE-NAME adding a definition." -- 2.31.1 [-- Attachment #1.10: 0009-etc-committer-Don-t-crash-if-no-keyword-list-is-dete.patch --] [-- Type: text/x-patch, Size: 1549 bytes --] From 0861ab498d87ce1314221fef3c304ab9f1a73ab0 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 22:57:07 +0200 Subject: [PATCH 09/11] etc: committer: Don't crash if no keyword list is detected. This is required for some packages that use quasiquote and unquote-splicing in #:configure-flags. * etc/committer.scm.in (keyword-list->alist): Don't crash if no keyword list structure could be detected, instead produce a warning. --- etc/committer.scm.in | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index de8f954f4e..7fbeb1874e 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -41,7 +41,9 @@ (rnrs control) (guix gexp) (texinfo) - (texinfo plain-text)) + (texinfo plain-text) + (guix diagnostics) + (guix i18n)) (define* (break-string str #:optional (max-line-length 70)) "Break the string STR into lines that are no longer than MAX-LINE-LENGTH. @@ -209,7 +211,9 @@ corresponding to the top-level definition containing the staged changes." (match kwlist (() '()) (((? keyword? k) object . rest) - `((,k . ,object) . ,(keyword-list->alist rest))))) + `((,k . ,object) . ,(keyword-list->alist rest))) + (_ (warning (G_ "cannot interpret as keyword argument list: ‘~a’~%") '()) + '()))) (define (pairwise-foreach-keyword proc . arguments) "Apply PROC with each keyword argument and corresponding values -- 2.31.1 [-- Attachment #1.11: 0010-etc-committer-Ignore-let-bindings.patch --] [-- Type: text/x-patch, Size: 1576 bytes --] From a63e09363549b16ba22d14b41812a008ecbe4127 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 22:59:07 +0200 Subject: [PATCH 10/11] etc: committer: Ignore let bindings. Hopefully they aren't important in practice, for deciding on the commit message! * etc/committer.scm.in (change-commit-message/one-pass)[explain-make-flags/change]: Ignore 'let' and 'let*' bindings, only use the last expression. (unwrap-list)[unwrap-list]: Ignore 'let' and 'let*' bindings, only use the expression that is inside. --- etc/committer.scm.in | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 7fbeb1874e..c056de912c 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -305,6 +305,8 @@ Return false if all changes could be explained and truth otherwise." (case (car list) ((quasiquote quote) (second list)) ((list) (cdr list)) + ;; Hopefully the bindings weren't important ... + ((let let*) (last list)) (else (error "I can't interpret that as a list!")))) (define* (change-commit-message/one-pass @@ -396,6 +398,8 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (format port " Use the C++ cross-compiler, instead of hardcoding \"g++\".") #t) + ((((or 'let 'let*) _ exp) . _) (explain-make-flags/change exp y)) + ((_ . ((or 'let 'let*) _ exp)) (explain-make-flags/change x exp)) (_ #f))) (define (explain-phases/change x y) (match (cons x y) -- 2.31.1 [-- Attachment #1.12: 0011-etc-committer-Handle-substitute-keyword-arguments.patch --] [-- Type: text/x-patch, Size: 5037 bytes --] From 5f0313c01121a0a1e7f39f447425b5a8b70fb8c0 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Sat, 1 May 2021 12:19:05 +0200 Subject: [PATCH 11/11] etc: committer: Handle substitute-keyword-arguments. * etc/committer.scm.in (keyword-list->alist): Rename to ... (keyword-list->alist/list): ..., and document the input format. While we're at it, correct the arguments to 'warning'. (keyword-list->alist/possibly-quoted): New procedure, removing 'quote', 'quasiquote' and supporting 'substitute-keyword-arguments'. (pairwise-foreach-keyword): Use new procedure. (unwrap-list): Also remove 'quote' and 'quasiquote' when in a 'let', 'let*' form. Does not strictly belong in this commit, but it was required for my test case. (change-commit-message/one-pass)[get-values/list]: Remove ... (change-commit-message/one-pass)[get-values/no-unquote]: ... and replace with this. (change-commit-message/one-pass): Use new procedure get-values/no-unquote instead of get-values/list. --- etc/committer.scm.in | 41 ++++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index c056de912c..7c63e38e8a 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -207,18 +207,34 @@ corresponding to the top-level definition containing the staged changes." (+ (lines-to-first-change hunk) (hunk-new-line-number hunk)))))) -(define (keyword-list->alist kwlist) +;; Input: a list of keywords and the corresponding values, +;; without an exterior quote, quasiquote or list. +(define (keyword-list->alist/list kwlist) (match kwlist (() '()) (((? keyword? k) object . rest) `((,k . ,object) . ,(keyword-list->alist rest))) - (_ (warning (G_ "cannot interpret as keyword argument list: ‘~a’~%") '()) + (_ (warning (G_ "cannot interpret as keyword argument list: ‘~a’~%") kwlist) + '()))) + +;; Input: an expression representing a list of keywords and the corresponding +;; values, including any exterior quote, quasiquote or list. +(define (keyword-list->alist/possibly-quoted list-sexp) + (match list-sexp + (((or 'quote 'quasiquote) l) + (keyword-list->alist/list l)) + ((substitute-keyword-arguments _ (((? keyword? k) _) l) ...) + (map (lambda (key value) + (cons key (unwrap-list value))) + k l)) + (_ (warning (G_ "cannot interpret as keyword argument list: ‘~a’~%") + list-sexp) '()))) (define (pairwise-foreach-keyword proc . arguments) "Apply PROC with each keyword argument and corresponding values in ARGUMENTS. If a value is not present in a argument, pass #f instead." - (let* ((alists (map keyword-list->alist arguments)) + (let* ((alists (map keyword-list->alist/possibly-quoted arguments)) (keywords (delete-duplicates (apply append (map (cut map car <>) alists)) eq?))) @@ -301,12 +317,13 @@ Return false if all changes could be explained and truth otherwise." ;; '(x ...) -> (x ...) ;; `(x ...) -> (x ...) ;; (list x ...) -> (x ...) +;; and remove let and let* bindings (define (unwrap-list list) (case (car list) ((quasiquote quote) (second list)) ((list) (cdr list)) ;; Hopefully the bindings weren't important ... - ((let let*) (last list)) + ((let let*) (unwrap-list (last list))) (else (error "I can't interpret that as a list!")))) (define* (change-commit-message/one-pass @@ -322,14 +339,12 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (() '()) ((first . rest) (map cadadr first)))) - ;; Like get-values, but also allow quote and do not treat - ;; the value of the field as an alist. - (define (get-values/list expr field) - (match ((sxpath `(// ,field ,(node-or (sxpath '(quasiquote)) - (sxpath '(quote))))) expr) + ;; Like get-values, but do not remove the exterior quasiquote + ;; or quote. + (define (get-values/no-unquote expr field) + (match ((sxpath `(// ,field *)) expr) (() '()) - ((first . rest) - (second first)))) + ((first . rest) first))) (define (listify items) (match items ((one) one) @@ -444,8 +459,8 @@ SUMMARY: first using a ‘void port’, then with the ‘real’ output port." (_ (format port "[arguments]<#:phases>: Update.~%")))) ;; There were some unexplained changes. (else (format port "[arguments]<~a>: Update.~%" keyword))))) - (let ((old-arguments (or (get-values/list old 'arguments) '())) - (new-arguments (or (get-values/list new 'arguments) '()))) + (let ((old-arguments (get-values/no-unquote old 'arguments)) + (new-arguments (get-values/no-unquote new 'arguments))) (pairwise-foreach-keyword explain-argument old-arguments new-arguments))) -- 2.31.1 [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply related [flat|nested] 9+ messages in thread
* [bug#48120] [PATCH] Teach etc/committer.scm.in some stuff 2021-05-06 7:50 ` [bug#48120] [PATCH] " Maxime Devos @ 2021-05-09 18:34 ` Xinglu Chen 2022-05-22 3:33 ` [bug#48120] [PATCH]: " Maxim Cournoyer 1 sibling, 0 replies; 9+ messages in thread From: Xinglu Chen @ 2021-05-09 18:34 UTC (permalink / raw) To: Maxime Devos, 48120 On Thu, May 06 2021, Maxime Devos wrote: > New patch series, handling more edge cases. > > It needs some changes in how it wraps lines now there > is a break-string procedure, but I don't have time to > work on this currently so I'll just submit it as-is for now. I don’t think I am qualified to review all of this, but it seems to work after I made some minor fixes. I just used ‘cc-for-target’ instead of hardcoding ‘gcc’ on a random package, this is what I got. --8<---------------cut here---------------start------------->8--- gnu: eigensoft: Use the C cross-compiler. * gnu/packages/bioinformatics.scm (eigensoft) [arguments]<#:make-flags>: Use the C cross-compiler, instead of hardcoding "gcc". --8<---------------cut here---------------end--------------->8--- > +(define (keyword-list->alist kwlist) > + (match kwlist > + (() '()) > + (((? keyword? k) object . rest) > + `((,k . ,object) . ,(keyword-list->alist rest))))) > + > +(define (pairwise-foreach-keyword proc . arguments) > + "Apply PROC with each keyword argument and corresponding values > +in ARGUMENTS. If a value is not present in a argument, pass #f instead." > + (let* ((alists (map keyword-list->alist arguments)) > + (keywords (delete-duplicates > + (apply append (map (cut map car <>) alists)) ‘append-map’ instead of (apply append (map ...) ...) ? > + eq?))) > + (for-each (lambda (keyword) > + (apply proc keyword > + (map (cut assoc-ref <> keyword) alists))) > + keywords))) > + > > [...] > > @@ -207,6 +263,14 @@ corresponding to the top-level definition containing the staged changes." > (() '()) > ((first . rest) > (map cadadr first)))) > + ;; Like get-values, but also allow quote and do not treat > + ;; the value of the field as an alist. > + (define (get-values/list expr field) > + (match ((sxpath `(// ,field ,(node-or (sxpath '(quasiquote)) > + (sxpath '(quote))))) expr) > + (() '()) > + ((first . rest) > + (second first)))) > (define (listify items) > (match items > ((one) one) > @@ -245,6 +309,34 @@ corresponding to the top-level definition containing the staged changes." > (listify removed) > (listify added)))))))))) > '(inputs propagated-inputs native-inputs))) I think the parentheses are mismatched here, {M-x check-parens} should complain. --8<---------------cut here---------------start------------->8--- ~/src/guix $ guile etc/committer.scm.in ;;; note: source file /home/yoctocell/src/guix/etc/committer.scm ;;; newer than compiled /home/yoctocell/.cache/guile/ccache/3.0-LE-8-4.4/home/yoctocell/src/guix/etc/committer.scm.go ;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0 ;;; or pass the --no-auto-compile argument to disable. ;;; compiling /home/yoctocell/src/guix/etc/committer.scm ;;; WARNING: compilation of /home/yoctocell/src/guix/etc/committer.scm failed: ;;; In procedure read_inner_expression: etc/committer.scm:465:47: unexpected ")" Backtrace: 4 (primitive-load "/home/yoctocell/src/guix/etc/committer.scm") In ice-9/eval.scm: 298:34 3 (_ #<directory (guile-user) 7efdd29e9c80>) 196:27 2 (_ #<directory (guile-user) 7efdd29e9c80>) 223:20 1 (proc #<directory (guile-user) 7efdd29e9c80>) In unknown file: 0 (%resolve-variable (7 . get-values/no-unquote) #<directory (guile-user) 7efdd29e9c80>) ERROR: In procedure %resolve-variable: Unbound variable: get-values/no-unquote --8<---------------cut here---------------end--------------->8--- > From 5f0313c01121a0a1e7f39f447425b5a8b70fb8c0 Mon Sep 17 00:00:00 2001 > From: Maxime Devos <maximedevos@telenet.be> > Date: Sat, 1 May 2021 12:19:05 +0200 > Subject: [PATCH 11/11] etc: committer: Handle substitute-keyword-arguments. > > * etc/committer.scm.in > (keyword-list->alist): Rename to ... > (keyword-list->alist/list): ..., and document the input format. > > [...] > > -(define (keyword-list->alist kwlist) > +;; Input: a list of keywords and the corresponding values, > +;; without an exterior quote, quasiquote or list. > +(define (keyword-list->alist/list kwlist) > (match kwlist > (() '()) > (((? keyword? k) object . rest) > `((,k . ,object) . ,(keyword-list->alist rest))) ^^^^^^^^^^^^^^^^^^^ ‘keyword-list->alist/list’ ^ permalink raw reply [flat|nested] 9+ messages in thread
* [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff. 2021-05-06 7:50 ` [bug#48120] [PATCH] " Maxime Devos 2021-05-09 18:34 ` Xinglu Chen @ 2022-05-22 3:33 ` Maxim Cournoyer 2022-05-22 9:04 ` Maxime Devos 1 sibling, 1 reply; 9+ messages in thread From: Maxim Cournoyer @ 2022-05-22 3:33 UTC (permalink / raw) To: Maxime Devos; +Cc: 48120 Hello, Maxime Devos <maximedevos@telenet.be> writes: > New patch series, handling more edge cases. > > It needs some changes in how it wraps lines now there > is a break-string procedure, but I don't have time to > work on this currently so I'll just submit it as-is for now. Gentle ping :-). Maxim ^ permalink raw reply [flat|nested] 9+ messages in thread
* [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff. 2022-05-22 3:33 ` [bug#48120] [PATCH]: " Maxim Cournoyer @ 2022-05-22 9:04 ` Maxime Devos 2022-05-22 13:13 ` Maxim Cournoyer 0 siblings, 1 reply; 9+ messages in thread From: Maxime Devos @ 2022-05-22 9:04 UTC (permalink / raw) To: Maxim Cournoyer; +Cc: 48120 [-- Attachment #1: Type: text/plain, Size: 469 bytes --] Maxim Cournoyer schreef op za 21-05-2022 om 23:33 [-0400]: > Hello, > > Maxime Devos <maximedevos@telenet.be> writes: > > > New patch series, handling more edge cases. > > > > It needs some changes in how it wraps lines now there > > is a break-string procedure, but I don't have time to > > work on this currently so I'll just submit it as-is for now. > > Gentle ping :-). > > Maxim Currently working on other things. Also, IIRC, needs a rebase [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply [flat|nested] 9+ messages in thread
* [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff. 2022-05-22 9:04 ` Maxime Devos @ 2022-05-22 13:13 ` Maxim Cournoyer 0 siblings, 0 replies; 9+ messages in thread From: Maxim Cournoyer @ 2022-05-22 13:13 UTC (permalink / raw) To: Maxime Devos; +Cc: 48120 Hello, Maxime Devos <maximedevos@telenet.be> writes: > Maxim Cournoyer schreef op za 21-05-2022 om 23:33 [-0400]: >> Hello, >> >> Maxime Devos <maximedevos@telenet.be> writes: >> >> > New patch series, handling more edge cases. >> > >> > It needs some changes in how it wraps lines now there >> > is a break-string procedure, but I don't have time to >> > work on this currently so I'll just submit it as-is for now. >> >> Gentle ping :-). >> >> Maxim > > Currently working on other things. Also, IIRC, needs a rebase OK, no pressure, thanks for the update. Maxim ^ permalink raw reply [flat|nested] 9+ messages in thread
* [bug#48120] [PATCH] etc: committer: Read #~, #$ and #+ correctly. 2021-04-30 14:36 [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff Maxime Devos 2021-05-06 7:50 ` [bug#48120] [PATCH] " Maxime Devos @ 2021-06-17 13:36 ` Maxime Devos 2021-08-07 12:06 ` [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff Ricardo Wurmus 2021-11-22 23:07 ` Ricardo Wurmus 3 siblings, 0 replies; 9+ messages in thread From: Maxime Devos @ 2021-06-17 13:36 UTC (permalink / raw) To: 48120 [-- Attachment #1.1: Type: text/plain, Size: 201 bytes --] Hi Guix, I haven't gotten around to making a new revision of the whole patch series yet, but I want to note that this individual patch is simple and functions on its own. Greetings, Maxime. [-- Attachment #1.2: Type: text/x-patch, Size: 1090 bytes --] From 3f6404ab0367d91bb665748a8eab17976e9a2c11 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Fri, 30 Apr 2021 22:53:12 +0200 Subject: [PATCH] etc: committer: Read #~, #$ and #+ correctly. Some package definitions use G-expressions (see, e.g., chez-scheme). Import (guix gexp) such that Guile knows how to read those. Otherwise, an exception such as the following might be raised: ERROR: In procedure read: In procedure scm_lreadr: gnu/services/networking.scm:480:16: Unknown # object: #\~ * etc/committer.scm.in: Import (guix gexp). --- etc/committer.scm.in | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/etc/committer.scm.in b/etc/committer.scm.in index 1f19ccfd6d..b61121bc4b 100755 --- a/etc/committer.scm.in +++ b/etc/committer.scm.in @@ -36,7 +36,8 @@ (ice-9 popen) (ice-9 match) (ice-9 rdelim) - (ice-9 textual-ports)) + (ice-9 textual-ports) + (guix gexp)) (define (read-excursion port) "Read an expression from PORT and reset the port position before returning -- 2.32.0 [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply related [flat|nested] 9+ messages in thread
* [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff. 2021-04-30 14:36 [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff Maxime Devos 2021-05-06 7:50 ` [bug#48120] [PATCH] " Maxime Devos 2021-06-17 13:36 ` [bug#48120] [PATCH] etc: committer: Read #~, #$ and #+ correctly Maxime Devos @ 2021-08-07 12:06 ` Ricardo Wurmus 2021-11-22 23:07 ` Ricardo Wurmus 3 siblings, 0 replies; 9+ messages in thread From: Ricardo Wurmus @ 2021-08-07 12:06 UTC (permalink / raw) To: 48120 I pushed that one change with commit 50c2dcd1c977f98681a4e457b2bcf09d96588eee to the master branch. Thank you! -- Ricardo ^ permalink raw reply [flat|nested] 9+ messages in thread
* [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff. 2021-04-30 14:36 [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff Maxime Devos ` (2 preceding siblings ...) 2021-08-07 12:06 ` [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff Ricardo Wurmus @ 2021-11-22 23:07 ` Ricardo Wurmus 3 siblings, 0 replies; 9+ messages in thread From: Ricardo Wurmus @ 2021-11-22 23:07 UTC (permalink / raw) To: 48120 Hi Maxime, are you still interested in adjusting your patches? Or would you prefer I make the suggested changes when applying them? -- Ricardo ^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2022-05-22 13:15 UTC | newest] Thread overview: 9+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2021-04-30 14:36 [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff Maxime Devos 2021-05-06 7:50 ` [bug#48120] [PATCH] " Maxime Devos 2021-05-09 18:34 ` Xinglu Chen 2022-05-22 3:33 ` [bug#48120] [PATCH]: " Maxim Cournoyer 2022-05-22 9:04 ` Maxime Devos 2022-05-22 13:13 ` Maxim Cournoyer 2021-06-17 13:36 ` [bug#48120] [PATCH] etc: committer: Read #~, #$ and #+ correctly Maxime Devos 2021-08-07 12:06 ` [bug#48120] [PATCH]: Teach etc/committer.scm.in some stuff Ricardo Wurmus 2021-11-22 23:07 ` Ricardo Wurmus
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/guix.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.