-
Notifications
You must be signed in to change notification settings - Fork 4
/
debug-test.ss
117 lines (92 loc) · 3.73 KB
/
debug-test.ss
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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
#lang scheme/base
(require "debug.ss"
"test-base.ss")
; Helpers ----------------------------------------
(define-syntax capture-output
(syntax-rules ()
[(_ expr ...)
(let ([out (open-output-string)])
(parameterize ([current-output-port out])
expr ... (get-output-string out)))]))
(define-syntax discard-output
(syntax-rules ()
[(_ expr ...)
(let ([out (open-output-string)])
(parameterize ([current-output-port out])
expr ...))]))
; Test suite -----------------------------------
(define/provide-test-suite debug-tests
(test-equal? "debug : passes value transparently"
(discard-output (debug "Message" (+ 1 2 3)))
6)
(test-equal? "debug : prints value"
(capture-output (debug "Message" (+ 1 2 3)))
"Message:\n 6\n")
(test-equal? "debug* : passes value transparently"
(discard-output (debug* "Message" + 1 2 3))
6)
(test-equal? "debug* : prints value"
(capture-output (debug* "Message" + 1 2 3))
"Message:\n 6\n")
(test-equal? "debug-location : prints value"
(capture-output (debug-location))
"Reached debug-test.ss:43:20\n")
(test-equal? "debug-location : prints value and expression"
(capture-output (debug-location (+ 1 2 3)))
"Reached debug-test.ss:47:20:\n 6\n")
(test-equal? "debug-enabled?"
(parameterize ([debug-enabled? #f])
(capture-output (debug "Message" (+ 1 2 3))))
"")
(test-equal? "define/debug"
(capture-output (define/debug a 2) (void))
"a:\n 2\n")
(test-equal? "define-values/debug"
(capture-output (define-values/debug (a b) (values 1 2)) (void))
"(a b):\n (1 2)\n")
(test-equal? "let/debug"
(capture-output (let/debug ([a 1] [b 2])
(+ a b)))
"a:\n 1\nb:\n 2\n")
(test-equal? "let/debug : let loop"
(capture-output (let/debug loop ([a 1])
(unless (= a 3)
(loop (add1 a)))))
"a:\n 1\na:\n 2\na:\n 3\n")
(test-equal? "let*/debug"
(capture-output (let*/debug ([a 1] [b (+ a 2)])
(+ a b)))
"a:\n 1\nb:\n 3\n")
(test-equal? "letrec/debug"
(capture-output (letrec/debug ([a 1] [b 2] [c 3])
(+ a b c)))
"a:\n 1\nb:\n 2\nc:\n 3\n")
(test-equal? "let-values/debug"
(capture-output (let-values/debug ([(a b c) (values 1 2 3)]
[(d e f) (values (+ 4 5) (+ 6 7) (+ 8 9))])
(+ a b c d e f)))
"(a b c):\n (1 2 3)\n(d e f):\n (9 13 17)\n")
(test-equal? "let*-values/debug"
(capture-output (let*-values/debug ([(a b) (values 1 2)]
[(c d) (values (+ a b) (- a b))])
(+ a b c d)))
"(a b):\n (1 2)\n(c d):\n (3 -1)\n")
(test-equal? "letrec-values/debug"
(capture-output (letrec-values/debug ([(a b) (values 1 2)]
[(c d) (values (+ a b) (- a b))])
(+ a b c d)))
"(a b):\n (1 2)\n(c d):\n (3 -1)\n")
(test-case "with-pretty-indent"
(parameterize ([pretty-print-columns 6])
(check-equal? (pretty-format (list 1 2 3 4 5))
"(1\n 2\n 3\n 4\n 5)")
(check-equal? (with-pretty-indent "=="
(pretty-format (list 1 2 3 4 5)))
"==(1\n== 2\n== 3\n== 4\n== 5)")
(check-equal? (with-pretty-indent "==="
(pretty-format (list 1 2 3 4 5)))
"===(1\n=== 2\n=== 3\n=== 4\n=== 5)")))
(test-case "exn-context"
(let ([ctxt (exn-context (make-exn "Test" (current-continuation-marks)))])
(check-pred list? ctxt)
(check-true (andmap symbol? ctxt)))))