cs & io: fix caching of locale converters

Fix an interaction with custodians and byte converters that are
used by `string-locale<?`, `string->bytes/locale`, etc.

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "7.5.0.1")
+(define version "7.5.0.2")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-test/tests/racket/locale-cache.rkt

@@ -0,0 +1,12 @@
+#lang racket/base
+
+;; Probably locale-sensitive string comparisons are not justed just by
+;; starting up, so the first `string-locale<?` will trigger the
+;; creation of a byte converter on most Unix platforms. Make sure
+;; that a cached converted is not connected to custodian.
+
+(define c (make-custodian))
+(parameterize ([current-custodian c])
+  (void (string-locale<? "a" "b")))
+(custodian-shutdown-all c)
+(void (string-locale<? "a" "b"))

racket/src/io/converter/main.rkt

@@ -13,7 +13,8 @@
          bytes-convert-end)
 
 (module+ reset
-  (provide bytes-reset-converter))
+  (provide bytes-open-converter-in-custodian
+           bytes-reset-converter))
 
 (struct bytes-converter ([c #:mutable]
                          [custodian-reference #:mutable]))
@@ -27,7 +28,7 @@
 (define platform-utf-8-permissive (if windows? 'utf-8-ish-permissive 'utf-8-permissive))
 (define platform-utf-16 (if windows? 'utf-16-ish 'utf-16-assume))
 
-(define/who (bytes-open-converter from-str to-str)
+(define (bytes-open-converter-in-custodian who cust from-str to-str)
   (check who string? from-str)
   (check who string? to-str)
   (cond
@@ -70,7 +71,7 @@
         #f]
        [else
         (start-atomic)
-        (check-current-custodian who)
+        (unless cust (check-current-custodian who))
         (define c (rktio_converter_open rktio
                                         (encoding->bytes who to-str)
                                         (encoding->bytes who from-str)))
@@ -82,11 +83,14 @@
            #f]
           [else
            (define converter (bytes-converter c #f))
-           (define cref (unsafe-custodian-register (current-custodian) converter close-converter #f #f))
+           (define cref (unsafe-custodian-register (or cust (current-custodian)) converter close-converter #f #f))
            (set-bytes-converter-custodian-reference! converter cref)
            (end-atomic)
            converter])])]))
 
+(define/who (bytes-open-converter from-str to-str)
+  (bytes-open-converter-in-custodian who #f from-str to-str))
+
 ;; ----------------------------------------
 
 ;; in atomic mode
@@ -235,6 +239,6 @@
 
 ;; in atomic mode
 (define (bytes-reset-converter converter)
-  (define c  (bytes-converter-c converter))
+  (define c (bytes-converter-c converter))
   (unless (utf-8-converter? c)
     (rktio_convert_reset rktio c)))

racket/src/io/host/bootstrap.rkt

@@ -2,7 +2,8 @@
 (require (only-in '#%linklet primitive-table)
          (only-in '#%unsafe
                   unsafe-custodian-register
-                  unsafe-custodian-unregister)
+                  unsafe-custodian-unregister
+                  unsafe-make-custodian-at-root)
          "../../thread/current-sandman.rkt"
          ffi/unsafe/atomic
          (only-in ffi/unsafe
@@ -149,6 +150,7 @@
                          'plumber-flush-handle-remove! plumber-flush-handle-remove!
                          'unsafe-custodian-register unsafe-custodian-register
                          'unsafe-custodian-unregister unsafe-custodian-unregister
+                         'unsafe-make-custodian-at-root unsafe-make-custodian-at-root
                          'thread-push-kill-callback! thread-push-kill-callback!
                          'thread-pop-kill-callback! thread-pop-kill-callback!
                          'unsafe-add-pre-poll-callback! (lambda (proc) (void))

racket/src/io/host/thread.rkt

@@ -77,6 +77,7 @@
          in-atomic-mode?
          unsafe-custodian-register
          unsafe-custodian-unregister
+         unsafe-make-custodian-at-root
          thread-push-kill-callback!
          thread-pop-kill-callback!
          unsafe-add-pre-poll-callback!

racket/src/io/locale/cache.rkt

@@ -21,9 +21,11 @@
 (define (new-cache) (cache #f #f #f #f))
 
 (define-place-local local-cache (new-cache))
+(define-place-local converter-custodian (unsafe-make-custodian-at-root))
 
 (define (convert-cache-init!)
-  (set! local-cache (new-cache)))
+  (set! local-cache (new-cache))
+  (set! converter-custodian (unsafe-make-custodian-at-root)))
 
 (define (cache-clear! get update!)
   (define c (get local-cache))
@@ -57,24 +59,21 @@
 
 (define (bytes-open-converter/cached-to enc)
   (or (cache-lookup! enc cache-to set-cache-to!)
-      (bytes-open-converter ucs-4-encoding enc)))
+      (bytes-open-converter-in-custodian 'bytes-open-converter/cached-to converter-custodian ucs-4-encoding enc)))
 
 (define (bytes-open-converter/cached-to2 enc)
   (or (cache-lookup! enc cache-to2 set-cache-to2!)
-      (bytes-open-converter ucs-4-encoding enc)))
+      (bytes-open-converter-in-custodian 'bytes-open-converter/cached-to2 converter-custodian ucs-4-encoding enc)))
 
 (define (bytes-open-converter/cached-from enc)
   (or (cache-lookup! enc cache-from set-cache-from!)
-      (bytes-open-converter enc "UTF-8")))
+      (bytes-open-converter-in-custodian 'bytes-open-converter/cached-from converter-custodian enc "UTF-8")))
 
 (define (bytes-close-converter/cached-to c enc)
-  (or (cache-save! c enc cache-to set-cache-to!)
+  (cache-save! c enc cache-to set-cache-to!))
-      (bytes-close-converter c)))
 
 (define (bytes-close-converter/cached-to2 c enc)
-  (or (cache-save! c enc cache-to2 set-cache-to2!)
+  (cache-save! c enc cache-to2 set-cache-to2!))
-      (bytes-close-converter c)))
 
 (define (bytes-close-converter/cached-from c enc)
-  (or (cache-save! c enc cache-from set-cache-from!)
+  (cache-save! c enc cache-from set-cache-from!))
-      (bytes-close-converter c)))

racket/src/racket/src/schvers.h

@@ -16,7 +16,7 @@
 #define MZSCHEME_VERSION_X 7
 #define MZSCHEME_VERSION_Y 5
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 1
+#define MZSCHEME_VERSION_W 2
 
 /* A level of indirection makes `#` work as needed: */
 #define AS_a_STR_HELPER(x) #x

racket/src/thread/instance.rkt

@@ -65,6 +65,7 @@
           'plumber-flush-handle-remove! plumber-flush-handle-remove!
           'unsafe-custodian-register unsafe-custodian-register
           'unsafe-custodian-unregister unsafe-custodian-unregister
+          'unsafe-make-custodian-at-root unsafe-make-custodian-at-root
           'thread-push-kill-callback! thread-push-kill-callback!
           'thread-pop-kill-callback! thread-pop-kill-callback!
           'unsafe-add-pre-poll-callback! unsafe-add-pre-poll-callback!