summaryrefslogtreecommitdiff
path: root/build-aux
diff options
context:
space:
mode:
authorArun Isaac2023-01-03 19:59:24 +0000
committerArun Isaac2023-01-03 20:05:50 +0000
commita525bd1d808f46095a4cf71d5f37b2ed781a49aa (patch)
tree41fbbdf425d3c8fe771ae35a807ca9b778e0b276 /build-aux
parent536759ac425f8aeaabeea3ecda6f3811476346ea (diff)
downloadguile-email-a525bd1d808f46095a4cf71d5f37b2ed781a49aa.tar.gz
guile-email-a525bd1d808f46095a4cf71d5f37b2ed781a49aa.tar.lz
guile-email-a525bd1d808f46095a4cf71d5f37b2ed781a49aa.zip
build-aux: Make test-corpus.scm a loadable script.
Make test-corpus.scm a script loadable from the REPL rather than something that must be run on the shell. Loadable scripts are easier to deal with since one does not have to deal with command-line arguments. * build-aux/test-corpus.scm (%fail-directory): Delete variable. (write-failed-email): Add fail-directory argument. (main): New function.
Diffstat (limited to 'build-aux')
-rw-r--r--build-aux/test-corpus.scm45
1 files changed, 18 insertions, 27 deletions
diff --git a/build-aux/test-corpus.scm b/build-aux/test-corpus.scm
index 83a359f..374060b 100644
--- a/build-aux/test-corpus.scm
+++ b/build-aux/test-corpus.scm
@@ -1,5 +1,5 @@
;;; guile-email --- Guile email parser
-;;; Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of guile-email.
;;;
@@ -33,27 +33,17 @@
(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)
+(define (write-failed-email fail-directory corpus mbox index email)
"Write EMAIL, the INDEXth email in MBOX of CORPUS, for which
-parse-email fails to fail directory."
+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
+ fail-directory
corpus
(basename mbox ".mbox")
index)
@@ -83,18 +73,19 @@ parse-email fails to fail directory."
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))
+(define (main fail-directory)
+ ;; 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")
+ ;; 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"))
+ ;; If fail directory has any emails, then error out.
+ (unless (null? (directory-files fail-directory))
+ (error "Corpus test failed for some messages")))