aboutsummaryrefslogtreecommitdiffstats
path: root/lib/guile/tests.scm
blob: bc0606cb63ee3b68c3019576c277dd753ea23370 (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
#!/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")