summaryrefslogtreecommitdiff
path: root/test-suite/vm/t-call-cc.scm
blob: 097f276ff1569c1d444ced1f756dab5cd0f31a5c (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
(let ((set-counter2 #f))
  (define (get-counter2)
    (call/cc
     (lambda (k)
       (set! set-counter2 k)
       1)))
  (define (loop counter1)
    (let ((counter2 (get-counter2)))
      (set! counter1 (1+ counter1))
      (cond ((not (= counter1 counter2))
             (error "bad call/cc behaviour" counter1 counter2))
            ((> counter1 10)
             #t)
            (else
             (set-counter2 (1+ counter2))))))
  (loop 0))

(let* ((next #f)
       (counter 0)
       (result (call/cc
                 (lambda (k)
                   (set! next k)
                   1))))
  (set! counter (+ 1 counter))
  (cond ((not (= counter result))
         (error "bad call/cc behaviour" counter result))
        ((> counter 10)
         #t)
        (else
         (next (+ 1 counter)))))