From 27fd1769686fb6757f5918da579d1d9b10632ad8 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 24 Jun 2020 06:06:46 -0600
Subject: [PATCH] cs: fix mutability check on prefab auto fields

Also, fix the error message for misuse of a mutator.
---
 .../racket-test-core/tests/racket/struct.rktl | 23 +++++++++++++++++++
 racket/src/cs/rumble/impersonator.ss          |  6 +++--
 racket/src/cs/rumble/prefab.ss                |  2 +-
 racket/src/cs/rumble/struct.ss                | 22 +++++++++---------
 4 files changed, 39 insertions(+), 14 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/struct.rktl b/pkgs/racket-test-core/tests/racket/struct.rktl
index db634624f1..98911c0fcc 100644
--- a/pkgs/racket-test-core/tests/racket/struct.rktl
+++ b/pkgs/racket-test-core/tests/racket/struct.rktl
@@ -1286,6 +1286,29 @@
   (-set! v 3 'ok)
   (test 'ok -ref v 3))
 
+;; ----------------------------------------
+;; Check that prefab auto fields count as mutable
+
+(let ()
+  (struct flag ([x #:auto #:mutable]) #:prefab)
+  (define f (flag))
+  (set-flag-x! f 'ok)
+  (test 'ok flag-x f)
+
+  (err/rt-test (set-flag-x! 'no 'way) exn:fail:contract? #rx"^set-flag-x!:")
+
+  (define f2 (read (open-input-string "#s((flag (1 #f)) #f)")))
+  (test #f flag-x f2)
+  (set-flag-x! f2 'ok)
+  (test 'ok flag-x f2)
+
+  (struct flag-3d flag (y [z #:auto #:mutable]) #:prefab)
+  (define f3 (flag-3d 'y))
+  (set-flag-x! f3 'three)
+  (test 'three flag-x f3)
+  (set-flag-3d-z! f3 'zee)
+  (test 'zee flag-3d-z f3))
+
 ;; ----------------------------------------
 ;; Make sure that a JIT-inlined predicate doesn't
 ;; fail improperly on chaperones and struct types
diff --git a/racket/src/cs/rumble/impersonator.ss b/racket/src/cs/rumble/impersonator.ss
index e0ef67469b..a595b5ec6f 100644
--- a/racket/src/cs/rumble/impersonator.ss
+++ b/racket/src/cs/rumble/impersonator.ss
@@ -139,10 +139,12 @@
           (unsafe-struct*-set! v abs-pos a)])))]
    [else
     (raise-argument-error (string->symbol
-                           (string-append "set"
+                           (string-append "set-"
                                           (symbol->string (or record-name 'struct))
                                           "-"
-                                          (symbol->string (or field-name 'field))
+                                          (if field-name
+                                              (symbol->string field-name)
+                                              (string-append "field" (number->string pos)))
                                           "!"))
                           (string-append (symbol->string (or record-name 'struct)) "?")
                           orig)]))
diff --git a/racket/src/cs/rumble/prefab.ss b/racket/src/cs/rumble/prefab.ss
index 0762181d8c..543cc63fb3 100644
--- a/racket/src/cs/rumble/prefab.ss
+++ b/racket/src/cs/rumble/prefab.ss
@@ -313,7 +313,7 @@
         vec
         (list->vector
          (append (vector->list vec)
-                 (let loop ([auto auto] [pos (fx- init+auto-count auto 1)])
+                 (let loop ([auto auto] [pos (fx- init+auto-count auto)])
                    (if (fx= auto 0)
                        '()
                        (cons pos (loop (fx- auto 1) (fx+ pos 1))))))))))
diff --git a/racket/src/cs/rumble/struct.ss b/racket/src/cs/rumble/struct.ss
index e6c304678a..513a8df749 100644
--- a/racket/src/cs/rumble/struct.ss
+++ b/racket/src/cs/rumble/struct.ss
@@ -750,24 +750,24 @@
       (let* ([abs-pos (+ pos (position-based-mutator-offset pbm))]
              [p (record-field-mutator rtd abs-pos)]
              [rec-name (record-type-name rtd)]
-             [name (string->symbol
-                    (string-append "set-"
-                                   (symbol->string rec-name)
-                                   "-"
-                                   (if name
-                                       (symbol->string name)
-                                       (string-append "field" (number->string pos)))
-                                   "!"))]
+             [mut-name (string->symbol
+                        (string-append "set-"
+                                       (symbol->string rec-name)
+                                       "-"
+                                       (if name
+                                           (symbol->string name)
+                                           (string-append "field" (number->string pos)))
+                                       "!"))]
              [wrap-p
               (procedure-rename
                (if (struct-type-field-mutable? rtd pos)
                    (lambda (v a)
                      (if (record? v rtd)
                          (p v a)
-                         (impersonate-set! p rtd pos abs-pos v a rec-name (or name 'field))))
+                         (impersonate-set! p rtd pos abs-pos v a rec-name name)))
                    (lambda (v a)
-                     (cannot-modify-by-pos-error name v pos)))
-               name)])
+                     (cannot-modify-by-pos-error mut-name v pos)))
+               mut-name)])
         (register-struct-field-mutator! wrap-p rtd pos)
         wrap-p))]
    [(pbm pos)