sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cmp: fix multiple-value-setq for special variables

Browse source 
We need to save env->nvalues before calling cl_set on any variable
because cl_set overwrites env->nvalues. Otherwise, we only get nil for
any variable after the first special one.

Fixes #591.
This commit is contained in:
Marius Gerbershagen 2020-05-28 21:20:17 +02:00
parent 2e337edcf9
commit e89dce9631
2 changed files with 43 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
src/cmp/cmpmulti.lsp
View file

@ -191,27 +191,32 @@
;; At least we always have NIL value0
(setf min-values (max 1 min-values))
;; We know that at least MIN-VALUES variables will get a value
(dotimes (i min-values)
(when vars
(let ((v (pop vars))
(loc (values-loc-or-value0 i)))
(bind-or-set loc v use-bind))))
(let* ((*lcl* *lcl*)
(useful-extra-vars (some #'useful-var-p (nthcdr min-values vars)))
(nr (make-lcl-var :type :int)))
(wt-nl-open-brace)
(when useful-extra-vars
;; Make a copy of env->nvalues before assigning to any variables
(wt-nl "const int " nr " = cl_env_copy->nvalues;"))
(when (some #'useful-var-p vars)
(let* ((*lcl* *lcl*)
(nr (make-lcl-var :type :int))
(tmp (make-lcl-var)))
(wt-nl-open-brace)
(wt-nl "const int " nr " = cl_env_copy->nvalues;")
(wt-nl "cl_object " tmp ";")
(loop for v in vars
for i from min-values
for loc = (values-loc-or-value0 i)
do (when (useful-var-p v)
(wt-nl tmp " = (" nr "<=" i ")? ECL_NIL : " loc ";")
(bind-or-set tmp v use-bind)))
(wt-nl-close-brace)))
;; We know that at least MIN-VALUES variables will get a value
(dotimes (i min-values)
(when vars
(let ((v (pop vars))
(loc (values-loc-or-value0 i)))
(bind-or-set loc v use-bind))))
;; Assign to other variables only when the form returns enough values
(when useful-extra-vars
(let ((tmp (make-lcl-var)))
(wt-nl "cl_object " tmp ";")
(loop for v in vars
for i from min-values
for loc = (values-loc-or-value0 i)
do (when (useful-var-p v)
(wt-nl tmp " = (" nr "<=" i ")? ECL_NIL : " loc ";")
(bind-or-set tmp v use-bind)))))
(wt-nl-close-brace))
'VALUE0))
(defun c2multiple-value-setq (c1form vars form)

18
src/tests/normal-tests/compiler.lsp
View file

@ -1903,3 +1903,21 @@
(let ((my-new-val 42))
(bam my-new-val)))))
(eq :banzai (bam 30))))))))
;;; Date 2020-05-28
;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/issues/591
;;; Description
;;;
;;; MULTIPLE-VALUE-SETQ would wrongly assign NIL to special variables
;;; due to not saving env->nvalues before calling SET
(ext:with-clean-symbols (*a* *b* foo)
(defvar *a* :wrong-a)
(defvar *b* :wrong-b)
(defun foo () (values :right-a :right-b))
(test cmp.0081.m-v-setq-special
(is (funcall (compile
nil
'(lambda ()
(multiple-value-setq (*a* *b*) (foo))
(and (eq *a* :right-a)
(eq *b* :right-b))))))))