labels.lsp 9.93 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Oct  9 19:06:33 2002
;;;; Contains: Tests of LABELS

6

7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26

(deftest labels.1
  (labels ((%f () 1))
    (%f))
  1)

(deftest labels.2
  (labels ((%f (x) x))
    (%f 2))
  2)

(deftest labels.3
  (labels ((%f (&rest args) args))
    (%f 'a 'b 'c))
  (a b c))

;;; The optional arguments are not in the block defined by
;;; the local function declaration
(deftest labels.4
  (block %f
pfdietz's avatar
pfdietz committed
27
    (labels ((%f (&optional (x (return-from %f :good)))
sds's avatar
sds committed
28
               nil))
pfdietz's avatar
pfdietz committed
29 30 31
      (%f)
      :bad))
  :good)
32

33 34 35 36 37 38
;;; Keyword parameter initializers are not in the blocked defined
;;; by the local function declaration

(deftest labels.4a
  (block %f
    (labels ((%f (&key (x (return-from %f :good)))
sds's avatar
sds committed
39
               nil))
40 41 42 43
      (%f)
      :bad))
  :good)

44 45 46 47 48 49 50 51 52 53
(deftest labels.5
  (labels ((%f () (return-from %f 15) 35))
    (%f))
  15)

;;; The aux parameters are not in the block defined by
;;; the local function declaration
(deftest labels.6
  (block %f
    (labels ((%f (&aux (x (return-from %f 10)))
sds's avatar
sds committed
54
               20))
55 56
      (%f)
      :bad))
57 58 59 60 61
  10)

;;; The function is visible inside itself
(deftest labels.7
  (labels ((%f (x n) (cond ((eql n 0) x)
sds's avatar
sds committed
62
                           (t (%f (+ x n) (1- n))))))
63 64 65
    (%f 0 10))
  55)

pfdietz's avatar
pfdietz committed
66 67 68 69
;;; Scope of defined function names includes &AUX parameters

(deftest labels.7b
  (labels ((%f (x &aux (b (%g x))) b)
sds's avatar
sds committed
70
           (%g (y) (+ y y)))
pfdietz's avatar
pfdietz committed
71 72 73
    (%f 10))
  20)

74 75 76 77
;;; Scope of defined function names includes &OPTIONAL parameters

(deftest labels.7c
  (labels ((%f (x &optional (b (%g x))) b)
sds's avatar
sds committed
78
           (%g (y) (+ y y)))
79 80 81 82 83 84 85
    (%f 10))
  20)

;;; Scope of defined function names includes &KEY parameters

(deftest labels.7d
  (labels ((%f (x &key (b (%g x))) b)
sds's avatar
sds committed
86
           (%g (y) (+ y y)))
87 88 89
    (%f 10))
  20)

90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
;;; Keyword arguments
(deftest labels.8
  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
    (%f))
  nil 0 nil)

(deftest labels.9
  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
    (%f :a 1))
  1 0 nil)

(deftest labels.10
  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
    (%f :b 2))
  nil 2 t)

(deftest labels.11
  (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p)))))
    (%f :b 2 :a 3))
  3 2 t)

;;; Unknown keyword parameter should throw a program-error in safe code
;;; (section 3.5.1.4)
(deftest labels.12
114 115 116 117
  (signals-error
   (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))
   program-error)
  t)
118 119 120 121

;;; Odd # of keyword args should throw a program-error in safe code
;;; (section 3.5.1.6)
(deftest labels.13
122 123 124 125
  (signals-error
   (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))
   program-error)
  t)
126 127 128

;;; Too few arguments (section 3.5.1.2)
(deftest labels.14
129
  (signals-error (labels ((%f (a) a)) (%f))
sds's avatar
sds committed
130
                 program-error)
131
  t)
132 133 134

;;; Too many arguments (section 3.5.1.3)
(deftest labels.15
135
  (signals-error (labels ((%f (a) a)) (%f 1 2))
sds's avatar
sds committed
136
                 program-error)
137
  t)
138 139 140

