let.lsp 3.51 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Oct 12 09:24:36 2002
;;;; Contains: Tests for LET, LET*

6

pfdietz's avatar
pfdietz committed
7 8 9

;;; LET and LET* are also heavily exercised in the many other tests.

10 11 12 13
;;; NOTE!  Some of these tests bind a variable with the same name
;;; more than once.  This apparently has underdetermined semantics that
;;; varies in different Lisps.

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

51 52 53
;;;(deftest let.8
;;;  (let ((x 0) (x 1)) x)
;;;  1)
pfdietz's avatar
pfdietz committed
54 55 56 57 58

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

59 60 61
;;; (deftest let.10
;;;  (let ((x 1) x) x)
;;;  nil)
pfdietz's avatar
pfdietz committed
62 63 64 65

(deftest let.11
  (let ((x 1))
    (list x
sds's avatar
sds committed
66 67 68 69
          (let (x)
            (declare (special x))
            x)
          x))
pfdietz's avatar
pfdietz committed
70 71
  (1 nil 1))

72 73 74 75
;;; (deftest let.12
;;;  (let ((x 0))
;;;    (values
;;;     (let ((x 20)
sds's avatar
sds committed
76
;;;        (x (1+ x)))
77 78 79 80 81 82
;;;       x)
;;;     x))
;;;   1 0)

;;; (deftest let.13
;;;  (flet ((%f () (declare (special x))
sds's avatar
sds committed
83
;;;          (if (boundp 'x) x 10)))
84
;;;    (let ((x 1)
sds's avatar
sds committed
85
;;;       (x (1+ (%f))))
86 87 88
;;;      (declare (special x))
;;;      x))
;;;  11)
pfdietz's avatar
pfdietz committed
89

90 91
;;; Tests of large number of LET variables
(deftest let.14
pfdietz's avatar
pfdietz committed
92
  (let* ((n 100)
sds's avatar
sds committed
93 94 95 96 97 98 99 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)))
101 102 103
    (or (eqlt val (/ (* n (1+ n)) 2)) (list val)))
  t)

104 105 106 107
;;; 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
108 109 110
        for form = `(ignore-errors (let ((,s 17)) ,s))
        unless (eql (eval form) 17)
        collect s)
111 112
  nil)

113 114 115 116 117 118 119 120 121
;;; 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)

122 123 124 125 126 127 128
;;; 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
129 130
        (declare (special x)) ;; free declaration
        y)))
131
  :good)
132

pfdietz's avatar
pfdietz committed
133 134 135 136 137 138
(deftest let.17a
  (funcall
   (compile
    nil
    '(lambda ()
       (let ((x :bad))
sds's avatar
sds committed
139 140 141 142 143
         (declare (special x))
         (let ((x :good)) ;; lexical binding
           (let ((y x))
             (declare (special x)) ;; free declaration
             y))))))
pfdietz's avatar
pfdietz committed
144 145 146 147 148 149 150 151 152 153
  :good)

(deftest let.18
  (let ((foo 'special))
    (declare (special foo))
    (let ((foo 'lexical))
      (locally (declare (special foo)))
      foo))
  lexical)

154 155
(deftest let.19
  (loop for k in lambda-list-keywords
sds's avatar
sds committed
156 157
        unless (eql (eval `(let ((,k :foo)) ,k)) :foo)
        collect k)
158
  nil)
159 160 161 162 163

;;; Macros are expanded in the appropriate environment

(deftest let.20
  (macrolet ((%m (z) z))
sds's avatar
sds committed
164
            (let () (expand-in-current-env (%m :good))))
165 166 167 168
  :good)

(deftest let.21
  (macrolet ((%m (z) z))
sds's avatar
sds committed
169
            (let ((x (expand-in-current-env (%m 1)))) (+ x x x)))
170
  3)