unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / Atom feed
* [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; 6+ 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	[flat|nested] 6+ 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
  2021-06-17 13:36 ` [bug#48120] [PATCH] etc: committer: Read #~, #$ and #+ correctly Maxime Devos
                   ` (2 subsequent siblings)
  3 siblings, 1 reply; 6+ 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	[flat|nested] 6+ 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
  0 siblings, 0 replies; 6+ 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] 6+ 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; 6+ 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	[flat|nested] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ messages in thread

end of thread, other threads:[~2021-11-22 23:09 UTC | newest]

Thread overview: 6+ 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
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

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).