From: Christophe Rhodes Date: Thu, 14 Nov 2013 17:36:21 +0000 (+0000) Subject: fix another LET*/:interpret bug X-Git-Url: http://repo.macrolet.net/gitweb/?p=sbcl.git;a=commitdiff_plain;h=5eb98a1de601302b0e3eb0c385262fca9093fcc0 fix another LET*/:interpret bug reported by Douglas Katzman sbcl-devel 2013-09-08 --- diff --git a/src/code/full-eval.lisp b/src/code/full-eval.lisp index 343b138..08f8cb6 100644 --- a/src/code/full-eval.lisp +++ b/src/code/full-eval.lisp @@ -371,28 +371,23 @@ ;; due to function calls. (see PARSE-ARGUMENTS) (if (and (consp exp) (eq (car exp) 'quote)) (second exp) - (%eval exp env))) - (maybe-new-env (env exp) - (if (and (consp exp) (eq (car exp) 'quote)) - env - (make-env :parent env)))) + (%eval exp env)))) (if bindings (let* ((binding-name (car (car bindings))) - (binding-value (cdr (car bindings)))) + (binding-value (cdr (car bindings))) + (new-env (make-env :parent env))) (if (specialp binding-name specials) (progv (list binding-name) (list (maybe-eval binding-value)) ;; Mark the variable as special in this environment - (push-var binding-name *special* env) + (push-var binding-name *special* new-env) (eval-next-let*-binding - (cdr bindings) specials - (maybe-new-env env binding-value) end-action)) + (cdr bindings) specials new-env end-action)) (progn - (push-var binding-name (maybe-eval binding-value) env) + (push-var binding-name (maybe-eval binding-value) new-env) (eval-next-let*-binding - (cdr bindings) specials - (maybe-new-env env binding-value) end-action)))) + (cdr bindings) specials new-env end-action)))) (funcall end-action env)))) ;;; Create a new environment based on OLD-ENV by adding the variable diff --git a/tests/full-eval.impure.lisp b/tests/full-eval.impure.lisp index 54a9151..540e6de 100644 --- a/tests/full-eval.impure.lisp +++ b/tests/full-eval.impure.lisp @@ -99,3 +99,8 @@ (x (progn (funcall *stash* :after-binding-z) 'new-x))) (funcall *stash* :in-body) (values)))) + +(with-test (:name (let* :nested-environment-again)) + (let* ((foo 3) + (foo (lambda () (typep foo 'integer)))) + (assert (funcall foo))))