blob: f4810452d6bd286c69e241390de536c6781329ef (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
#!/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))
(let ((rule '("+one" "from:first")))
(test-equal "+one -new" (tags-with-new rule #t))
(test-equal "+one" (tags-with-new rule #f))
(test-equal "(from:first) and tag:new" (query-with-new rule #t))
(test-equal "from:first" (query-with-new rule #f)))
(let ((rule '("" "*")))
(test-equal " -new" (tags-with-new rule #t))
(test-equal "" (tags-with-new rule #f))
(test-equal "tag:new" (query-with-new rule #t))
(test-equal "*" (query-with-new rule #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")
|
