summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am1
-rw-r--r--mumi/test-utils.scm55
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)))))