From 7bef05430de5e39bf2937b026d68d63116c46233 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Tue, 3 Jan 2023 16:55:56 +0000 Subject: Quit the autotools build system. For a simple package like guile-email, the autotools build system is more trouble than it is worth. We prefer a hand-written Makefile. As the commit summary suggests, the autotools are indeed a bad habit that we must "quit". * Makefile: New file. * Makefile.am, bootstrap.sh, configure.ac, pre-inst-env.in: Delete files. * build-aux/test-corpus.scm.in: Rename to ... * build-aux/test-corpus.scm: ... this. Remove shebang. * build-aux/test-driver.scm.in: Rename to ... * build-aux/test-driver.scm: ... this. Remove autotools specific parts. * guix.scm: Import (guix utils). (guile-email)[arguments]: Add prefix to #:make-flags. Delete configure phase. * .gitignore: Remove INSTALL, Makefile, Makefile.in, aclocal.m4, autom4te.cache, build-aux/install-sh, build-aux/missing, build-aux/test-corpus.scm, config.log, config.status, configure, doc/.dirstamp, pre-inst-env, test-suite.log, tests/*.log and tests/*.trs. --- build-aux/test-corpus.scm | 100 +++++++++++++++++++++++++++++++++++++++++ build-aux/test-corpus.scm.in | 103 ------------------------------------------- build-aux/test-driver.scm | 46 +++++++++++++++++++ build-aux/test-driver.scm.in | 66 --------------------------- 4 files changed, 146 insertions(+), 169 deletions(-) create mode 100644 build-aux/test-corpus.scm delete mode 100644 build-aux/test-corpus.scm.in create mode 100644 build-aux/test-driver.scm delete mode 100644 build-aux/test-driver.scm.in (limited to 'build-aux') diff --git a/build-aux/test-corpus.scm b/build-aux/test-corpus.scm new file mode 100644 index 0000000..83a359f --- /dev/null +++ b/build-aux/test-corpus.scm @@ -0,0 +1,100 @@ +;;; guile-email --- Guile email parser +;;; Copyright © 2021 Arun Isaac +;;; +;;; This file is part of guile-email. +;;; +;;; guile-email is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Affero General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; guile-email 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 +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with guile-email. If not, see +;;; . + +;;; Commentary: + +;; This script recursively finds all mbox files in the current +;; directory, and tests if guile-email can parse all messages without +;; erroring out. + +;;; Code: + +(use-modules (rnrs io ports) + (srfi srfi-26) + (srfi srfi-28) + (srfi srfi-171) + (ice-9 ftw) + (ice-9 match) + (email email)) + +(define %fail-directory + (match (command-line) + ((_ fail-directory) fail-directory) + ((arg0 _ ...) + (scm-error 'misc-error + #f + "Usage: ~A fail-directory" + (list arg0) + #f)))) + +(define (directory-files directory) + "Return files in DIRECTORY." + (scandir directory (lambda (filename) + (not (member filename (list "." "..")))))) + +(define (write-failed-email corpus mbox index email) + "Write EMAIL, the INDEXth email in MBOX of CORPUS, for which +parse-email fails to fail directory." + (display (format "Failed on index ~a of ~a/~a~%" index corpus mbox)) + (call-with-output-file (format "~a/~a_~a_~a" + %fail-directory + corpus + (basename mbox ".mbox") + index) + (cut put-bytevector <> email))) + +(define read-next-email-in-mbox + (@@ (email email) + read-next-email-in-mbox)) + +(define (test-corpus corpus) + "Test CORPUS, a directory containing mbox files." + (for-each (lambda (mbox) + (let ((mbox-path (string-append corpus "/" mbox))) + (display (format "~a~%" mbox-path)) + (call-with-input-file mbox-path + (lambda (port) + (port-transduce (compose (tenumerate) + (tmap (match-lambda + ((index . bv) + (catch #t + (lambda () + (parse-email bv)) + (lambda _ + (write-failed-email corpus mbox index bv))))))) + (const #t) + read-next-email-in-mbox + port))))) + (directory-files corpus))) + +;; If fail directory exists, delete its contents. Else, create it. +(if (file-exists? %fail-directory) + (for-each (lambda (file) + (delete-file (string-append %fail-directory "/" file))) + (directory-files %fail-directory)) + (mkdir %fail-directory)) + +;; Test corpora. +(test-corpus "guix-commits") +(test-corpus "guix-patches") +(test-corpus "bug-guix") + +;; If fail directory has any emails, then error out. +(unless (null? (directory-files %fail-directory)) + (error "Corpus test failed for some messages")) diff --git a/build-aux/test-corpus.scm.in b/build-aux/test-corpus.scm.in deleted file mode 100644 index b069186..0000000 --- a/build-aux/test-corpus.scm.in +++ /dev/null @@ -1,103 +0,0 @@ -#! @GUILE@ --*- scheme -*- -!# -;;; guile-email --- Guile email parser -;;; Copyright © 2021 Arun Isaac -;;; -;;; This file is part of guile-email. -;;; -;;; guile-email is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU Affero General Public License as -;;; published by the Free Software Foundation; either version 3 of the -;;; License, or (at your option) any later version. -;;; -;;; guile-email 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 -;;; Affero General Public License for more details. -;;; -;;; You should have received a copy of the GNU Affero General Public -;;; License along with guile-email. If not, see -;;; . - -;;; Commentary: - -;; This script recursively finds all mbox files in the current -;; directory, and tests if guile-email can parse all messages without -;; erroring out. - -;;; Code: - -(use-modules (rnrs io ports) - (srfi srfi-26) - (srfi srfi-28) - (srfi srfi-171) - (ice-9 ftw) - (ice-9 match) - (email email)) - -(define %fail-directory - (match (command-line) - ((_ fail-directory) fail-directory) - ((arg0 _ ...) - (scm-error 'misc-error - #f - "Usage: ~A fail-directory" - (list arg0) - #f)))) - -(define (directory-files directory) - "Return files in DIRECTORY." - (scandir directory (lambda (filename) - (not (member filename (list "." "..")))))) - -(define (write-failed-email corpus mbox index email) - "Write EMAIL, the INDEXth email in MBOX of CORPUS, for which -parse-email fails to fail directory." - (display (format "Failed on index ~a of ~a/~a~%" index corpus mbox)) - (call-with-output-file (format "~a/~a_~a_~a" - %fail-directory - corpus - (basename mbox ".mbox") - index) - (cut put-bytevector <> email))) - -(define read-next-email-in-mbox - (@@ (email email) - read-next-email-in-mbox)) - -(define (test-corpus corpus) - "Test CORPUS, a directory containing mbox files." - (for-each (lambda (mbox) - (let ((mbox-path (string-append corpus "/" mbox))) - (display (format "~a~%" mbox-path)) - (call-with-input-file mbox-path - (lambda (port) - (port-transduce (compose (tenumerate) - (tmap (match-lambda - ((index . bv) - (catch #t - (lambda () - (parse-email bv)) - (lambda _ - (write-failed-email corpus mbox index bv))))))) - (const #t) - read-next-email-in-mbox - port))))) - (directory-files corpus))) - -;; If fail directory exists, delete its contents. Else, create it. -(if (file-exists? %fail-directory) - (for-each (lambda (file) - (delete-file (string-append %fail-directory "/" file))) - (directory-files %fail-directory)) - (mkdir %fail-directory)) - -;; Test corpora. -(test-corpus "guix-commits") -(test-corpus "guix-patches") -(test-corpus "bug-guix") - -;; If fail directory has any emails, then error out. -(unless (null? (directory-files %fail-directory)) - (error "Corpus test failed for some messages")) diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm new file mode 100644 index 0000000..8d60cd4 --- /dev/null +++ b/build-aux/test-driver.scm @@ -0,0 +1,46 @@ +;;; guile-email --- Guile email parser +;;; Copyright © 2018, 2019 Arun Isaac +;;; +;;; This file is part of guile-email. +;;; +;;; guile-email is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Affero General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; guile-email 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 +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with guile-email. If not, see +;;; . + +(use-modules (ice-9 format) + (ice-9 match) + (srfi srfi-64)) + +(define %my-gnu-runner + (let ((runner (test-runner-simple))) + (test-runner-on-group-begin! runner + (lambda (runner suite-name count) + (format (current-error-port) + "%%%% Starting test ~a~%" suite-name))) + (test-runner-on-group-end! runner (const #f)) + (test-runner-on-test-end! runner + (lambda (runner) + (let ((name (test-runner-test-name runner)) + (result (string-upcase + (symbol->string (test-result-kind runner))))) + (format (current-error-port) + "\x1b[~:[31~;32~]m~a\x1b[0m ~a~%" + (eq? (test-result-kind runner) 'pass) + result name)))) + runner)) + +(match (command-line) + ((_ test-files ...) + (test-with-runner %my-gnu-runner + (for-each load test-files)) + (exit (zero? (test-runner-fail-count %my-gnu-runner))))) diff --git a/build-aux/test-driver.scm.in b/build-aux/test-driver.scm.in deleted file mode 100644 index 96d84e0..0000000 --- a/build-aux/test-driver.scm.in +++ /dev/null @@ -1,66 +0,0 @@ -;;; guile-email --- Guile email parser -;;; Copyright © 2018, 2019 Arun Isaac -;;; -;;; This file is part of guile-email. -;;; -;;; guile-email is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU Affero General Public License as -;;; published by the Free Software Foundation; either version 3 of the -;;; License, or (at your option) any later version. -;;; -;;; guile-email 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 -;;; Affero General Public License for more details. -;;; -;;; You should have received a copy of the GNU Affero General Public -;;; License along with guile-email. If not, see -;;; . - -(use-modules (ice-9 format) - (ice-9 getopt-long) - (srfi srfi-26) - (srfi srfi-64)) - -;; Currently, only log-file and trs-file are understood. Everything -;; else is ignored. -(define %options - '((test-name (value #t)) - (log-file (value #t)) - (trs-file (value #t)) - (color-tests (value #t)) - (expect-failure (value #t)) - (enable-hard-errors (value #t)))) - -(define (my-gnu-runner log-port trs-port) - (let ((runner (test-runner-simple))) - (test-runner-on-group-begin! runner - (lambda (runner suite-name count) - (format #t "%%%% Starting test ~a~%" suite-name) - (format log-port "%%%% Starting test ~a~%" suite-name) - ;; Set log-port in the aux-value field for use by other parts - ;; of test-runner-simple - (test-runner-aux-value! runner log-port) - (format #t " (Writing full log to \"~a\")~%" (port-filename log-port)))) - (test-runner-on-group-end! runner (const #f)) - (test-runner-on-test-end! runner - (lambda (runner) - (let ((name (test-runner-test-name runner)) - (result (string-upcase - (symbol->string (test-result-kind runner))))) - (format trs-port ":test-result: ~a ~a~%" result name) - (format (current-error-port) - "\x1b[~:[31~;32~]m~a\x1b[0m ~a~%" - (eq? (test-result-kind runner) 'pass) - result name)))) - runner)) - -(let ((opts (getopt-long (command-line) %options))) - (call-with-output-file (string-append "@abs_top_builddir@/" - (option-ref opts 'log-file #f)) - (lambda (log-port) - (call-with-output-file (option-ref opts 'trs-file #f) - (lambda (trs-port) - (chdir "@abs_top_srcdir@") - (test-with-runner (my-gnu-runner log-port trs-port) - (load-from-path (option-ref opts 'test-name #f)))))))) -- cgit v1.2.3