From 483afea5988aabbfb9b469b6ec377e843d5c6782 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Fri, 9 Dec 2005 15:50:20 +0000
Subject: [PATCH] Fix bug reported by Drew McDermott, cmucl-help, 2005/12/07.

(defun spunk (a b)
   (let (k m p q)
      (multiple-value-setq
         (k m p q)
        (the (values t t t t)
          (punk a b)))))


Remove the assertion that the values type must have no required args
and adjust maybe-negate-check appropriately.  (This last from Alexey
Dejneka.)
---
 compiler/checkgen.lisp | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/compiler/checkgen.lisp b/compiler/checkgen.lisp
index e7af2db27..ee3105205 100644
--- a/compiler/checkgen.lisp
+++ b/compiler/checkgen.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.33 2003/05/08 14:52:04 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.34 2005/12/09 15:50:20 rtoy Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -329,8 +329,9 @@
 	    ((and (mv-combination-p dest)
 		  (eq (basic-combination-kind dest) :local))
 	     (assert (values-type-p atype))
-	     (assert (null (args-type-required atype)))
-	     (maybe-negate-check cont (args-type-optional atype) force-hairy))
+	     (maybe-negate-check cont (append (args-type-required atype)
+					      (args-type-optional atype))
+				 force-hairy))
 	    ((or (exit-p dest) (return-p dest) (mv-combination-p dest))
 	     (values :too-hairy nil))
 	    (t
-- 
GitLab