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 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

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

@ -1194,6 +1194,10 @@
(stest #f string>? "b" "\uE2")
(stest (if c? #f #t) string-locale>? "b" "\uE2")
(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? "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"))

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

@ -902,17 +902,17 @@
;; 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
;; the largest fixnum, after running these checks start,
;; 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)
(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))
(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)))
(raise-argument-error who "(and/c exact-integer? (not/c zero?))" step))
(when (and (< start stop) (< step 0))
@ -939,7 +939,7 @@
(raise-argument-error who type-name vec))
(let* ([len (unsafe-vector-length vec)]
[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)))
(define-syntax define-in-vector-like
@ -1105,7 +1105,7 @@
(define-sequence-syntax *in-bytes
(lambda () #'in-bytes)
(make-in-vector-like 'in-bytes
"bytes"
"byte string"
#'bytes?
#'unsafe-bytes-length
#'in-bytes

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

@ -25,21 +25,45 @@
[(if (path-for-some-system? s)
(eq? (path-convention-type s) 'windows)
(eq? (system-type) 'windows))
(let ([str (if (string? s) s (bytes->string/locale (path->bytes s)))])
(if (regexp-match? #rx"^[\u5C][\u5C][?][\u5C]" str)
(if (string? s)
(string->path s)
s)
(let ([s (string-locale-downcase str)])
(bytes->path
(string->bytes/locale
(regexp-replace* #rx"/"
(if (regexp-match? #rx"[/\u5C][. ]+[/\u5C]*$" s)
;; Just "." or ".." in last path element - don't remove
s
(regexp-replace* #rx"\u5B .\u5D+([/\u5C]*)$" s "\u005C1"))
bsbs))
'windows))))]
(let ([bstr (if (string? s) #f (path->bytes s))])
(cond
[(and (string? s)
(regexp-match? #rx"^[\u5C][\u5C][?][\u5C]" s))
(string->path s)]
[(and bstr
(regexp-match? #rx#"^[\x5C][\x5C][?][\x5C]" bstr))
s]
[else
;; There's no guarantee that `bstr` can be encoded, so
;; deal with parts that can be encoded in chunks
(let ([norm (lambda (s)
(string-locale-downcase (regexp-replace* #rx"/" s bsbs)))]
[norm-tail (lambda (s)
(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)]
[else s])))

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

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

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

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

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

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

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

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

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

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

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

@ -14,4 +14,4 @@
(define/who (path->string 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 len (bytes-length bstr))
(define surrogate-count
(for/fold ([n 0]) ([b (in-bytes bstr (if big-endian? 0 1) len 2)])
(if (= (bitwise-and b #xDC) #xD8)
(add1 n)
n)))
(if (= len 0)
0
(for/fold ([n 0]) ([b (in-bytes bstr (if big-endian? 0 1) len 2)])
(if (= (bitwise-and b #xDC) #xD8)
(add1 n)
n))))
(define str (make-string (- (arithmetic-shift len -1) surrogate-count)))
(let loop ([i 0] [pos 0])
(unless (= i len)