tagbody.lsp 2.94 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Oct 12 13:27:22 2002
;;;; Contains: Tests of TAGBODY

6

pfdietz's avatar
pfdietz committed
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

(deftest tagbody.1
  (tagbody)
  nil)

(deftest tagbody.2
  (tagbody 'a)
  nil)

(deftest tagbody.3
  (tagbody (values))
  nil)

(deftest tagbody.4
  (tagbody (values 1 2 3 4 5))
  nil)

(deftest tagbody.5
  (let ((x 0))
    (values
     (tagbody
      (setq x 1)
      (go a)
      (setq x 2)
      a)
     x))
  nil 1)

(deftest tagbody.6
  (let ((x 0))
    (tagbody
     (setq x 1)
     (go a)
     b
     (setq x 2)
     (go c)
     a
     (setq x 3)
     (go b)
     c)
    x)
  2)

;;; Macroexpansion occurs after tag determination
(deftest tagbody.7
  (let ((x 0))
    (macrolet ((%m () 'a))
      (tagbody
       (tagbody
sds's avatar
sds committed
56 57 58
        (go a)
        (%m)
        (setq x 1))
pfdietz's avatar
pfdietz committed
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
       a ))
    x)
  0)

(deftest tagbody.8
  (let ((x 0))
    (tagbody
     (flet ((%f (y) (setq x y) (go a)))
       (%f 10))
     (setq x 1)
     a)
    x)
  10)

;;; Tag names are in their own name space
(deftest tagbody.9
  (let (result)
    (tagbody
     (flet ((a (x) x))
       (setq result (a 10))
       (go a))
     a)
    result)
  10)

(deftest tagbody.10
  (let (result)
    (tagbody
     (block a
       (setq result 10)
       (go a))
     (setq result 20)
     a)
    result)
  10)

(deftest tagbody.11
  (let (result)
    (tagbody
     (catch 'a
       (setq result 10)
       (go a))
     (setq result 20)
     a)
    result)
  10)

(deftest tagbody.12
  (let (result)
    (tagbody
     (block a
       (setq result 10)
       (return-from a nil))
     (setq result 20)
     a)
    result)
  20)
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150

;;; Test that integers are accepted as go tags

(deftest tagbody.13
  (block done
    (tagbody
     (go around)
     10
     (return-from done 'good)
     around
     (go 10)))
  good)

(deftest tagbody.14
  (block done
    (tagbody
     (go around)
     -10
     (return-from done 'good)
     around
     (go -10)))
  good)

(deftest tagbody.15
  (block done
    (tagbody
     (go around)
     #.(1+ most-positive-fixnum)
     (return-from done 'good)
     around
     (go #.(1+ most-positive-fixnum))))
  good)

(deftest tagbody.16
  (let* ((t1 (1+ most-positive-fixnum))
sds's avatar
sds committed
151 152 153 154 155 156 157 158
         (t2 (1+ most-positive-fixnum))
         (form `(block done
                  (tagbody
                   (go around)
                   ,t1
                   (return-from done 'good)
                   around
                   (go ,t2)))))
159 160 161
    (eval form))
  good)

162 163
;;; Check that macros are not expanded before finding tags
;;; Test for issue TAGBODY-TAG-EXPANSION
164

165 166 167 168 169
(deftest tagbody.17
  (block done
    (tagbody
     (macrolet ((foo () 'tag))
       (let (tag)
sds's avatar
sds committed
170 171 172 173
         (tagbody
          (go tag)
          (foo)
          (return-from done :bad))))
174 175 176 177
     tag
     (return-from done :good)))
  :good)

178 179 180 181 182 183 184 185
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest tagbody.18
  (macrolet ((%m (z) z))
    (tagbody
      (expand-in-current-env (%m :foo))))
  nil)