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