;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Jun 24 20:53:36 2005
;;;; Contains: Tests for LET*



(deftest let*.1
  (let* ((x 0)) x)
  0)

(deftest let*.2
  (let* ((x 0) (y 1)) (values x y))
  0 1)

(deftest let*.3
  (let* ((x 0) (y 1)) (declare (special x y)) (values x y))
  0 1)

(deftest let*.4
  (let* ((x 0))
    (let* ((x 1))
      x))
  1)

(deftest let*.5
  (let* ((x 0))
    (let* ((#:x 1))
      x))
  0)

(deftest let*.6
  (let* ((x 0))
    (declare (special x))
    (let* ((x 1))
      (values x (locally (declare (special x)) x))))
  1 0)

(deftest let*.7
  (let* ((x '(a b c)))
    (declare (dynamic-extent x))
    x)
  (a b c))

(deftest let*.8
  (let* ((x 0) (x 1)) x)
  1)

(deftest let*.9
  (let* (x y z) (values x y z))
  nil nil nil)

(deftest let*.10
  (let* ((x 1) x) x)
  nil)

(deftest let*.11
  (let* ((x 1))
    (list x
          (let* (x x x)
            (declare (special x))
            x)
          x))
  (1 nil 1))

(deftest let*.12
  (let* ((x 1)
         (y (1+ x))
         (x (1+ y))
         (z (+ x y)))
    (values x y z))
  3 2 5)

;;; (deftest let*.13
;;;  (flet ((%f () (declare (special x)) x))
;;;    (let* ((x 1)
;;;        (x (1+ (%f))))
;;;      (declare (special x))
;;;      x))
;;;  2)

;;; Tests of large number of LET* variables
(deftest let*.14
  (let* ((n 100)
         (vars (mapcar #'gensym (make-list n :initial-element "G")))
         (expr `(let* ,(let ((i 0))
                         (mapcar #'(lambda (v) (list v (incf i))) vars))
                  ,(let ((sumexpr 0))
                     (dolist (v vars)
                       (setq sumexpr `(+ ,v ,sumexpr)))
                     sumexpr)))
         (val (eval expr)))
    (or (eqlt val (/ (* n (1+ n)) 2)) (list val)))
  t)

;;; Test that all non-variables exported from COMMON-LISP can be bound
;;; in LET* forms.
(deftest let*.15
  (loop for s in *cl-non-variable-constant-symbols*
        for form = `(ignore-errors (let* ((,s 17)) ,s))
        unless (eql (eval form) 17)
        collect s)
  nil)

;;; Check that LET* does not have a tagbody
(deftest let*.16
  (block done
    (tagbody
     (let () (go 10) 10 (return-from done 'bad))
     10
     (return-from done 'good)))
  good)

;;; Check that free declarations do not apply to the init forms

(deftest let*.17
  (let ((x :bad))
    (declare (special x))
    (let ((x :good)) ;; lexical binding
      (let* ((y x))
        (declare (special x)) ;; free declaration
        y)))
  :good)

(deftest let*.17a
  (funcall
   (compile
    nil
    '(lambda ()
       (let ((x :bad))
         (declare (special x))
         (let ((x :good)) ;; lexical binding
           (let* ((y x))
             (declare (special x)) ;; free declaration
             y))))))
  :good)

(deftest let*.18
  (let ((x :bad1)
        (z :bad2))
    (declare (special x z))
    (let ((x :good)
          (z :good)) ;; lexical bindings
      (let* ((y x)
             (w z))
        (declare (special x)) ;; free declaration
        (values y w))))
  :good
  :good)

(deftest let*.19
  (let ((foo 'special))
    (declare (special foo))
    (let* ((foo 'lexical))
      (locally (declare (special foo)))
      foo))
  lexical)

(deftest let*.20
  (loop for k in lambda-list-keywords
        unless (eql (eval `(let* ((,k :foo)) ,k)) :foo)
        collect k)
  nil)

;;; Macros are expanded in the appropriate environment

(deftest let*.21
  (macrolet ((%m (z) z))
            (let* () (expand-in-current-env (%m :good))))
  :good)

(deftest let*.22
  (macrolet ((%m (z) z))
            (let* ((x (expand-in-current-env (%m 1)))) (+ x x x)))
  3)

(deftest let*.23
  (macrolet ((%m (z) z))
            (let* ((x (expand-in-current-env (%m 1)))
                   (y (expand-in-current-env (%m 2))))
              (+ x y)))
  3)