suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

normal-case-path: leave bad encoding bytes alone

Browse Source 
When bytes within a Windows path cannot be converted using
`bytes->string/locale` (i.e., when the bytes do not fit a UTF-8
encoding), then leave the bytes alone, instead of triggering a failure
from `bytes->string/locale`.

Fixing this bug uncovered others: `string-locale-downcase` did not
work on an empty byte string on a little-endian machine, and
`in-bytes` and similar reported range errors in terms of "vectors".
This commit is contained in:
Matthew Flatt 2020-11-04 10:27:07 -07:00
parent 66ed5369ef
commit fc53f2998c
11 changed files with 280 additions and 136 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
pkgs/racket-test-core/tests/racket/path.rktl
View File

@ -497,6 +497,21 @@
(check-cleanse cleanse-path) (check-cleanse cleanse-path)
(check-cleanse resolve-path)) (check-cleanse resolve-path))
(test (bytes->path #" . " 'windows) normal-case-path (bytes->path #" . " 'windows))
(test (bytes->path #"\\ . " 'windows) normal-case-path (bytes->path #"/ . " 'windows))
(test (bytes->path #"\\ . " 'windows) normal-case-path (bytes->path #"\\ . " 'windows))
(test (bytes->path #"x" 'windows) normal-case-path (bytes->path #"x . " 'windows))
(test (bytes->path #"\\x" 'windows) normal-case-path (bytes->path #"/x . " 'windows))
(test (bytes->path #"\\x" 'windows) normal-case-path (bytes->path #"\\x . " 'windows))
;; Make sure `normal-case-bytes` leaves unencodable bytes alone;
(test #"\340x" path->bytes (normal-case-path (bytes->path #"\340x" 'windows)))
(test #"\340\340x" path->bytes (normal-case-path (bytes->path #"\340\340x" 'windows)))
(test #"\340x" path->bytes (normal-case-path (bytes->path #"\340X" 'windows)))
(test #"\340x" path->bytes (normal-case-path (bytes->path #"\340X . " 'windows)))
(test #"\340x\340x\340" path->bytes (normal-case-path (bytes->path #"\340x\340x\340" 'windows)))
(test #"x . \340x" path->bytes (normal-case-path (bytes->path #"X . \340X . " 'windows)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; \\?\ paths in Windows ;; \\?\ paths in Windows

4
pkgs/racket-test-core/tests/racket/unicode.rktl
View File

@ -1194,6 +1194,10 @@
(stest #f string>? "b" "\uE2") (stest #f string>? "b" "\uE2")
(stest (if c? #f #t) string-locale>? "b" "\uE2") (stest (if c? #f #t) string-locale>? "b" "\uE2")
(test "ABC" string-locale-upcase "aBc") (test "ABC" string-locale-upcase "aBc")
(test "" string-locale-downcase "")
(test "a" string-locale-downcase "A")
(test "" string-locale-upcase "")
(test "A" string-locale-upcase "a")
(test (if c? "\uE2" "\uC2") string-locale-upcase "\uE2") (test (if c? "\uE2" "\uC2") string-locale-upcase "\uE2")
(test (if c? "A\uE2\0B" "A\uC2\0B") string-locale-upcase "a\uE2\0b") (test (if c? "A\uE2\0B" "A\uC2\0B") string-locale-upcase "a\uE2\0b")
(test (if c? "A\uE2\0\uE2\0B" "A\uC2\0\uC2\0B") string-locale-upcase "a\uE2\0\uE2\0b")) (test (if c? "A\uE2\0\uE2\0B" "A\uC2\0\uC2\0B") string-locale-upcase "a\uE2\0\uE2\0b"))

12
racket/collects/racket/private/for.rkt
View File

@ -902,17 +902,17 @@
;; Vector-like sequences -------------------------------------------------- ;; Vector-like sequences --------------------------------------------------
;; (: check-ranges (Symbol Natural Integer Integer Natural -> Void)) ;; (: check-ranges (Symbol String Natural Integer Integer Natural -> Void))
;; ;;
;; As no object can have more slots than can be indexed by ;; As no object can have more slots than can be indexed by
;; the largest fixnum, after running these checks start, ;; the largest fixnum, after running these checks start,
;; stop, and step are guaranteed to be fixnums. ;; stop, and step are guaranteed to be fixnums.
(define (check-ranges who vec start stop step len) (define (check-ranges who type-name vec start stop step len)
(unless (and (exact-nonnegative-integer? start) (unless (and (exact-nonnegative-integer? start)
(or (< start len) (= len start stop))) (or (< start len) (= len start stop)))
(raise-range-error who "vector" "starting " start vec 0 (sub1 len))) (raise-range-error who type-name "starting " start vec 0 (sub1 len)))
(unless (and (exact-integer? stop) (<= -1 stop) (<= stop len)) (unless (and (exact-integer? stop) (<= -1 stop) (<= stop len))
(raise-range-error who "vector" "stopping " stop vec -1 len)) (raise-range-error who type-name "stopping " stop vec -1 len))
(unless (and (exact-integer? step) (not (zero? step))) (unless (and (exact-integer? step) (not (zero? step)))
(raise-argument-error who "(and/c exact-integer? (not/c zero?))" step)) (raise-argument-error who "(and/c exact-integer? (not/c zero?))" step))
(when (and (< start stop) (< step 0)) (when (and (< start stop) (< step 0))
@ -939,7 +939,7 @@
(raise-argument-error who type-name vec)) (raise-argument-error who type-name vec))
(let* ([len (unsafe-vector-length vec)] (let* ([len (unsafe-vector-length vec)]
[stop* (if stop stop len)]) [stop* (if stop stop len)])
(check-ranges who vec start stop* step len) (check-ranges who type-name vec start stop* step len)
(values vec start stop* step))) (values vec start stop* step)))
(define-syntax define-in-vector-like (define-syntax define-in-vector-like
@ -1105,7 +1105,7 @@
(define-sequence-syntax *in-bytes (define-sequence-syntax *in-bytes
(lambda () #'in-bytes) (lambda () #'in-bytes)
(make-in-vector-like 'in-bytes (make-in-vector-like 'in-bytes
"bytes" "byte string"
#'bytes? #'bytes?
#'unsafe-bytes-length #'unsafe-bytes-length
#'in-bytes #'in-bytes

54
racket/collects/racket/private/path.rkt
View File

@ -25,21 +25,45 @@
[(if (path-for-some-system? s) [(if (path-for-some-system? s)
(eq? (path-convention-type s) 'windows) (eq? (path-convention-type s) 'windows)
(eq? (system-type) 'windows)) (eq? (system-type) 'windows))
(let ([str (if (string? s) s (bytes->string/locale (path->bytes s)))]) (let ([bstr (if (string? s) #f (path->bytes s))])
(if (regexp-match? #rx"^[\u5C][\u5C][?][\u5C]" str) (cond
(if (string? s) [(and (string? s)
(string->path s) (regexp-match? #rx"^[\u5C][\u5C][?][\u5C]" s))
s) (string->path s)]
(let ([s (string-locale-downcase str)]) [(and bstr
(bytes->path (regexp-match? #rx#"^[\x5C][\x5C][?][\x5C]" bstr))
(string->bytes/locale s]
(regexp-replace* #rx"/" [else
(if (regexp-match? #rx"[/\u5C][. ]+[/\u5C]*$" s) ;; There's no guarantee that `bstr` can be encoded, so
;; Just "." or ".." in last path element - don't remove ;; deal with parts that can be encoded in chunks
s (let ([norm (lambda (s)
(regexp-replace* #rx"\u5B .\u5D+([/\u5C]*)$" s "\u005C1")) (string-locale-downcase (regexp-replace* #rx"/" s bsbs)))]
bsbs)) [norm-tail (lambda (s)
'windows))))] (if (regexp-match? #rx"[/\u5C][. ]+[/\u5C]*$" s)
;; Just "." or ".." in last path element - don't remove
s
(regexp-replace* #rx"(?<=\u5B^ ./\u5C\u5D)\u5B .\u5D+([/\u5C]*)$" s "\u005C1")))]
[finish (lambda (bstr) (bytes->path bstr 'windows))])
(cond
[(string? s)
(finish (string->bytes/locale (norm (norm-tail s))))]
[else
(let ([c (bytes-open-converter "" "UTF-8")])
(finish
(let loop ([offset 0])
(let-values ([(new-bstr used status) (bytes-convert c bstr offset (bytes-length bstr))])
(let* ([s (bytes->string/locale new-bstr)]
[tail-s (if (eq? status 'complete) (norm-tail s) s)]
[done (string->bytes/locale (norm tail-s))])
(cond
[(eq? status 'complete)
done]
[(eq? status 'aborts)
(bytes-append done (subbytes bstr (+ offset used)))]
[else
(bytes-append done
(subbytes bstr (+ offset used) (+ offset used 1))
(loop (+ offset used 1)))]))))))]))]))]
[(string? s) (string->path s)] [(string? s) (string->path s)]
[else s]))) [else s])))

131
racket/src/cs/schemified/expander.scm
View File

@ -70,9 +70,10 @@
(1/use-user-specific-search-paths (1/use-user-specific-search-paths
use-user-specific-search-paths))) use-user-specific-search-paths)))
(define rx2276 (regexp "^[\\][\\][?][\\]")) (define rx2276 (regexp "^[\\][\\][?][\\]"))
(define rx2490 (byte-regexp #vu8(94 91 92 93 91 92 93 91 63 93 91 92 93)))
(define rx2515 (regexp "/")) (define rx2515 (regexp "/"))
(define rx2283 (regexp "[/\\][. ]+[/\\]*$")) (define rx2283 (regexp "[/\\][. ]+[/\\]*$"))
(define rx2870 (regexp "[ .]+([/\\]*)$")) (define rx2458 (regexp "(?<=[^ ./\\])[ .]+([/\\]*)$"))
(define rx2566 (regexp "^\\\\\\\\[?]\\\\[a-z]:")) (define rx2566 (regexp "^\\\\\\\\[?]\\\\[a-z]:"))
(define rx2590 (regexp "^\\\\\\\\[?]\\\\UNC\\\\")) (define rx2590 (regexp "^\\\\\\\\[?]\\\\UNC\\\\"))
(define rx2623 (regexp "^\\\\\\\\")) (define rx2623 (regexp "^\\\\\\\\"))
@ -732,35 +733,86 @@
#f))))) #f)))))
(define bsbs (string '#\x5c '#\x5c)) (define bsbs (string '#\x5c '#\x5c))
(define normal-case-path (define normal-case-path
(lambda (s_0) (letrec ((finish_0
(begin (|#%name|
(if (let ((or-part_0 (path-for-some-system? s_0))) finish
(if or-part_0 or-part_0 (path-string? s_0))) (lambda (bstr_0) (begin (bytes->path bstr_0 'windows)))))
(void) (loop_0
(raise-argument-error (|#%name|
'normal-path-case loop
"(or/c path-for-some-system? path-string?)" (lambda (bstr_0 c_0 offset_0)
s_0)) (begin
(if (if (path-for-some-system? s_0) (call-with-values
(eq? (path-convention-type s_0) 'windows) (lambda ()
(eq? (system-type) 'windows)) (bytes-convert
(let ((str_0 c_0
(if (string? s_0) bstr_0
s_0 offset_0
(bytes->string/locale (path->bytes s_0))))) (unsafe-bytes-length bstr_0)))
(if (regexp-match? rx2276 str_0) (case-lambda
(if (string? s_0) (string->path s_0) s_0) ((new-bstr_0 used_0 status_0)
(let ((s_1 (string-locale-downcase str_0))) (let ((done_0
(bytes->path (string->bytes/locale
(string->bytes/locale (norm_0
(regexp-replace* (norm-tail_0
rx2515 (bytes->string/locale new-bstr_0))))))
(if (regexp-match? rx2283 s_1) (if (eq? status_0 'complete)
s_1 done_0
(regexp-replace* rx2870 s_1 "\\1")) (if (eq? status_0 'aborts)
bsbs)) (bytes-append
'windows)))) done_0
(if (string? s_0) (string->path s_0) s_0))))) (subbytes bstr_0 (+ offset_0 used_0)))
(let ((app_0
(let ((app_0 (+ offset_0 used_0)))
(subbytes
bstr_0
app_0
(+ offset_0 used_0 1)))))
(bytes-append
done_0
app_0
(loop_0 bstr_0 c_0 (+ offset_0 used_0 1))))))))
(args (raise-binding-result-arity-error 3 args))))))))
(norm-tail_0
(|#%name|
norm-tail
(lambda (s_0)
(begin
(if (regexp-match? rx2283 s_0)
s_0
(regexp-replace* rx2458 s_0 "\\1"))))))
(norm_0
(|#%name|
norm
(lambda (s_0)
(begin
(string-locale-downcase
(regexp-replace* rx2515 s_0 bsbs)))))))
(lambda (s_0)
(begin
(if (let ((or-part_0 (path-for-some-system? s_0)))
(if or-part_0 or-part_0 (path-string? s_0)))
(void)
(raise-argument-error
'normal-path-case
"(or/c path-for-some-system? path-string?)"
s_0))
(if (if (path-for-some-system? s_0)
(eq? (path-convention-type s_0) 'windows)
(eq? (system-type) 'windows))
(let ((bstr_0 (if (string? s_0) #f (path->bytes s_0))))
(if (if (string? s_0) (regexp-match? rx2276 s_0) #f)
(string->path s_0)
(if (if bstr_0 (regexp-match? rx2490 bstr_0) #f)
s_0
(if (string? s_0)
(let ((bstr_1
(string->bytes/locale (norm_0 (norm-tail_0 s_0)))))
(begin (bytes->path bstr_1 'windows)))
(let ((c_0 (bytes-open-converter "" "UTF-8")))
(let ((bstr_1 (loop_0 bstr_0 c_0 0)))
(begin (bytes->path bstr_1 'windows))))))))
(if (string? s_0) (string->path s_0) s_0))))))
(define check-extension-call (define check-extension-call
(lambda (s_0 sfx_0 who_0 sep_0 trust-sep?_0) (lambda (s_0 sfx_0 who_0 sep_0 trust-sep?_0)
(begin (begin
@ -2930,7 +2982,7 @@
(void) (void)
(raise-argument-error 'in-hash-values "hash?" ht_0)))) (raise-argument-error 'in-hash-values "hash?" ht_0))))
(define check-ranges (define check-ranges
(lambda (who_0 vec_0 start_0 stop_0 step_0 len_0) (lambda (who_0 type-name_0 vec_0 start_0 stop_0 step_0 len_0)
(begin (begin
(if (if (exact-nonnegative-integer? start_0) (if (if (exact-nonnegative-integer? start_0)
(let ((or-part_0 (< start_0 len_0))) (let ((or-part_0 (< start_0 len_0)))
@ -2939,7 +2991,7 @@
(void) (void)
(raise-range-error (raise-range-error
who_0 who_0
"vector" type-name_0
"starting " "starting "
start_0 start_0
vec_0 vec_0
@ -2949,7 +3001,14 @@
(if (<= -1 stop_0) (<= stop_0 len_0) #f) (if (<= -1 stop_0) (<= stop_0 len_0) #f)
#f) #f)
(void) (void)
(raise-range-error who_0 "vector" "stopping " stop_0 vec_0 -1 len_0)) (raise-range-error
who_0
type-name_0
"stopping "
stop_0
vec_0
-1
len_0))
(if (if (exact-integer? step_0) (not (zero? step_0)) #f) (if (if (exact-integer? step_0) (not (zero? step_0)) #f)
(void) (void)
(raise-argument-error (raise-argument-error
@ -2994,7 +3053,7 @@
(let ((len_0 (|#%app| unsafe-vector-length_0 vec_0))) (let ((len_0 (|#%app| unsafe-vector-length_0 vec_0)))
(let ((stop*_0 (if stop_0 stop_0 len_0))) (let ((stop*_0 (if stop_0 stop_0 len_0)))
(begin (begin
(check-ranges who_0 vec_0 start_0 stop*_0 step_0 len_0) (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0)
(values vec_0 start_0 stop*_0 step_0))))))) (values vec_0 start_0 stop*_0 step_0)))))))
(define check-vector (define check-vector
(lambda (v_0) (lambda (v_0)
@ -19314,7 +19373,7 @@
(define 1/make-set!-transformer (define 1/make-set!-transformer
(let ((struct:set!-transformer_0 (let ((struct:set!-transformer_0
(make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 1))) (make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 1)))
(let ((effect2444 (let ((effect2455
(struct-type-install-properties! (struct-type-install-properties!
struct:set!-transformer_0 struct:set!-transformer_0
'set!-transformer 'set!-transformer
@ -19367,7 +19426,7 @@
s s
'set!-transformer 'set!-transformer
'proc))))))) 'proc)))))))
(let ((effect2446 (let ((effect2457
(begin (begin
(register-struct-constructor! set!-transformer1_0) (register-struct-constructor! set!-transformer1_0)
(register-struct-predicate! set!-transformer?_1) (register-struct-predicate! set!-transformer?_1)

101
racket/src/cs/schemified/io.scm
View File

@ -2255,7 +2255,7 @@
(void) (void)
(raise-argument-error 'in-hash-keys "hash?" ht_0)))) (raise-argument-error 'in-hash-keys "hash?" ht_0))))
(define check-ranges (define check-ranges
(lambda (who_0 vec_0 start_0 stop_0 step_0 len_0) (lambda (who_0 type-name_0 vec_0 start_0 stop_0 step_0 len_0)
(begin (begin
(if (if (exact-nonnegative-integer? start_0) (if (if (exact-nonnegative-integer? start_0)
(let ((or-part_0 (< start_0 len_0))) (let ((or-part_0 (< start_0 len_0)))
@ -2264,7 +2264,7 @@
(void) (void)
(raise-range-error (raise-range-error
who_0 who_0
"vector" type-name_0
"starting " "starting "
start_0 start_0
vec_0 vec_0
@ -2274,7 +2274,14 @@
(if (<= -1 stop_0) (<= stop_0 len_0) #f) (if (<= -1 stop_0) (<= stop_0 len_0) #f)
#f) #f)
(void) (void)
(raise-range-error who_0 "vector" "stopping " stop_0 vec_0 -1 len_0)) (raise-range-error
who_0
type-name_0
"stopping "
stop_0
vec_0
-1
len_0))
(if (if (exact-integer? step_0) (not (zero? step_0)) #f) (if (if (exact-integer? step_0) (not (zero? step_0)) #f)
(void) (void)
(raise-argument-error (raise-argument-error
@ -2319,7 +2326,7 @@
(let ((len_0 (|#%app| unsafe-vector-length_0 vec_0))) (let ((len_0 (|#%app| unsafe-vector-length_0 vec_0)))
(let ((stop*_0 (if stop_0 stop_0 len_0))) (let ((stop*_0 (if stop_0 stop_0 len_0)))
(begin (begin
(check-ranges who_0 vec_0 start_0 stop*_0 step_0 len_0) (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0)
(values vec_0 start_0 stop*_0 step_0))))))) (values vec_0 start_0 stop*_0 step_0)))))))
(define check-vector (define check-vector
(lambda (v_0) (lambda (v_0)
@ -11269,7 +11276,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
src-bstr630_0 src-bstr630_0
@ -18509,7 +18516,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
(unsafe-unbox* (unsafe-unbox*
@ -18974,7 +18981,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
bstr9_0 bstr9_0
@ -22688,7 +22695,7 @@
(if (is-path? p_0) (if (is-path? p_0)
(void) (void)
(raise-argument-error 'path->string "path?" p_0)) (raise-argument-error 'path->string "path?" p_0))
(1/bytes->string/locale (|#%app| path-bytes p_0) '#\x3f)))))) (1/bytes->string/locale (|#%app| path-bytes p_0) '#\xfffd))))))
(define print-named (define print-named
(lambda (what_0 v_0 mode_0 o_0 max-length_0) (lambda (what_0 v_0 mode_0 o_0 max-length_0)
(let ((name_0 (object-name v_0))) (let ((name_0 (object-name v_0)))
@ -24827,7 +24834,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
bstr_0 bstr_0
@ -24865,7 +24872,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
bstr_0 bstr_0
@ -25853,7 +25860,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
bstr5_0 bstr5_0
@ -32175,7 +32182,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
bstr_0 bstr_0
@ -32521,39 +32528,43 @@
(lambda (bstr_0) (lambda (bstr_0)
(let ((len_0 (unsafe-bytes-length bstr_0))) (let ((len_0 (unsafe-bytes-length bstr_0)))
(let ((surrogate-count_0 (let ((surrogate-count_0
(call-with-values (if (= len_0 0)
(lambda () 0
(normalise-inputs (call-with-values
'in-bytes (lambda ()
"bytes" (normalise-inputs
procz1 'in-bytes
procz2 "byte string"
bstr_0 procz1
(if big-endian? 0 1) procz2
len_0 bstr_0
2)) (if big-endian? 0 1)
(case-lambda len_0
((v*_0 start*_0 stop*_0 step*_0) 2))
(begin (case-lambda
#t ((v*_0 start*_0 stop*_0 step*_0)
(letrec* (begin
((for-loop_0 #t
(|#%name| (letrec*
for-loop ((for-loop_0
(lambda (n_0 idx_0) (|#%name|
(begin for-loop
(if (< idx_0 stop*_0) (lambda (n_0 idx_0)
(let ((b_0 (unsafe-bytes-ref v*_0 idx_0))) (begin
(let ((n_1 (if (< idx_0 stop*_0)
(let ((n_1 (let ((b_0 (unsafe-bytes-ref v*_0 idx_0)))
(if (= (bitwise-and b_0 220) 216) (let ((n_1
(add1 n_0) (let ((n_1
n_0))) (if (=
(values n_1)))) (bitwise-and b_0 220)
(for-loop_0 n_1 (+ idx_0 2)))) 216)
n_0)))))) (add1 n_0)
(for-loop_0 0 start*_0)))) n_0)))
(args (raise-binding-result-arity-error 4 args)))))) (values n_1))))
(for-loop_0 n_1 (+ idx_0 2))))
n_0))))))
(for-loop_0 0 start*_0))))
(args (raise-binding-result-arity-error 4 args)))))))
(let ((str_0 (let ((str_0
(make-string (make-string
(- (arithmetic-shift len_0 -1) surrogate-count_0)))) (- (arithmetic-shift len_0 -1) surrogate-count_0))))

57
racket/src/cs/schemified/regexp.scm
View File

@ -410,7 +410,7 @@
(void) (void)
(raise-argument-error 'in-hash-keys "hash?" ht_0)))) (raise-argument-error 'in-hash-keys "hash?" ht_0))))
(define check-ranges (define check-ranges
(lambda (who_0 vec_0 start_0 stop_0 step_0 len_0) (lambda (who_0 type-name_0 vec_0 start_0 stop_0 step_0 len_0)
(begin (begin
(if (if (exact-nonnegative-integer? start_0) (if (if (exact-nonnegative-integer? start_0)
(let ((or-part_0 (< start_0 len_0))) (let ((or-part_0 (< start_0 len_0)))
@ -419,7 +419,7 @@
(void) (void)
(raise-range-error (raise-range-error
who_0 who_0
"vector" type-name_0
"starting " "starting "
start_0 start_0
vec_0 vec_0
@ -429,7 +429,14 @@
(if (<= -1 stop_0) (<= stop_0 len_0) #f) (if (<= -1 stop_0) (<= stop_0 len_0) #f)
#f) #f)
(void) (void)
(raise-range-error who_0 "vector" "stopping " stop_0 vec_0 -1 len_0)) (raise-range-error
who_0
type-name_0
"stopping "
stop_0
vec_0
-1
len_0))
(if (if (exact-integer? step_0) (not (zero? step_0)) #f) (if (if (exact-integer? step_0) (not (zero? step_0)) #f)
(void) (void)
(raise-argument-error (raise-argument-error
@ -474,7 +481,7 @@
(let ((len_0 (|#%app| unsafe-vector-length_0 vec_0))) (let ((len_0 (|#%app| unsafe-vector-length_0 vec_0)))
(let ((stop*_0 (if stop_0 stop_0 len_0))) (let ((stop*_0 (if stop_0 stop_0 len_0)))
(begin (begin
(check-ranges who_0 vec_0 start_0 stop*_0 step_0 len_0) (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0)
(values vec_0 start_0 stop*_0 step_0))))))) (values vec_0 start_0 stop*_0 step_0)))))))
(define check-vector (define check-vector
(lambda (v_0) (lambda (v_0)
@ -4554,7 +4561,15 @@
(lambda (bstr_0 i_0) (lambda (bstr_0 i_0)
(call-with-values (call-with-values
(lambda () (lambda ()
(normalise-inputs 'in-bytes "bytes" procz1 procz2 bstr_0 i_0 #f 1)) (normalise-inputs
'in-bytes
"byte string"
procz1
procz2
bstr_0
i_0
#f
1))
(case-lambda (case-lambda
((v*_0 start*_0 stop*_0 step*_0) ((v*_0 start*_0 stop*_0 step*_0)
(begin (begin
@ -5541,7 +5556,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
bstr_0 bstr_0
@ -5554,7 +5569,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz3 procz3
procz4 procz4
s_0 s_0
@ -5610,7 +5625,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz5 procz5
procz6 procz6
bstr_0 bstr_0
@ -5690,7 +5705,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
bstr_0 bstr_0
@ -5703,7 +5718,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz3 procz3
procz4 procz4
s_0 s_0
@ -5759,7 +5774,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz5 procz5
procz6 procz6
bstr_0 bstr_0
@ -5844,7 +5859,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
bstr_0 bstr_0
@ -5857,7 +5872,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz3 procz3
procz4 procz4
s_0 s_0
@ -5966,7 +5981,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz5 procz5
procz6 procz6
bstr_0 bstr_0
@ -6744,7 +6759,7 @@
(let ((app_0 (car p_0))) (let ((app_0 (car p_0)))
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
s_0 s_0
@ -6757,7 +6772,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz3 procz3
procz4 procz4
s_0 s_0
@ -6899,7 +6914,7 @@
(let ((app_0 (car p_0))) (let ((app_0 (car p_0)))
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
s_0 s_0
@ -6912,7 +6927,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz3 procz3
procz4 procz4
s_0 s_0
@ -8466,7 +8481,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz1 procz1
procz2 procz2
in_0 in_0
@ -8519,7 +8534,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz3 procz3
procz4 procz4
in_0 in_0
@ -8535,7 +8550,7 @@
(lambda () (lambda ()
(normalise-inputs (normalise-inputs
'in-bytes 'in-bytes
"bytes" "byte string"
procz5 procz5
procz6 procz6
must-string_0 must-string_0

15
racket/src/cs/schemified/schemify.scm
View File

@ -1869,7 +1869,7 @@
(void) (void)
(raise-argument-error 'in-hash-values "hash?" ht_0)))) (raise-argument-error 'in-hash-values "hash?" ht_0))))
(define check-ranges (define check-ranges
(lambda (who_0 vec_0 start_0 stop_0 step_0 len_0) (lambda (who_0 type-name_0 vec_0 start_0 stop_0 step_0 len_0)
(begin (begin
(if (if (exact-nonnegative-integer? start_0) (if (if (exact-nonnegative-integer? start_0)
(let ((or-part_0 (< start_0 len_0))) (let ((or-part_0 (< start_0 len_0)))
@ -1878,7 +1878,7 @@
(void) (void)
(raise-range-error (raise-range-error
who_0 who_0
"vector" type-name_0
"starting " "starting "
start_0 start_0
vec_0 vec_0
@ -1888,7 +1888,14 @@
(if (<= -1 stop_0) (<= stop_0 len_0) #f) (if (<= -1 stop_0) (<= stop_0 len_0) #f)
#f) #f)
(void) (void)
(raise-range-error who_0 "vector" "stopping " stop_0 vec_0 -1 len_0)) (raise-range-error
who_0
type-name_0
"stopping "
stop_0
vec_0
-1
len_0))
(if (if (exact-integer? step_0) (not (zero? step_0)) #f) (if (if (exact-integer? step_0) (not (zero? step_0)) #f)
(void) (void)
(raise-argument-error (raise-argument-error
@ -1933,7 +1940,7 @@
(let ((len_0 (|#%app| unsafe-vector-length_0 vec_0))) (let ((len_0 (|#%app| unsafe-vector-length_0 vec_0)))
(let ((stop*_0 (if stop_0 stop_0 len_0))) (let ((stop*_0 (if stop_0 stop_0 len_0)))
(begin (begin
(check-ranges who_0 vec_0 start_0 stop*_0 step_0 len_0) (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0)
(values vec_0 start_0 stop*_0 step_0))))))) (values vec_0 start_0 stop*_0 step_0)))))))
(define check-vector (define check-vector
(lambda (v_0) (lambda (v_0)

15
racket/src/cs/schemified/thread.scm
View File

@ -582,7 +582,7 @@
(void) (void)
(raise-argument-error 'in-hash-keys "hash?" ht_0)))) (raise-argument-error 'in-hash-keys "hash?" ht_0))))
(define check-ranges (define check-ranges
(lambda (who_0 vec_0 start_0 stop_0 step_0 len_0) (lambda (who_0 type-name_0 vec_0 start_0 stop_0 step_0 len_0)
(begin (begin
(if (if (exact-nonnegative-integer? start_0) (if (if (exact-nonnegative-integer? start_0)
(let ((or-part_0 (< start_0 len_0))) (let ((or-part_0 (< start_0 len_0)))
@ -591,7 +591,7 @@
(void) (void)
(raise-range-error (raise-range-error
who_0 who_0
"vector" type-name_0
"starting " "starting "
start_0 start_0
vec_0 vec_0
@ -601,7 +601,14 @@
(if (<= -1 stop_0) (<= stop_0 len_0) #f) (if (<= -1 stop_0) (<= stop_0 len_0) #f)
#f) #f)
(void) (void)
(raise-range-error who_0 "vector" "stopping " stop_0 vec_0 -1 len_0)) (raise-range-error
who_0
type-name_0
"stopping "
stop_0
vec_0
-1
len_0))
(if (if (exact-integer? step_0) (not (zero? step_0)) #f) (if (if (exact-integer? step_0) (not (zero? step_0)) #f)
(void) (void)
(raise-argument-error (raise-argument-error
@ -646,7 +653,7 @@
(let ((len_0 (|#%app| unsafe-vector-length_0 vec_0))) (let ((len_0 (|#%app| unsafe-vector-length_0 vec_0)))
(let ((stop*_0 (if stop_0 stop_0 len_0))) (let ((stop*_0 (if stop_0 stop_0 len_0)))
(begin (begin
(check-ranges who_0 vec_0 start_0 stop*_0 step_0 len_0) (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0)
(values vec_0 start_0 stop*_0 step_0))))))) (values vec_0 start_0 stop*_0 step_0)))))))
(define check-vector (define check-vector
(lambda (v_0) (lambda (v_0)

2
racket/src/io/path/string.rkt
View File

@ -14,4 +14,4 @@
(define/who (path->string p) (define/who (path->string p)
(check who is-path? #:contract "path?" p) (check who is-path? #:contract "path?" p)
(bytes->string/locale (path-bytes p) #\?)) (bytes->string/locale (path-bytes p) #\uFFFD))

10
racket/src/io/string/utf-16-decode.rkt
View File

@ -8,10 +8,12 @@
(define (utf-16-decode bstr) (define (utf-16-decode bstr)
(define len (bytes-length bstr)) (define len (bytes-length bstr))
(define surrogate-count (define surrogate-count
(for/fold ([n 0]) ([b (in-bytes bstr (if big-endian? 0 1) len 2)]) (if (= len 0)
(if (= (bitwise-and b #xDC) #xD8) 0
(add1 n) (for/fold ([n 0]) ([b (in-bytes bstr (if big-endian? 0 1) len 2)])
n))) (if (= (bitwise-and b #xDC) #xD8)
(add1 n)
n))))
(define str (make-string (- (arithmetic-shift len -1) surrogate-count))) (define str (make-string (- (arithmetic-shift len -1) surrogate-count)))
(let loop ([i 0] [pos 0]) (let loop ([i 0] [pos 0])
(unless (= i len) (unless (= i len)