Add test-utils.

2 files changed, 56 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index 0d68fe0..9426c26 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -51,6 +51,7 @@ SOURCES =							\
   mumi/send-email.scm				\
   mumi/config.scm					\
   mumi/debbugs.scm					\
+  mumi/test-utils.scm				\
   mumi/xapian.scm
 
 TEST_EXTENSIONS = .scm
diff --git a/mumi/test-utils.scm b/mumi/test-utils.scm
new file mode 100644
index 0000000..b33ffc4
--- /dev/null
+++ b/mumi/test-utils.scm
@@ -0,0 +1,55 @@
+;;; mumi -- Mediocre, uh, mail interface
+;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (mumi test-utils)
+  #:use-module (mumi xapian)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 ftw)
+  #:export (delete-file-recursively mock))
+
+(define* (delete-file-recursively dir)
+  "Delete DIR recursively, like `rm -rf', without following symlinks.
+Report but ignore errors."
+  (let ((dev (stat:dev (lstat dir))))
+    (file-system-fold (lambda (dir stat result)    ; enter?
+                        (= dev (stat:dev stat)))
+                      (lambda (file stat result)   ; leaf
+                        (delete-file file))
+                      (const #t)              ; down
+                      (lambda (dir stat result)    ; up
+                        (rmdir dir))
+                      (const #t)              ; skip
+                      (lambda (file stat errno result)
+                        (format (current-error-port)
+                                "warning: failed to delete ~a: ~a~%"
+                                file (strerror errno)))
+                      #t
+                      dir
+
+                      ;; Don't follow symlinks.
+                      lstat)))
+
+(define-syntax-rule (mock (module proc replacement) body ...)
+  "Within BODY, replace the definition of PROC from MODULE with the definition
+given by REPLACEMENT."
+  (let* ((m (resolve-module 'module))
+         (original (module-ref m 'proc)))
+    (dynamic-wind
+      (lambda () (module-set! m 'proc replacement))
+      (lambda () body ...)
+      (lambda () (module-set! m 'proc original)))))