Fix (SETF OGET).
[jscl.git] / tests / control.lisp
1
2 ;;; Returning from a "dynamically" nested non local exists
3
4 (defun foo (x)
5   (when x (funcall x))
6   (foo (lambda () (return-from foo 1)))
7   (return-from foo 2))
8
9 (test (= (foo nil) 1))
10
11 (defun foo-2 (x)
12   (let (value)
13     (tagbody
14        (when x (funcall x))
15        (foo-2 (lambda () (go exit-2)))
16        (go end)
17      exit-2
18        (setq value t)
19      end)
20     value))
21
22 (test (foo-2 nil))
23
24
25 (test (equal (flet ((foo () (return-from foo 42)))
26                (foo))
27              42))
28
29 (test (equal (let ((out (list)))
30                (labels ((zfoo (n rf i)
31                           (if (> n 0)
32                               (progn
33                                 (push (lambda () (return-from zfoo n)) rf)
34                                 (push n out)
35                                 (zfoo (1- n) rf i)
36                                 (push (- n) out))
37                               (progn
38                                 (push 999 out)
39                                 (funcall (nth i (reverse rf)))
40                                 (push -999 out)))))
41                  (let ((rf (list)))
42                    (zfoo 5 rf 3)
43                    out)))
44              '(-5 -4 -3 999 1 2 3 4 5)))
45
46 ;; COMPLEMENT
47 (test (funcall (complement #'zerop) 1))
48 ;; FIXME: Uncomment whenever characterp is defined
49 ;(test (not (funcall (complement #'characterp) #\A)))
50 (test (not (funcall (complement #'member) 'a '(a b c))))
51 (test (funcall (complement #'member) 'd '(a b c)))