From 0ce89f53c47c6caa28d07da2aada2944802e0cf5 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 20 Dec 2020 09:09:54 -0700
Subject: [PATCH] Chez Scheme: repair for `call-with-values ... values` cp0
 conversion

Closes #3576
---
 pkgs/racket-test-core/tests/racket/syntax.rktl | 12 ++++++++++++
 racket/src/ChezScheme/mats/cp0.ms              | 12 ++++++++++++
 racket/src/ChezScheme/s/cp0.ss                 |  2 +-
 3 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/pkgs/racket-test-core/tests/racket/syntax.rktl b/pkgs/racket-test-core/tests/racket/syntax.rktl
index 4dd8f5a1b2..ba1c7198cf 100644
--- a/pkgs/racket-test-core/tests/racket/syntax.rktl
+++ b/pkgs/racket-test-core/tests/racket/syntax.rktl
@@ -2358,6 +2358,18 @@
                        (set! i (add1 i))
                        (+ i 1)))))
 
+
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Regression test to make sure a `values` wrapper is not
+;; discarded:
+
+(err/rt-test (for/fold ([x 0]
+                        [y 0])
+                       ([i '(1)])
+               (values (values x y)))
+             exn:fail:contract:arity?)
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)
diff --git a/racket/src/ChezScheme/mats/cp0.ms b/racket/src/ChezScheme/mats/cp0.ms
index 25ca4005cb..b59d983b81 100644
--- a/racket/src/ChezScheme/mats/cp0.ms
+++ b/racket/src/ChezScheme/mats/cp0.ms
@@ -377,6 +377,18 @@
        '(lambda (x)
           (#3%$value (if x 1 (#2%values 3 3 3)))
           #t)))
+
+  (not
+   (equivalent-expansion?
+    (expand/optimize
+     '(lambda (g x y)
+        (call-with-values (lambda ()
+                            (values
+                             (values x y)))
+          (case-lambda
+           [(x y) (g x y)]))))
+    '(lambda (g x y) (g x y))))
+
 )
 
 (cp0-mat cp0-mrvs
diff --git a/racket/src/ChezScheme/s/cp0.ss b/racket/src/ChezScheme/s/cp0.ss
index 854a1104a4..3ec7595e5d 100644
--- a/racket/src/ChezScheme/s/cp0.ss
+++ b/racket/src/ChezScheme/s/cp0.ss
@@ -2457,7 +2457,7 @@
         [(p-opnd c-opnd)
          (let ((p-temp (cp0-make-temp #f)) (c-temp (cp0-make-temp #f)))
            (with-extended-env ((env ids) (empty-env (list p-temp c-temp) (app-opnds ctxt)))
-             (let ((ctxt1 (make-app '() 'value 'call #f (app-preinfo ctxt))))
+             (let ((ctxt1 (make-app '() 'tail 'call #f (app-preinfo ctxt))))
                (let ((*p-val (cp0 (build-ref p-temp) ctxt1 env sc wd #f moi)))
                  (cond
                    [(and (app-used ctxt1)