From 7a78c23f6f2f1c32abb508563a700cd535b29ad1 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Sun, 13 Jun 2021 21:11:59 +0530
Subject: 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.
---
 build-aux/test-corpus.scm.in | 54 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 54 insertions(+)
 create mode 100644 build-aux/test-corpus.scm.in

(limited to 'build-aux')

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))
+                            '()
+                            "."))
-- 
cgit v1.2.3