aboutsummaryrefslogtreecommitdiffstats
path: root/lib/guile/tests.scm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/guile/tests.scm')
-rwxr-xr-xlib/guile/tests.scm65
1 files changed, 65 insertions, 0 deletions
diff --git a/lib/guile/tests.scm b/lib/guile/tests.scm
new file mode 100755
index 0000000..bc0606c
--- /dev/null
+++ b/lib/guile/tests.scm
@@ -0,0 +1,65 @@
+#!/usr/bin/guile \
+-L . --no-auto-compile -s
+!#
+
+(use-modules
+ (ice-9 and-let-star)
+ (language tree-il)
+ (term ansi-color)
+ (srfi srfi-64)
+ (mail-tools)
+ (utils))
+
+(define (%test-write-result1 pair port)
+ (simple-format port (string-append (colorize-string " ~a: " 'BOLD) "~s~%")
+ (car pair) (cdr pair)))
+
+(define (test-on-test-end-color runner)
+ (let ((log (test-runner-aux-value runner))
+ (kind (test-result-ref runner 'result-kind))
+ (results (test-result-alist runner)))
+ (when (memq kind '(fail xpass))
+ (display (colorize-string (if (eq? kind 'xpass) "XPASS" "FAIL") 'RED))
+ (map (lambda (y)
+ (and-let* ((x (assq y results)))
+ (format #t ":~a" (cdr x))))
+ '(source-file source-line test-name))
+ (newline))
+ (when (output-port? log)
+ (display "Test end:\n" log)
+ (map (lambda (pair)
+ ;; Write out properties not written out by on-test-begin.
+ (unless (memq (car pair) '(test-name source-file source-line source-form))
+ (%test-write-result1 pair log)))
+ results))))
+
+(test-runner-factory
+ (lambda ()
+ (let ((runner (test-runner-simple)))
+ (test-runner-on-test-end! runner test-on-test-end-color)
+ runner)))
+
+(test-begin "Mail tools")
+(test-equal "mail/spam/cur/postU=5" (new-path "mail/inbox/cur/postU=5" "mail/spam"))
+(test-equal 60 (call-with-input-string "1595684247\n60\n" get-uidvalidity))
+(test-equal "Ha;S" (rename-higher "Ha,U=55;S" 5))
+(test-equal "Ha,U=20;S" (rename-higher "Ha,U=20;S" 55))
+(test-equal '("+one -new" "(from:first) and tag:new") (with-new '("+one" "from:first") #t))
+(test-equal '("+one" "from:first") (with-new '("+one" "from:first") #f))
+(test-equal '(" -new" "tag:new") (with-new '("" "*") #t))
+(test-equal '("" "*") (with-new '("" "*") #f))
+(test-end "Mail tools")
+
+(test-begin "Thread macros")
+(test-equal '(+ 5 9) (tree-il->scheme (macroexpand '(-> 5 (+ 9)))))
+(test-equal '(+ 8) (tree-il->scheme (macroexpand '(-> 8 +))))
+(test-equal '(string-append (number->string (inc 8)) " EUR")
+ (tree-il->scheme (macroexpand '(-> 8 inc number->string (string-append " EUR")))))
+(test-equal "29 EUR" (-> 28 1+ number->string (string-append " EUR")))
+
+(test-equal '(2)
+ (-> (->> '(5 9 2) (cons 1) (filter even?))
+ macroexpand
+ tree-il->scheme))
+
+(test-end "Thread macros")