From e56d8c5ded80d167b86c331f31b326616b49525e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 15 Jan 2021 12:18:53 -0700
Subject: [PATCH] cs: fix `make-ctype` on converter that accepts extra
 arguments

Related to #3457
---
 .../tests/racket/foreign-test.rktl                | 15 +++++++++++++++
 racket/src/cs/rumble/foreign.ss                   | 12 ++++++++++--
 2 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl
index efeb58804b..89e40796d9 100644
--- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl
+++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl
@@ -1539,6 +1539,21 @@
   (test #f register-process-global bstr #f)
   (test #"data" cast (register-process-global orig-bstr #"data\0") _pointer _bytes))
 
+;; ----------------------------------------
+;; Make sure `make-ctype` is not confused by a conversion function that
+;; could have extra arguments
+
+(let ()
+  (define _strnum (make-ctype _int
+                              (lambda (s [ignored 'ignore-me])
+                                (test 'ignore-me values ignored)
+                                (string->number s))
+                              (lambda (n [ignored 'ignore-me])
+                                (test 'ignore-me values ignored)
+                                (number->string n))))
+  (test 5 cast "5" _strnum _int)
+  (test "5" cast 5 _int _strnum))
+
 ;; ----------------------------------------
 
 (report-errs)
diff --git a/racket/src/cs/rumble/foreign.ss b/racket/src/cs/rumble/foreign.ss
index 7a73ff74a1..bb7312f425 100644
--- a/racket/src/cs/rumble/foreign.ss
+++ b/racket/src/cs/rumble/foreign.ss
@@ -315,7 +315,7 @@
     (create-compound-ctype (ctype-host-rep type)
                            (ctype-our-rep type)
                            type
-                           racket-to-c
+                           (protect-racket-to-c racket-to-c)
                            c-to-racket
                            (compound-ctype-get-decls type)
                            (compound-ctype-size type)
@@ -325,9 +325,17 @@
     (create-ctype (ctype-host-rep type)
                   (ctype-our-rep type)
                   type
-                  racket-to-c
+                  (protect-racket-to-c racket-to-c)
                   c-to-racket)]))
 
+(define (protect-racket-to-c racket-to-c)
+  ;; Make sure `racket-to-c` is not confused for an internal
+  ;; variant that accepts a `who` argument:
+  (if (and (#%procedure? racket-to-c)
+           (chez:procedure-arity-includes? racket-to-c 2))
+      (lambda (v) (racket-to-c v))
+      racket-to-c))
+
 ;; Apply all the conversion wrappers of `type` to the Scheme value `v`
 (define (s->c who type v)
   (let* ([racket-to-c (ctype-scheme->c type)]