From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Rob Browning Newsgroups: gmane.lisp.guile.devel Subject: [PATCH 4/7] guile-test: support automake parallel test harness via --trs-file Date: Fri, 25 Aug 2023 18:17:33 -0500 Message-ID: <20230825231736.955507-5-rlb@defaultvalue.org> References: <20230825231736.955507-1-rlb@defaultvalue.org> Mime-Version: 1.0 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="32195"; mail-complaints-to="usenet@ciao.gmane.io" To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Sat Aug 26 01:18:52 2023 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qZg4q-00087f-7J for guile-devel@m.gmane-mx.org; Sat, 26 Aug 2023 01:18:52 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qZg3l-00050K-U9; Fri, 25 Aug 2023 19:17:45 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qZg3k-0004zS-2U for guile-devel@gnu.org; Fri, 25 Aug 2023 19:17:44 -0400 Original-Received: from defaultvalue.org ([45.33.119.55]) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qZg3f-0008Kr-6A for guile-devel@gnu.org; Fri, 25 Aug 2023 19:17:43 -0400 Original-Received: from trouble.defaultvalue.org (localhost [127.0.0.1]) (Authenticated sender: rlb@defaultvalue.org) by defaultvalue.org (Postfix) with ESMTPSA id 2B030204B2 for ; Fri, 25 Aug 2023 18:17:37 -0500 (CDT) Original-Received: by trouble.defaultvalue.org (Postfix, from userid 1000) id C507A14E2A4; Fri, 25 Aug 2023 18:17:36 -0500 (CDT) X-Mailer: git-send-email 2.39.2 In-Reply-To: <20230825231736.955507-1-rlb@defaultvalue.org> Received-SPF: pass client-ip=45.33.119.55; envelope-from=rlb@defaultvalue.org; helo=defaultvalue.org X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.devel:21931 Archived-At: Support an optional --trs-file PATH argument that causes guile-test to write the status information expected by the automake parallel test harness to PATH. In addition, when --trs-file is specified, suppress the final test summary (via print-counts) since it would be repeated per-test-file when running in parallel, the automake harness prints its own summary. cf. https://www.gnu.org/software/automake/manual/html_node/API-for-Custom-Test-Drivers.html --- test-suite/guile-test | 29 +++++++++++--- test-suite/test-suite/lib/automake.scm | 54 ++++++++++++++++++++++++++ 2 files changed, 77 insertions(+), 6 deletions(-) create mode 100644 test-suite/test-suite/lib/automake.scm diff --git a/test-suite/guile-test b/test-suite/guile-test index e0c4333f7..6090efc35 100755 --- a/test-suite/guile-test +++ b/test-suite/guile-test @@ -89,6 +89,7 @@ :use-module (system vm coverage) :use-module (srfi srfi-11) :use-module (system vm vm) + :use-module ((test-suite lib automake) :prefix automake/) :export (main data-file-name test-file-name)) @@ -184,7 +185,9 @@ (coverage (single-char #\c)) (debug - (single-char #\d)))))) + (single-char #\d)) + (trs-file + (value #t)))))) (define (opt tag default) (let ((pair (assq tag options))) (if pair (cdr pair) default))) @@ -207,11 +210,16 @@ (if (null? foo) (enumerate-tests test-suite) foo))) - (log-file - (opt 'log-file "guile.log"))) + (log-file (opt 'log-file "guile.log")) + (trs-file (opt 'trs-file #f))) ;; Open the log file. - (let ((log-port (open-output-file log-file))) + (let ((log-port (open-output-file log-file)) + (trs-port (and trs-file + (let ((p (open-output-file trs-file))) + (set-port-encoding! p "UTF-8") + (display ":copy-in-global-log: no\n" p) + p)))) ;; Allow for arbitrary Unicode characters in the log file. (set-port-encoding! log-port "UTF-8") @@ -223,9 +231,11 @@ ;; Register some reporters. (let ((global-pass #t) (counter (make-count-reporter))) + (when trs-port + (register-reporter (automake/reporter trs-port))) (register-reporter (car counter)) (register-reporter (make-log-reporter log-port)) - (register-reporter user-reporter) + (register-reporter user-reporter) (register-reporter (lambda results (case (car results) ((unresolved) @@ -255,10 +265,17 @@ ;; Display the final counts, both to the user and in the log ;; file. (let ((counts ((cadr counter)))) - (print-counts counts) + (unless trs-port + (print-counts counts)) (print-counts counts log-port)) (close-port log-port) + + (when trs-port + (when global-pass (display ":recheck: no\n" trs-port)) + (display ":test-global-result: umm, ok?\n" trs-port) + (close-port trs-port)) + (quit global-pass)))))) diff --git a/test-suite/test-suite/lib/automake.scm b/test-suite/test-suite/lib/automake.scm new file mode 100644 index 000000000..237a89d65 --- /dev/null +++ b/test-suite/test-suite/lib/automake.scm @@ -0,0 +1,54 @@ +;;;; test-suite/lib/automake.scm --- support for automake driven tests +;;;; Copyright (C) 2023 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3, or (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this software; see the file COPYING.LESSER. +;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin +;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-suite lib automake) + :use-module ((ice-9 match)) + :use-module ((srfi srfi-1) :select (drop-right last)) + :export (reporter)) + +(define (display->str x) + (call-with-output-string (lambda (port) (display x port)))) + +(define (write->str x) + (call-with-output-string (lambda (port) (write x port)))) + +(define (show port . args) + (for-each (lambda (x) (display x port)) args)) + +(define (render-name name) + (string-join (append (map display->str (drop-right name 1)) + ;; Because for some tests, say via pass-if or + ;; pass-if-equal with no explict name, it's an + ;; arbirary form, possibly including null chars, + ;; etc. + (list (write->str (last name)))) + ": ")) + +(define (reporter trs-port) + (match-lambda* + (('pass name) (show trs-port ":test-result: PASS " (render-name name) "\n")) + (('upass name) (show trs-port ":test-result: XPASS " (render-name name) "\n")) + (('fail name) (show trs-port ":test-result: FAIL " (render-name name) "\n")) + (('xfail name . args) (show trs-port ":test-result: XFAIL " (render-name name) "\n")) + (('untested name) (show trs-port ":test-result: SKIP " (render-name name) "\n")) + (('unsupported name) (show trs-port ":test-result: SKIP " (render-name name) "\n")) + (('unresolved name) (show trs-port ":test-result: SKIP " (render-name name) "\n")) + (('error name . args) + (show trs-port ":test-result: ERROR " (render-name name) " ") + (write args trs-port) + (newline trs-port)))) -- 2.39.2