ffi/unsafe: fix cast from _bytes to _pointer

The `cast` function is supposed to auto-promote its second argument to
a GCable type if the value to convert is a GCable pointer. This
promotion did not happen for `_bytes` and other string-like types.

Also, in CS, `malloc` did not alocate GCable memory by default when
given the `_bytes` type, which would sometimes interfere with getting
a GCable pointer result.

This bug explains why the "draw-test/tests/racket/draw/dc.rkt" test
would occassionally have an `unscaled-alpha-set` failure on DrDr (for
many years).

pkgs/racket-test-core/tests/racket/foreign-test.rktl

@@ -729,6 +729,23 @@
   (test (cast p _thing-pointer _intptr)
         cast q _stuff-pointer _intptr))
 
+;; `cast` should auto-upgrade target pointer types using `_gcable` for a GCable argument
+(test #t cpointer-gcable? (cast #"x" _pointer _pointer))
+(test #t cpointer-gcable? (cast #"x" _gcpointer _pointer))
+(test #t cpointer-gcable? (cast #"x" _pointer _gcpointer))
+(test #t cpointer-gcable? (cast (malloc 8) _pointer _pointer))
+(test #t cpointer-gcable? (cast (malloc 8) _gcpointer _pointer))
+(test #t cpointer-gcable? (cast (malloc 8) _pointer _gcpointer))
+(test #t cpointer-gcable? (cast #"x" _bytes _pointer))
+(test #t cpointer-gcable? (cast #"x" _bytes _gcpointer))
+(test #t cpointer-gcable? (cast #"x" _bytes _bytes))
+(test #t
+      'many-casts
+      (for/and ([i (in-range 1000)])
+        (cpointer-gcable? (cast (bytes 1 2 3 4)
+                                _bytes
+                                _pointer))))
+
 ;; test 'interior allocation mode
 (when (eq? 'racket (system-type 'vm))
   ;; Example by Ron Garcia

racket/collects/ffi/unsafe.rkt

@@ -1465,13 +1465,12 @@
   (cond
    [(and (cpointer? p)
          (cpointer-gcable? p))
-    (define from-t (ctype-coretype from-type))
-    (define to-t (ctype-coretype to-type))
     (let loop ([p p])
       (cond
         [(and (not (zero? (ptr-offset p)))
-             (or (or (eq? to-t 'pointer)
+              (let ([ct (ctype-coretype to-type)])
-                     (eq? to-t 'gcpointer))))
+                (or (eq? ct 'pointer)
+                    (eq? ct 'gcpointer))))
          (define o (ptr-offset p))
          (define from-t (cpointer-tag p))
          (define z (ptr-add p (- o)))
@@ -1483,18 +1482,30 @@
          (when to-t
            (set-cpointer-tag! r to-t))
          r]
+        [(ctype-pointer? to-type)
+         (define (pointer->cpointer t)
+           (define ct (ctype-coretype t))
+           (if (eq? ct 'pointer)
+               (_gcable t)
+               t))
+         (convert p (pointer->cpointer from-type) (pointer->cpointer to-type))]
         [else
-        (if (and (or (eq? from-t 'pointer)
+         (convert p from-type to-type)]))]
-                     (eq? to-t 'pointer))
-                 (or (eq? from-t 'pointer)
-                     (eq? from-t 'gcpointer))
-                 (or (eq? to-t 'pointer)
-                     (eq? to-t 'gcpointer)))
-            (convert p (_gcable from-type) (_gcable to-type))
-            (convert p from-type to-type))]))]
    [else
     (convert p from-type to-type)]))
 
+(define (ctype-pointer? ctype)
+  (define coretype (ctype-coretype ctype))
+  (memq coretype '(pointer
+                   gcpointer
+                   fpointer
+                   bytes
+                   scheme
+                   string
+                   string/ucs-4
+                   string/utf-16
+                   symbol)))
+
 (define* (_or-null ctype)
   (let ([coretype (ctype-coretype ctype)])
     (unless (memq coretype '(pointer gcpointer fpointer))

racket/src/cs/rumble/foreign.ss

@@ -688,7 +688,9 @@
 (define (ctype-malloc-mode c)
   (let ([t (ctype-our-rep c)])
     (if (or (eq? t 'gcpointer)
+            (eq? t 'bytes)
             (eq? t 'scheme)
+            (eq? t 'string)
             (eq? t 'string/ucs-4)
             (eq? t 'string/utf-16))
         'nonatomic