diff options
| -rw-r--r-- | build-aux/test-corpus.scm.in | 87 |
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")) |