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
|
#lang zuo
(require "harness.zuo")
(alert "procedures")
(check (procedure? procedure?))
(check (procedure? (lambda (x) x)))
(check (procedure? (lambda args args)))
(check (procedure? apply))
(check (procedure? call/cc))
(check (procedure? (call/cc (lambda (k) k))))
(check (not (procedure? 1)))
(check (apply + '()) 0)
(check (apply + '(1)) 1)
(check (apply + '(1 2)) 3)
(check (apply + '(1 2 3 4)) 10)
(check (apply apply (list + '(1 2))) 3)
(check-fail (apply +) arity)
(check-fail (apply '(+ 1 2)) arity)
(check-fail (apply apply (cons + '(1 2))) arity)
(check-arg-fail (apply + 1) "not a list")
(check (call/cc (lambda (k) (+ 1 (k 'ok)))) 'ok)
(check (let ([f (call/cc (lambda (k) k))])
(if (procedure? f)
(f 10)
f))
10)
(check-fail (call/cc 1) "not a procedure")
(check (call/prompt (lambda () 10) 'tag) 10)
(check (let ([k (call/prompt
(lambda ()
(call/cc (lambda (k) k)))
'tag)])
(+ 1 (call/prompt (lambda () (k 11)) 'tag)))
12)
(check (let ([k (call/prompt
(lambda ()
(call/cc
(lambda (esc)
(+ 1
(* 2
(call/cc
(lambda (k) (esc k))))))))
'tag)])
(list (call/prompt (lambda () (k 3)) 'tag)
(call/prompt (lambda () (k 4)) 'tag)))
(list 7 9))
(check-fail (call/prompt 1 'tag) "not a procedure")
(check-fail (call/prompt void 7) "not a symbol")
(check (continuation-prompt-available? 'tag) #f)
(check (call/prompt (lambda ()
(continuation-prompt-available? 'tag))
'tag)
#t)
(check (call/prompt (lambda ()
(continuation-prompt-available? 'other))
'tag)
#f)
(check (call/prompt (lambda ()
(call/prompt
(lambda ()
(continuation-prompt-available? 'tag))
'other))
'tag)
#f)
(check (call/prompt (lambda ()
(call/prompt
(lambda ()
(continuation-prompt-available? 'other))
'other))
'tag)
#t)
(check (call/prompt (lambda ()
(list (call/prompt
(lambda ()
(continuation-prompt-available? 'other))
'other)
(continuation-prompt-available? 'tag)))
'tag)
'(#t #t))
(check-fail (call/prompt apply 'tag)
"apply: wrong number of arguments: [no arguments]\n")
|
