;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Oct  9 19:06:33 2002
;;;; Contains: Tests of LABELS



(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
    (labels ((%f (&optional (x (return-from %f :good)))
               nil))
      (%f)
      :bad))
  :good)

;;; 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)))
               nil))
      (%f)
      :bad))
  :good)

(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)))
               20))
      (%f)
      :bad))
  10)

;;; The function is visible inside itself
(deftest labels.7
  (labels ((%f (x n) (cond ((eql n 0) x)
                           (t (%f (+ x n) (1- n))))))
    (%f 0 10))
  55)

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

(deftest labels.7b
  (labels ((%f (x &aux (b (%g x))) b)
           (%g (y) (+ y y)))
    (%f 10))
  20)

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

(deftest labels.7c
  (labels ((%f (x &optional (b (%g x))) b)
           (%g (y) (+ y y)))
    (%f 10))
  20)

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

(deftest labels.7d
  (labels ((%f (x &key (b (%g x))) b)
           (%g (y) (+ y y)))
    (%f 10))
  20)

;;; 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
  (signals-error
   (labels ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))
   program-error)
  t)

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

;;; Too few arguments (section 3.5.1.2)
(deftest labels.14
  (signals-error (labels ((%f (a) a)) (%f))
                 program-error)
  t)

;;; Too many arguments (section 3.5.1.3)
(deftest labels.15
  (signals-error (labels ((%f (a) a)) (%f 1 2))
                 program-error)
  t)

;;; Invalid keyword argument (section 3.5.1.5)
(deftest labels.16
  (signals-error (labels ((%f (&key a) a)) (%f '(foo)))
                 program-error)
  t)

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

(deftest labels.17
  (labels (((setf %f) (x y) (setf (car y) x)))
    (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
                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)))
    (%f 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))
  1275)

;;; labels works with the maximum number of arguments (if
;;; not too many.)
(deftest labels.20
  (let* ((n (min (1- lambda-parameters-limit) 1024))
         (vars (loop repeat n collect (gensym))))
    (eval
     `(eqlt ,n
            (labels ((%f ,vars (+ ,@ vars)))
              (%f ,@(loop for e in vars collect 1))))))
  t)

;;; Declarations and documentation strings are ok
(deftest labels.21
  (labels ((%f (x)
             (declare (type fixnum x))
             "Add one to the fixnum x."
             (1+ x)))
    (declare (ftype (function (fixnum) integer) %f))
    (%f 10))
  11)

;;; Keywords can be function names
(deftest labels.22
  (labels ((:foo () 10)
           (:bar () (1+ (:foo))))
    (:bar))
  11)

(deftest labels.23
  (labels ((:foo () 10)
           (:bar () (1+ (funcall #':foo))))
    (funcall #':bar))
  11)

(deftest labels.24
  (loop for s in *cl-non-function-macro-special-operator-symbols*
        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)
  nil)

(deftest labels.25
  (loop for s in *cl-non-function-macro-special-operator-symbols*
        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)
  nil)

(deftest labels.26
  (loop for s in *cl-non-function-macro-special-operator-symbols*
        for form = `(ignore-errors
                     (labels (((setf ,s) (&rest args)
                               (declare (ignore args))
                               'a))
                       (setf (,s) 10)))
        unless (eq (eval form) 'a)
        collect s)
  nil)

;;; 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)))
  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)

;;; NIL as a disallowed keyword argument
(deftest labels.36
  (signals-error
   (labels ((%f (&key) :bad)) (%f nil nil))
   program-error)
  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)

;;; 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))
                   (declare (special x))
                   y))
        (%f))))
  :good)

(deftest labels.42
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels ((%f (&key (y x))
                   (declare (special x))
                   y))
        (%f))))
  :good)

(deftest labels.43
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels () (declare (special x)))
      x))
  :good)

(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))))
        x)))
  :good)

(deftest labels.46
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels ((%f (&aux (y x))
                   (declare (special x))
                   y))
        (%f))))
  :good)

(deftest labels.47
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (labels ((%f () x))
        (declare (special x))
        (%f))))
  :good)

;;; Macros are expanded in the appropriate environment

(deftest labels.48
  (macrolet ((%m (z) z))
            (labels () (expand-in-current-env (%m :good))))
  :good)

(deftest labels.49
  (macrolet ((%m (z) z))
            (labels ((%f () (expand-in-current-env (%m :good))))
                    (%f)))
  :good)


;;; 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)