From ae06b43db712697f7080cc8e5f4d3eecd9350211 Mon Sep 17 00:00:00 2001 From: Maxime Devos 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