diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl index eac03188ee..d5818f091f 100644 --- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl +++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl @@ -8,6 +8,7 @@ ffi/unsafe/alloc ffi/unsafe/define ffi/unsafe/define/conventions + ffi/unsafe/global ffi/vector racket/extflonum racket/place @@ -1362,6 +1363,19 @@ ;; ---------------------------------------- +(let* ([bstr (string->bytes/utf-8 (format "~a ~a" (current-inexact-milliseconds) (random)))] + [orig-bstr (bytes-copy bstr)]) + (err/rt-test (register-process-global 7 8)) + (err/rt-test (register-process-global "7" 8)) + (test #f register-process-global bstr #f) + (test #f register-process-global bstr #"data\0") + (test #"data" cast (register-process-global bstr #f) _pointer _bytes) + (bytes-set! bstr 0 65) + (test #f register-process-global bstr #f) + (test #"data" cast (register-process-global orig-bstr #"data\0") _pointer _bytes)) + +;; ---------------------------------------- + (report-errs) #| --- ignore everything below --- diff --git a/racket/src/cs/rumble/bytes.ss b/racket/src/cs/rumble/bytes.ss index 37c5b61623..496e862ef8 100644 --- a/racket/src/cs/rumble/bytes.ss +++ b/racket/src/cs/rumble/bytes.ss @@ -84,7 +84,8 @@ (check who byte? b) (bytevector-fill! bstr b)) -(define bytes-copy #2%bytevector-copy) +(define (bytes-copy bstr) + (#2%bytevector-copy bstr)) (define-syntax-rule (define-bytes-compare name do-name) (define/who name diff --git a/racket/src/cs/rumble/error-rewrite.ss b/racket/src/cs/rumble/error-rewrite.ss index f14fbb11e4..6ee4e48c68 100644 --- a/racket/src/cs/rumble/error-rewrite.ss +++ b/racket/src/cs/rumble/error-rewrite.ss @@ -51,6 +51,7 @@ (rename bytevector-u8-ref bytes-ref bytevector-u8-set! bytes-set! bytevector-length bytes-length + bytevector-copy bytes-copy bitwise-arithmetic-shift arithmetic-shift fixnum->flonum fx->fl flonum->fixnum fl->fx diff --git a/racket/src/cs/rumble/foreign.ss b/racket/src/cs/rumble/foreign.ss index 4ada81f986..ce52fed248 100644 --- a/racket/src/cs/rumble/foreign.ss +++ b/racket/src/cs/rumble/foreign.ss @@ -2024,7 +2024,8 @@ (define process-global-table (make-hashtable equal-hash-code equal?)) -(define (unsafe-register-process-global key val) +(define/who (unsafe-register-process-global key val) + (check who bytes? key) (with-global-lock (cond [(not val) @@ -2033,7 +2034,7 @@ (let ([old-val (hashtable-ref process-global-table key #f)]) (cond [(not old-val) - (hashtable-set! process-global-table key val) + (hashtable-set! process-global-table (bytes-copy key) val) #f] [else old-val]))])))