summaryrefslogtreecommitdiff
path: root/build-aux
diff options
context:
space:
mode:
authorArun Isaac2021-10-23 00:43:30 +0530
committerArun Isaac2021-10-23 00:46:46 +0530
commit40d74e554515bf775cc2883a3b7afe5e47ebf22f (patch)
tree3d429dfb9dcc3e0221c2b9a319885e83c3ebba00 /build-aux
parentfd5265c33874137f4f9ffb49fbb102befd180966 (diff)
downloadguile-email-40d74e554515bf775cc2883a3b7afe5e47ebf22f.tar.gz
guile-email-40d74e554515bf775cc2883a3b7afe5e47ebf22f.tar.lz
guile-email-40d74e554515bf775cc2883a3b7afe5e47ebf22f.zip
build-aux: Write failed corpus test emails to filesystem.
* build-aux/test-corpus.scm.in: Import (rnrs io ports), (srfi srfi-26), (srfi srfi-28), (srfi srfi-171), (ice-9 ftw) and (ice-9 match). (%fail-directory): New variable. (directory-files, write-failed-email): New function. Write failed corpus test emails to a "fail directory" specified on the command line.
Diffstat (limited to 'build-aux')
-rw-r--r--build-aux/test-corpus.scm.in87
1 files changed, 65 insertions, 22 deletions
diff --git a/build-aux/test-corpus.scm.in b/build-aux/test-corpus.scm.in
index 0920113..9e66132 100644
--- a/build-aux/test-corpus.scm.in
+++ b/build-aux/test-corpus.scm.in
@@ -28,27 +28,70 @@
;;; Code:
-(use-modules (ice-9 ftw)
+(use-modules (rnrs io ports)
+ (srfi srfi-26)
+ (srfi srfi-28)
+ (srfi srfi-171)
+ (ice-9 ftw)
+ (ice-9 match)
(email email))
-(for-each (lambda (mbox)
- (display mbox)
- (newline)
- (call-with-input-file mbox
- (lambda (port)
- (for-each parse-email (mbox->emails port)))))
- (file-system-fold (const #t)
- (lambda (name stat result)
- (if (string-suffix? ".mbox" name)
- (cons name result)
- result))
- (lambda (name stat result)
- result)
- (lambda (name stat result)
- result)
- (lambda (name stat result)
- result)
- (lambda (name stat errno result)
- (error (strerror errno) name))
- '()
- "."))
+(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 (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)
+ (list-transduce (compose (tenumerate)
+ (tmap (match-lambda
+ ((index . bv)
+ (catch #t
+ (lambda ()
+ (parse-email bv))
+ (lambda _
+ (write-failed-email corpus mbox index bv)))))))
+ (const #t)
+ (mbox->emails 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")
+
+;; If fail directory has any emails, then error out.
+(unless (null? (directory-files %fail-directory))
+ (error "Corpus test failed for some messages"))