From e89dce96315f1281dba433cebd920593173e4774 Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Thu, 28 May 2020 21:20:17 +0200
Subject: [PATCH] cmp: fix multiple-value-setq for special variables

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.
---
 src/cmp/cmpmulti.lsp                | 45 ++++++++++++++++-------------
 src/tests/normal-tests/compiler.lsp | 18 ++++++++++++
 2 files changed, 43 insertions(+), 20 deletions(-)

diff --git a/src/cmp/cmpmulti.lsp b/src/cmp/cmpmulti.lsp
index a27c66932..96ffbe030 100644
--- a/src/cmp/cmpmulti.lsp
+++ b/src/cmp/cmpmulti.lsp
@@ -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)
diff --git a/src/tests/normal-tests/compiler.lsp b/src/tests/normal-tests/compiler.lsp
index 4d592e636..f64b9689c 100644
--- a/src/tests/normal-tests/compiler.lsp
+++ b/src/tests/normal-tests/compiler.lsp
@@ -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))))))))