aboutsummaryrefslogtreecommitdiff
path: root/build-aux
diff options
context:
space:
mode:
authorArun Isaac2021-06-13 21:11:59 +0530
committerArun Isaac2021-06-14 00:04:10 +0530
commit7a78c23f6f2f1c32abb508563a700cd535b29ad1 (patch)
tree301e089116e2d6a09474bdca31696af60c80450e /build-aux
parent670310cb24b15319ec9d84cc88a6ca4fc0bd51e5 (diff)
downloadguile-email-7a78c23f6f2f1c32abb508563a700cd535b29ad1.tar.gz
guile-email-7a78c23f6f2f1c32abb508563a700cd535b29ad1.tar.lz
guile-email-7a78c23f6f2f1c32abb508563a700cd535b29ad1.zip
Add corpus test scripts.
* build-aux/pull-corpus.scm, build-aux/test-corpus.scm.in: New files. * configure.ac: Configure build-aux/test-corpus.scm. * .gitignore: Add build-aux/test-corpus.scm.
Diffstat (limited to 'build-aux')
-rw-r--r--build-aux/test-corpus.scm.in54
1 files changed, 54 insertions, 0 deletions
diff --git a/build-aux/test-corpus.scm.in b/build-aux/test-corpus.scm.in
new file mode 100644
index 0000000..0920113
--- /dev/null
+++ b/build-aux/test-corpus.scm.in
@@ -0,0 +1,54 @@
+#! @GUILE@
+-*- scheme -*-
+!#
+;;; guile-email --- Guile email parser
+;;; Copyright © 2021 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+;;; 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 (ice-9 ftw)
+ (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))
+ '()
+ "."))