Add testing module and ignore backup files.

testing.scm

@@ -0,0 +1,68 @@
+;;
+;; testing.scm
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; Permission to use, copy, modify, and/or distribute this software
+;; for any purpose with or without fee is hereby granted, provided
+;; that the above copyright notice and this permission notice appear
+;; in all copies.
+;; 
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+(module
+ testing
+ (test-eq? test-equal? test-exn)
+
+ (import scheme)
+
+ ;; Evaluates body ... expressions with exception handler installed.
+ (define-syntax with-handler
+   (syntax-rules ()
+     ((_ handler body ...)
+      (call-with-current-continuation
+       (lambda (k)
+	 (with-exception-handler
+	  (lambda (x) (k (handler x)))
+	  (lambda () body ...)))))))
+
+ ;; Test passes if the-test does not raise an exception and the result
+ ;; is eq? to expected-result.
+ (define-syntax test-eq?
+   (syntax-rules ()
+     ((_ name the-test expected-result)
+      (if (with-handler (lambda (x) #f)
+			(eq? the-test expected-result))
+	  (display ".")
+	  (error 'unit-test name)))))
+
+ ;; Test passes if the-test does not raise an exception and the result
+ ;; is equal? to expected-result.
+ (define-syntax test-equal?
+   (syntax-rules ()
+     ((_ name the-test expected-result)
+      (if (with-handler (lambda (x) #f)
+			(eq? the-test expected-result))
+	  (display ".")
+	  (error 'unit-test name)))))
+
+ ;; Passes if the-test raises an exception
+ (define-syntax test-exn
+   (syntax-rules ()
+     ((_ name the-test)
+      (if (with-handler (lambda (x) #t)
+			the-test #f)
+	  (display ".")
+	  (error 'unit-test name)))))
+
+ )