letstar.lsp 3.73 KB
Newer Older
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 51 52 53 54 55 56 57 58 59
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Jun 24 20:53:36 2005
;;;; Contains: Tests for LET*

(in-package :cl-test)

(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
sds's avatar
sds committed
60 61 62 63
          (let* (x x x)
            (declare (special x))
            x)
          x))
64 65 66 67
  (1 nil 1))

(deftest let*.12
  (let* ((x 1)
sds's avatar
sds committed
68 69 70
         (y (1+ x))
         (x (1+ y))
         (z (+ x y)))
71 72 73 74 75 76
    (values x y z))
  3 2 5)

;;; (deftest let*.13
;;;  (flet ((%f () (declare (special x)) x))
;;;    (let* ((x 1)
sds's avatar
sds committed
77
;;;        (x (1+ (%f))))
78 79 80 81 82 83 84
;;;      (declare (special x))
;;;      x))
;;;  2)

;;; Tests of large number of LET* variables
(deftest let*.14
  (let* ((n 100)
sds's avatar
sds committed
85 86 87 88 89 90 91 92
         (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)))
93 94 95 96 97 98 99
    (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*
sds's avatar
sds committed
100 101 102
        for form = `(ignore-errors (let* ((,s 17)) ,s))
        unless (eql (eval form) 17)
        collect s)
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
  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))
sds's avatar
sds committed
121 122
        (declare (special x)) ;; free declaration
        y)))
123 124 125 126 127 128 129 130
  :good)

(deftest let*.17a
  (funcall
   (compile
    nil
    '(lambda ()
       (let ((x :bad))
sds's avatar
sds committed
131 132 133 134 135
         (declare (special x))
         (let ((x :good)) ;; lexical binding
           (let* ((y x))
             (declare (special x)) ;; free declaration
             y))))))
136 137 138 139
  :good)

(deftest let*.18
  (let ((x :bad1)
sds's avatar
sds committed
140
        (z :bad2))
141 142
    (declare (special x z))
    (let ((x :good)
sds's avatar
sds committed
143
          (z :good)) ;; lexical bindings
144
      (let* ((y x)
sds's avatar
sds committed
145 146 147
             (w z))
        (declare (special x)) ;; free declaration
        (values y w))))
148 149 150 151 152 153 154 155 156 157 158 159 160
  :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
sds's avatar
sds committed
161 162
        unless (eql (eval `(let* ((,k :foo)) ,k)) :foo)
        collect k)
163
  nil)
164 165 166 167 168

;;; Macros are expanded in the appropriate environment

(deftest let*.21
  (macrolet ((%m (z) z))
sds's avatar
sds committed
169
            (let* () (expand-in-current-env (%m :good))))
170 171 172 173
  :good)

(deftest let*.22
  (macrolet ((%m (z) z))
sds's avatar
sds committed
174
            (let* ((x (expand-in-current-env (%m 1)))) (+ x x x)))
175 176 177 178
  3)

(deftest let*.23
  (macrolet ((%m (z) z))
sds's avatar
sds committed
179 180 181
            (let* ((x (expand-in-current-env (%m 1)))
                   (y (expand-in-current-env (%m 2))))
              (+ x y)))
182 183 184 185
  3)