;;; Invalid keyword argument (section 3.5.1.5)
(deftest labels.16
141
  (signals-error (labels ((%f (&key a) a)) (%f '(foo)))
sds's avatar
sds committed
142
                 program-error)
143
  t)
144 145 146 147

;;; Definition of a (setf ...) function

(deftest labels.17
148
  (labels (((setf %f) (x y) (setf (car y) x)))
149 150 151 152 153 154 155 156 157 158 159 160 161 162
    (let ((z (list 1 2)))
      (setf (%f z) 'a)
      z))
  (a 2))

;;; Body is an implicit progn
(deftest labels.18
  (labels ((%f (x) (incf x) (+ x x)))
    (%f 10))
  22)

;;; Can handle at least 50 lambda parameters
(deftest labels.19
  (labels ((%f (a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
sds's avatar
sds committed
163 164 165 166 167 168 169 170 171
                b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
                c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
                d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
                e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)
               (+ a1 a2 a3 a4 a5 a6 a7 a8 a9 a10
                  b1 b2 b3 b4 b5 b6 b7 b8 b9 b10
                  c1 c2 c3 c4 c5 c6 c7 c8 c9 c10
                  d1 d2 d3 d4 d5 d6 d7 d8 d9 d10
                  e1 e2 e3 e4 e5 e6 e7 e8 e9 e10)))
172
    (%f 1 2 3 4 5 6 7 8 9 10
sds's avatar
sds committed
173 174 175 176
        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))
177 178 179 180 181
  1275)

;;; labels works with the maximum number of arguments (if
;;; not too many.)
(deftest labels.20
182
  (let* ((n (min (1- lambda-parameters-limit) 1024))
sds's avatar
sds committed
183
         (vars (loop repeat n collect (gensym))))
184
    (eval
185
     `(eqlt ,n
sds's avatar
sds committed
186 187
            (labels ((%f ,vars (+ ,@ vars)))
              (%f ,@(loop for e in vars collect 1))))))
188 189 190 191 192
  t)

;;; Declarations and documentation strings are ok
(deftest labels.21
  (labels ((%f (x)
sds's avatar
sds committed
193 194 195
             (declare (type fixnum x))
             "Add one to the fixnum x."
             (1+ x)))
196
    (declare (ftype (function (fixnum) integer) %f))
197 198
    (%f 10))
  11)
199 200 201 202

;;; Keywords can be function names
(deftest labels.22
  (labels ((:foo () 10)
sds's avatar
sds committed
203
           (:bar () (1+ (:foo))))
204 205 206 207 208
    (:bar))
  11)

(deftest labels.23
  (labels ((:foo () 10)
sds's avatar
sds committed
209
           (:bar () (1+ (funcall #':foo))))
210 211
    (funcall #':bar))
  11)
212 213 214

(deftest labels.24
  (loop for s in *cl-non-function-macro-special-operator-symbols*
sds's avatar
sds committed
215 216 217 218 219 220 221
        for form = `(ignore-errors (labels ((,s (x) (foo (1- x)))
                                            (foo (y)
                                                 (if (<= y 0) 'a
                                                   (,s (1- y)))))
                                     (,s 10)))
        unless (eq (eval form) 'a)
        collect s)
222 223 224 225
  nil)

(deftest labels.25
  (loop for s in *cl-non-function-macro-special-operator-symbols*
sds's avatar
sds committed
226 227 228 229 230 231 232 233 234 235
        for form = `(ignore-errors
                     (labels ((,s (x) (foo (1- x)))
                              (foo (y)
                                   (if (<= y 0) 'a
                                     (,s (1- y)))))
                       (declare (ftype (function (integer) symbol)
                                       foo ,s))
                       (,s 10)))
        unless (eq (eval form) 'a)
        collect s)
236 237 238 239
  nil)

(deftest labels.26
  (loop for s in *cl-non-function-macro-special-operator-symbols*
sds's avatar
sds committed
240 241 242 243 244 245 246
        for form = `(ignore-errors
                     (labels (((setf ,s) (&rest args)
                               (declare (ignore args))
                               'a))
                       (setf (,s) 10)))
        unless (eq (eval form) 'a)
        collect s)
247
  nil)
248 249 250 251 252 253 254 255 256

;;; Check that LABELS does not have a tagbody
(deftest labels.27
  (block done
    (tagbody
     (labels ((%f () (go 10) 10 (return-from done 'bad)))
       (%f))
     10
     (return-from done 'good)))
257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
  good)

;;; Check that nil keyword arguments do not enable the default values

(deftest labels.28
  (labels ((%f (&key (a 'wrong)) a)) (%f :a nil))
  nil)

(deftest labels.29
  (labels ((%f (&key (a 'wrong a-p)) (list a (not a-p)))) (%f :a nil))
  (nil nil))

(deftest labels.30
  (labels ((%f (&key ((:a b) 'wrong)) b)) (%f :a nil))
  nil)

(deftest labels.31
  (labels ((%f (&key ((:a b) 'wrong present?)) (list b (not present?))))
    (%f :a nil))
  (nil nil))

(deftest labels.32
  (labels ((%f (&key) 'good))
    (%f :allow-other-keys nil))
  good)

(deftest labels.33
  (labels ((%f (&key) 'good))
    (%f :allow-other-keys t))
  good)

(deftest labels.34
  (labels ((%f (&key) 'good))
    (%f :allow-other-keys t :a 1 :b 2))
  good)

(deftest labels.35
  (labels ((%f (&key &allow-other-keys) 'good))
    (%f :a 1 :b 2))
  good)
297 298 299 300 301 302

;;; NIL as a disallowed keyword argument
(deftest labels.36
  (signals-error
   (labels ((%f (&key) :bad)) (%f nil nil))
   program-error)
303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329
  t)

;;; Identity of function objects
;;; Since (FUNCTION <name>) returns *the* functional value, it
;;; should be the case that different invocations of this form
;;; in the same lexical environment return the same value.

(deftest labels.37
  (labels ((f () 'foo))
    (eqt #'f #'f))
  t)

(deftest labels.38
  (labels ((f () 'foo))
    (destructuring-bind (x y) (loop repeat 2 collect #'f) (eqlt x y)))
  t)

(deftest labels.39
  (labels ((f () #'f))
    (eqlt (f) #'f))
  t)

(deftest labels.40
  (let ((x (labels ((f () #'f)) #'f)))
    (eqlt x (funcall x)))
  t)

330 331 332 333 334 335 336
;;; Test that free declarations do not affect argument forms

(deftest labels.41
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels ((%f (&optional (y x))
sds's avatar
sds committed
337 338 339
                   (declare (special x))
                   y))
        (%f))))
340 341 342 343 344 345 346
  :good)

(deftest labels.42
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels ((%f (&key (y x))
sds's avatar
sds committed
347 348 349
                   (declare (special x))
                   y))
        (%f))))
350 351
  :good)

pfdietz's avatar
pfdietz committed
352 353 354 355 356 357 358
(deftest labels.43
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels () (declare (special x)))
      x))
  :good)
359

pfdietz's avatar
pfdietz committed
360 361 362 363 364 365 366 367 368 369 370 371 372
(deftest labels.44
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels ((%f () (declare (special x)))))
      x))
  :good)

(deftest labels.45
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels ((%f () (declare (special x))))
sds's avatar
sds committed
373
        x)))
pfdietz's avatar
pfdietz committed
374
  :good)
pfdietz's avatar
pfdietz committed
375 376 377 378 379 380

(deftest labels.46
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels ((%f (&aux (y x))
sds's avatar
sds committed
381 382 383
                   (declare (special x))
                   y))
        (%f))))
pfdietz's avatar
pfdietz committed
384 385 386 387 388 389 390
  :good)

(deftest labels.47
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels ((%f () x))
sds's avatar
sds committed
391 392
        (declare (special x))
        (%f))))
393 394 395 396 397 398
  :good)

;;; Macros are expanded in the appropriate environment

(deftest labels.48
  (macrolet ((%m (z) z))
sds's avatar
sds committed
399
            (labels () (expand-in-current-env (%m :good))))
400 401 402 403
  :good)

(deftest labels.49
  (macrolet ((%m (z) z))
sds's avatar
sds committed
404 405
            (labels ((%f () (expand-in-current-env (%m :good))))
                    (%f)))
406
  :good)
407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437


;;; local function bindings shadow global functions, macros
;;; and compiler-macros



(defun labels.50 () :bad)


(deftest labels.50
   (labels ((labels.50 () :good))
     (labels.50))
   :good)

(defmacro labels.51 () :bad)

(deftest labels.51
   (labels ((labels.51 () :good))
      (labels.51))
   :good)

(define-compiler-macro labels.52 (&whole form)
   :bad)

(deftest labels.52
   (labels ((labels.52 () :good))
     (labels.52))
   :good)