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

change collection-links format to avoid paths as strings

Browse Source 
Converting between strings and paths interferes with cross
compilation. This hasn't caused more problems only because cross
compilation has tended to run on Unix platforms, where the generated
paths are acceptable to Windows. But using strings goes wrong when
manipulating a Windows-based build for further cross-build actions on
Unix, and it can go wrong if paths contain bytes that cannot be
encoded in strings.
This commit is contained in:
Matthew Flatt 2021-05-12 13:31:16 -06:00
parent a7ddec9573
commit 2ac7e21ad4
13 changed files with 383 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
pkgs/racket-doc/scribblings/reference/collects.scrbl
View File

@ -144,17 +144,24 @@ initialized to the result of @racket[find-library-collection-links].
A @tech{collection links file} is @racket[read] with default reader
parameter settings to obtain a list. Every element of the list must be
a link specification with one of the forms @racket[(list _string
_path)], @racket[(list _string _path _regexp)], @racket[(list 'root
_path)], @racket[(list 'root _path _regexp)], @racket[(list 'static-root
_path)], @racket[(list 'static-root _path _regexp)]. A @racket[_string] names a
top-level @tech{collection}, in which case @racket[_path] is a path
_encoded-path)], @racket[(list _string _encoded-path _regexp)], @racket[(list 'root
_encoded-path)], @racket[(list 'root _encoded-path _regexp)], @racket[(list 'static-root
_encoded-path)], @racket[(list 'static-root _encoded-path _regexp)].
A @racket[_string] names a
top-level @tech{collection}, in which case @racket[_encoded-path] describes a path
that can be used as the collection's path (directly, as opposed to a
subdirectory of @racket[_path] named by @racket[_string]). A
subdirectory of @racket[_encoded-path] named by @racket[_string]). A
@racket['root] entry, in contrast, acts like an path in
@racket[(current-library-collection-paths)]. A
@racket['static-root] entry is like a @racket['root] entry, but
where the immediate content of the directory is assumed not to change unless the
@tech{collection links file} changes. If @racket[_path] is a
@tech{collection links file} changes.
Each @racket[_encoded-path] is either a string, a
byte string that is converted to a path with @racket[bytes->path],
or a list of relative path-element byte strings, @racket['up], and @racket['same]
indicators that are combined with @racket[build-path] with the byte
strings converted with @racket[bytes->path-element].
If @racket[_encoded-path] describes a
relative path, it is relative to the directory containing the
@tech{collection links file}. If @racket[_regexp] is specified in a
link, then the link is used only if @racket[(regexp-match? _regexp
@ -169,6 +176,9 @@ The @exec{raco link} command-link tool can display, install, and
remove links in a @tech{collection links file}. See @secref[#:doc
raco-doc "link"] in @other-manual[raco-doc] for more information.
@history[#:changed "8.1.0.6" @elem{Changed @racket[_encoded-path] to
allow bytes strings and lists.}]
@; ----------------------------------------
@section[#:tag "collects-api"]{Collection Paths and Parameters}

27
pkgs/racket-doc/scribblings/reference/paths.scrbl
View File

@ -143,7 +143,9 @@ For information on how byte strings encode paths, see
@secref["unixpathrep"] and @secref["windowspathrep"].}
@defproc[(string->path-element [str string?]) path?]{
@defproc[(string->path-element [str string?]
[false-on-non-element? any/c #f])
(or/c (and/c path? path-element?) #f)]{
Like @racket[string->path], except that @racket[str] corresponds to a
single relative element in a path, and it is encoded as necessary to
@ -154,26 +156,33 @@ paths.
If @racket[str] does not correspond to any @tech{path element}
(e.g., it is an absolute path, or it can be split), or if it
corresponds to an up-directory or same-directory indicator on
@|AllUnix|, then @exnraise[exn:fail:contract].
@|AllUnix|, then either @racket[#f] is returned or @exnraise[exn:fail:contract].
A @racket[#f] is returned only when @racket[false-on-non-element?]
is true.
Like @racket[path->string], information can be lost from
@racket[str] in the locale-specific conversion to a path.}
@racket[str] in the locale-specific conversion to a path.
@history[#:changed "8.1.0.6" @elem{Added the @racket[false-on-non-element?] argument.}]}
@defproc[(bytes->path-element [bstr bytes?]
[type (or/c 'unix 'windows) (system-path-convention-type)])
path-for-some-system?]{
[type (or/c 'unix 'windows) (system-path-convention-type)]
[false-on-non-element? any/c #f])
(or/c path-element? #f)]{
Like @racket[bytes->path], except that @racket[bstr] corresponds to a
single relative element in a path. In terms of conversions and
restrictions on @racket[bstr], @racket[bytes->path-element] is like
@racket[string->path-element].
single relative element in a path. In terms of conversions,
restrictions on @racket[bstr], and the treatment of @racket[false-on-non-element?],
@racket[bytes->path-element] is like @racket[string->path-element].
The @racket[bytes->path-element] procedure is generally the best
choice for reconstructing a path based on another path (where the
other path is deconstructed with @racket[split-path] and
@racket[path-element->bytes]) when ASCII-level manipulation of
@tech{path elements} is necessary.}
@tech{path elements} is necessary.
@history[#:changed "8.1.0.6" @elem{Added the @racket[false-on-non-element?] argument.}]}
@defproc[(path-element->string [path path-element?]) string?]{

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

@ -912,7 +912,8 @@
[bytes->path-element (if use-fs?
bytes->path-element
(lambda (s) (bytes->path-element s kind)))])
(lambda (s [other-kind #f] [non-element-false? #f])
(bytes->path-element s kind non-element-false?)))])
(test #t relative-path? (bytes->path #"./~"))
(test (bytes->path #"~") bytes->path-element #"~")
(test #"~" path-element->bytes (bytes->path #"~"))
@ -929,6 +930,10 @@
(err/rt-test (bytes->path-element #"x/y"))
(err/rt-test (bytes->path-element #"/x"))
(err/rt-test (bytes->path-element #"/"))
(err/rt-test (bytes->path-element #"_\0_"))
(test #f bytes->path-element #"x/y" (system-path-convention-type) #t)
(test #f bytes->path-element #"/" (system-path-convention-type) #t)
(err/rt-test (bytes->path-element #"_\0_" (system-path-convention-type) #t))
(unless use-fs?
(test (bytes->path #"~") simplify-path (bytes->path #"~") use-fs?)
(test (bytes->path #"~/") simplify-path (bytes->path #"~/") use-fs?)
@ -1015,6 +1020,13 @@
(err/rt-test (bytes->path-element #""))
(err/rt-test (string->path-element ""))
(err/rt-test (string->path-element "a\0b"))
(err/rt-test (bytes->path-element #"" (system-path-convention-type) #t))
(err/rt-test (string->path-element "" (system-path-convention-type) #t))
(err/rt-test (string->path-element "a\0b" #t))
(test #f string->path-element "a/b" #t)
(test #"\\\\?\\REL\\\\a/b" path->bytes (bytes->path-element #"a/b" 'windows))

53
racket/collects/racket/private/link-path.rkt Normal file
View File

@ -0,0 +1,53 @@
#lang racket/base
(provide encoded-link-path?
encode-link-path
decode-link-path)
(define (encoded-link-path? p)
(or (path-string? p)
(path-bytes? p)
(and (pair? p)
(list? p)
(andmap path-element-bytes/same/up? p))))
(define (path-bytes? p)
(and (bytes? p)
(positive? (bytes-length p))
(for/and ([c (in-bytes p)])
(not (eqv? c 0)))))
(define (path-element-bytes/same/up? p)
(or (eq? p 'up)
(eq? p 'same)
(and (path-bytes? p)
(let ([p (bytes->path-element p (system-path-convention-type) #t)])
(and p (relative-path? p))))))
(define (encode-link-path p)
(if (absolute-path? p)
(path->bytes p)
(let loop ([p p] [accum '()])
(define-values (base name dir?) (split-path p))
(define new-accum (cons (if (path? name)
(path-element->bytes name)
name)
accum))
(cond
[(eq? base 'relative) new-accum]
[else (loop base new-accum)]))))
(define (decode-link-path p)
(cond
[(path-string? p) p]
[(bytes? p) (bytes->path p)]
[else
(let loop ([path #f] [p p])
(cond
[(null? p) path]
[else
(define elem (if (bytes? (car p))
(bytes->path-element (car p))
(car p)))
(loop (if path (build-path path elem) elem)
(cdr p))]))]))

7
racket/collects/setup/collection-search.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/list
racket/string)
racket/string
racket/private/link-path)
(provide collection-search
normalized-lib-module-path?)
@ -50,11 +51,11 @@
(or (= (length e) 2)
(and (= (length e) 3)
(regexp? (caddr e))))
(path-string? (cadr e))
(encoded-link-path? (cadr e))
(or (null? (cddr e))
(regexp-match? (caddr e) (version)))))
(let ([a (car e)]
[p (path->complete-path (cadr e) links-dir)])
[p (path->complete-path (decode-link-path (cadr e)) links-dir)])
(cond
[(or (eq? 'root a)
(eq? 'static-root a))

20
racket/collects/setup/link.rkt
View File

@ -1,6 +1,7 @@
#lang racket/base
(require racket/file
racket/path
racket/private/link-path
setup/dirs
setup/collection-name)
@ -72,8 +73,8 @@
(eq? 'static-root (car e)))
(content-error "entry's first element is not a string, 'root, or 'static-root: " e))
#:when
(or (path-string? (cadr e))
(content-error "entry's second element is not a path string: " e))
(or (encoded-link-path? (cadr e))
(content-error "entry's second element is not a path encoding: " e))
#:when
(or (null? (cddr e))
(regexp? (caddr e))
@ -125,8 +126,7 @@
(let-values ([(base name dir?) (split-path dp)])
(path-element->string name)))))]
[rx version-regexp]
[d (and dp (path->string dp))]
[sd (and d (simplify d))])
[sd (and dp (simplify dp))])
(unless remove?
(unless (directory-exists? sd)
(error 'links
@ -134,8 +134,8 @@
sd)))
(if remove?
(filter (lambda (e)
(or (and d
(not (equal? (simplify (cadr e))
(or (and dp
(not (equal? (simplify (decode-link-path (cadr e)))
sd)))
(and name
(not (equal? (car e) name)))
@ -148,7 +148,7 @@
table)
(let ([l (hash-ref mapped a-name null)]
[e (list* a-name
d
(encode-link-path dp)
(if rx (list rx) null))])
(if (member (cdr e) l)
table
@ -184,7 +184,7 @@
""
"collection: ")
(car e)
(path->string (simplify (cadr e)))
(path->string (simplify (decode-link-path (cadr e))))
(if (null? (cddr e))
""
(format " version: ~s"
@ -200,7 +200,7 @@
(eq? 'static-root (car e)))
#:when (or (null? (cddr e))
(regexp-match? (caddr e) (version))))
(simplify (cadr e)))
(simplify (decode-link-path (cadr e))))
;; Return list of collections mapped for this version:
(let ([ht (make-hash)])
(for ([e (in-list new-table)])
@ -208,7 +208,7 @@
(or (null? (cddr e))
(regexp-match? (caddr e) (version))))
(hash-set! ht (if with-path?
(cons (car e) (simplify (cadr e)))
(cons (car e) (simplify (decode-link-path (cadr e))))
(car e))
#t)))
(hash-keys ht)))))

51
racket/src/bc/src/file.c
View File

@ -264,12 +264,12 @@ void scheme_init_file(Scheme_Startup_Env *env)
scheme_addto_prim_instance("bytes->path-element",
scheme_make_immed_prim(bytes_to_path_element,
"bytes->path-element",
1, 2),
1, 3),
env);
scheme_addto_prim_instance("string->path-element",
scheme_make_immed_prim(string_to_path_element,
"string->path-element",
1, 1),
1, 2),
env);
scheme_addto_prim_instance("file-exists?",
@ -843,27 +843,36 @@ static Scheme_Object *bytes_to_path(int argc, Scheme_Object **argv)
return s;
}
static Scheme_Object *do_bytes_to_path_element(const char *name, Scheme_Object *s, int argc, Scheme_Object **argv)
static Scheme_Object *do_bytes_to_path_element(const char *name, Scheme_Object *s, int argc, Scheme_Object **argv,
int has_kind, int false_on_error)
{
Scheme_Object *p;
intptr_t i, len;
int kind;
int bad_string = 0;
if (!SCHEME_BYTE_STRINGP(s))
scheme_wrong_contract(name, "bytes?", 0, argc, argv);
kind = extract_path_kind(name, 1, argc, argv);
if (has_kind)
kind = extract_path_kind(name, 1, argc, argv);
else
kind = SCHEME_PLATFORM_PATH_KIND;
len = SCHEME_BYTE_STRLEN_VAL(s);
for (i = 0; i < len; i++) {
if (IS_A_PRIM_SEP(kind, SCHEME_BYTE_STR_VAL(s)[i])) {
if (SCHEME_BYTE_STR_VAL(s)[i] == 0) {
bad_string = 1;
break;
} else if (IS_A_PRIM_SEP(kind, SCHEME_BYTE_STR_VAL(s)[i])) {
break;
}
}
if (i >= len) {
if (len == 0)
if (len == 0) {
bad_string = 1;
p = NULL;
else
} else
p = make_protected_sized_offset_path(1, SCHEME_BYTE_STR_VAL(s),
0, len,
SCHEME_MUTABLEP(s), 0,
@ -871,21 +880,28 @@ static Scheme_Object *do_bytes_to_path_element(const char *name, Scheme_Object *
} else
p = NULL;
if (!p || !is_path_element(p))
scheme_contract_error(name,
"cannot be converted to a path element",
"path", 1, argv[0],
"explanation", 0, (len
? "path can be split, is not relative, or names a special element"
: "path element cannot be empty"),
NULL);
if (!p || !is_path_element(p)) {
if (!bad_string && false_on_error)
return scheme_false;
if (bad_string)
raise_null_error(name, argv[0], "");
else
scheme_contract_error(name,
"cannot be converted to a path element",
"path", 1, argv[0],
"explanation", 0, (len
? "path can be split, is not relative, or names a special element"
: "path element cannot be empty"),
NULL);
}
return p;
}
static Scheme_Object *bytes_to_path_element(int argc, Scheme_Object **argv)
{
return do_bytes_to_path_element("bytes->path-element", argv[0], argc, argv);
return do_bytes_to_path_element("bytes->path-element", argv[0], argc, argv,
1, (argc > 2) ? SCHEME_TRUEP(argv[2]) : 0);
}
static Scheme_Object *string_to_path_element(int argc, Scheme_Object **argv)
@ -897,7 +913,8 @@ static Scheme_Object *string_to_path_element(int argc, Scheme_Object **argv)
b = scheme_char_string_to_byte_string_locale(argv[0]);
return do_bytes_to_path_element("string->path-element", b, argc, argv);
return do_bytes_to_path_element("string->path-element", b, argc, argv,
0, (argc > 1) ? SCHEME_TRUEP(argv[1]) : 0);
}
/**********************************************************************/

86
racket/src/bc/src/startup.inc
View File

@ -53156,6 +53156,85 @@ static const char *startup_source =
"(find-system-path 'orig-dir))"
"(thunk_0)))))"
"(define-values"
"(encoded-link-path?)"
"(lambda(p_0)"
"(begin"
"(let-values(((or-part_0)(path-string? p_0)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(path-bytes? p_0)))"
"(if or-part_1"
" or-part_1"
"(if(pair? p_0)(if(list? p_0)(andmap2 path-element-bytes/same/up? p_0) #f) #f))))))))"
"(define-values"
"(path-bytes?)"
"(lambda(p_0)"
"(begin"
"(if(bytes? p_0)"
"(if(positive?(bytes-length p_0))"
"(let-values(((vec_0 len_0)"
"(let-values(((vec_0) p_0))"
"(begin(check-bytes vec_0)(values vec_0(unsafe-bytes-length vec_0))))))"
"(begin"
" #f"
"((letrec-values(((for-loop_0)"
"(lambda(result_0 pos_0)"
"(begin"
" 'for-loop"
"(if(unsafe-fx< pos_0 len_0)"
"(let-values(((c_0)(unsafe-bytes-ref vec_0 pos_0)))"
"(let-values(((result_1)"
"(let-values()"
"(let-values(((result_1)"
"(let-values()"
"(let-values()(not(eqv? c_0 0))))))"
"(values result_1)))))"
"(if(if(not((lambda x_0(not result_1)) c_0))(not #f) #f)"
"(for-loop_0 result_1(unsafe-fx+ 1 pos_0))"
" result_1)))"
" result_0)))))"
" for-loop_0)"
" #t"
" 0)))"
" #f)"
" #f))))"
"(define-values"
"(path-element-bytes/same/up?)"
"(lambda(p_0)"
"(begin"
"(let-values(((or-part_0)(eq? p_0 'up)))"
"(if or-part_0"
" or-part_0"
"(let-values(((or-part_1)(eq? p_0 'same)))"
"(if or-part_1"
" or-part_1"
"(if(path-bytes? p_0)"
"(let-values(((p_1)(bytes->path-element p_0(system-path-convention-type) #t)))"
"(if p_1(relative-path? p_1) #f))"
" #f))))))))"
"(define-values"
"(decode-link-path)"
"(lambda(p_0)"
"(begin"
"(if(path-string? p_0)"
"(let-values() p_0)"
"(if(bytes? p_0)"
"(let-values()(bytes->path p_0))"
"(let-values()"
"((letrec-values(((loop_0)"
"(lambda(path_0 p_1)"
"(begin"
" 'loop"
"(if(null? p_1)"
"(let-values() path_0)"
"(let-values()"
"(let-values(((elem_0)"
"(if(bytes?(car p_1))(bytes->path-element(car p_1))(car p_1))))"
"(loop_0(if path_0(build-path path_0 elem_0) elem_0)(cdr p_1)))))))))"
" loop_0)"
" #f"
" p_0)))))))"
"(define-values"
"(struct:shadow-directory shadow-directory1.1 shadow-directory? shadow-directory-evt shadow-directory-table)"
"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)"
"(let-values()"
@ -53538,7 +53617,7 @@ static const char *startup_source =
"(if or-part_1"
" or-part_1"
"(eq? 'static-root(car p_0))))))"
"(if(path-string?(cadr p_0))"
"(if(encoded-link-path?(cadr p_0))"
"(let-values(((or-part_0)(null?(cddr p_0))))"
"(if or-part_0 or-part_0(regexp?(caddr p_0))))"
" #f)"
@ -53561,7 +53640,10 @@ static const char *startup_source =
"(if or-part_0 or-part_0(regexp-match?(caddr p_0)(version))))"
"(let-values()"
"(let-values(((dir_1)"
"(simplify-path(path->complete-path(cadr p_0) dir_0))))"
"(simplify-path"
"(path->complete-path"
"(decode-link-path(cadr p_0))"
" dir_0))))"
"(if(eq?(car p_0) 'static-root)"
"(let-values()"
"(for-each2"

4
racket/src/cs/primitive/kernel.ss
View File

@ -60,7 +60,7 @@
[bytes->immutable-bytes (known-procedure/no-prompt 2)]
[bytes->list (known-procedure/no-prompt 2)]
[bytes->path (known-procedure/no-prompt 6)]
[bytes->path-element (known-procedure/no-prompt 6)]
[bytes->path-element (known-procedure/no-prompt 14)]
[bytes->string/latin-1 (known-procedure/no-prompt 30)]
[bytes->string/locale (known-procedure/no-prompt 30)]
[bytes->string/utf-8 (known-procedure/no-prompt 30)]
@ -803,7 +803,7 @@
[string->list (known-procedure/no-prompt 2)]
[string->number (known-procedure/no-prompt 62)]
[string->path (known-procedure/no-prompt 2)]
[string->path-element (known-procedure/no-prompt 2)]
[string->path-element (known-procedure/no-prompt 6)]
[string->symbol (known-procedure/no-prompt 2)]
[string->uninterned-symbol (known-procedure/no-prompt 2)]
[string->unreadable-symbol (known-procedure/no-prompt 2)]

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

@ -59568,6 +59568,87 @@
current-directory
(find-system-path 'orig-dir)))
(|#%app| thunk_0))))
(define encoded-link-path?
(lambda (p_0)
(let ((or-part_0 (path-string? p_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (path-bytes? p_0)))
(if or-part_1
or-part_1
(if (pair? p_0)
(if (list? p_0) (andmap_2344 path-element-bytes/same/up? p_0) #f)
#f)))))))
(define path-bytes?
(lambda (p_0)
(if (bytes? p_0)
(if (positive? (unsafe-bytes-length p_0))
(call-with-values
(lambda ()
(begin (check-bytes p_0) (values p_0 (unsafe-bytes-length p_0))))
(case-lambda
((vec_0 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_0)
(begin
(if (unsafe-fx< pos_0 len_0)
(let ((c_0 (unsafe-bytes-ref vec_0 pos_0)))
(let ((result_1 (not (eqv? c_0 0))))
(let ((result_2 (values result_1)))
(if (if (not
(let ((x_0 (list c_0))) (not result_2)))
#t
#f)
(for-loop_0 result_2 (unsafe-fx+ 1 pos_0))
result_2))))
result_0))))))
(for-loop_0 #t 0))))
(args (raise-binding-result-arity-error 2 args))))
#f)
#f)))
(define path-element-bytes/same/up?
(lambda (p_0)
(let ((or-part_0 (eq? p_0 'up)))
(if or-part_0
or-part_0
(let ((or-part_1 (eq? p_0 'same)))
(if or-part_1
or-part_1
(if (path-bytes? p_0)
(let ((p_1
(bytes->path-element
p_0
(system-path-convention-type)
#t)))
(if p_1 (relative-path? p_1) #f))
#f)))))))
(define decode-link-path
(lambda (p_0)
(if (path-string? p_0)
p_0
(if (bytes? p_0)
(bytes->path p_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (path_0 p_1)
(begin
(if (null? p_1)
path_0
(let ((elem_0
(if (bytes? (car p_1))
(bytes->path-element (car p_1))
(car p_1))))
(let ((app_0
(if path_0 (build-path path_0 elem_0) elem_0)))
(loop_0 app_0 (cdr p_1))))))))))
(loop_0 #f p_0))))))
(define finish_3090
(make-struct-type-install-properties
'(shadow-directory)
@ -60009,7 +60090,8 @@
(eq?
'static-root
(car p_0))))))
(if (path-string? (cadr p_0))
(if (encoded-link-path?
(cadr p_0))
(let ((or-part_0
(null? (cddr p_0))))
(if or-part_0
@ -60046,7 +60128,7 @@
(let ((dir_1
(simplify-path
(path->complete-path
(cadr p_0)
(decode-link-path (cadr p_0))
dir_0))))
(if (eq? (car p_0) 'static-root)
(for-each_2380

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

@ -30691,58 +30691,70 @@
(raise-argument-error 'path->bytes "path-for-some-system?" p_0))
(bytes-copy (path-bytes p_0)))))))
(define 1/string->path-element
(|#%name|
string->path-element
(lambda (s_0)
(begin
(begin
(if (string? s_0)
(void)
(raise-argument-error 'string->path-element "string?" s_0))
(check-path-string 'string->path-element s_0)
(do-bytes->path-element
(string->path-bytes s_0)
(system-path-convention-type)
'string->path-element
s_0))))))
(let ((string->path-element_0
(|#%name|
string->path-element
(lambda (s4_0 false-on-non-element?3_0)
(begin
(begin
(if (string? s4_0)
(void)
(raise-argument-error 'string->path-element "string?" s4_0))
(check-path-string 'string->path-element s4_0)
(do-bytes->path-element
(string->path-bytes s4_0)
(system-path-convention-type)
'string->path-element
s4_0
false-on-non-element?3_0)))))))
(|#%name|
string->path-element
(case-lambda
((s_0) (begin (string->path-element_0 s_0 #f)))
((s_0 false-on-non-element?3_0)
(string->path-element_0 s_0 false-on-non-element?3_0))))))
(define 1/bytes->path-element
(let ((bytes->path-element_0
(|#%name|
bytes->path-element
(lambda (bstr4_0 convention3_0)
(lambda (bstr7_0 convention5_0 false-on-non-element?6_0)
(begin
(let ((convention_0
(if (eq? convention3_0 unsafe-undefined)
(if (eq? convention5_0 unsafe-undefined)
(system-path-convention-type)
convention3_0)))
convention5_0)))
(begin
(if (bytes? bstr4_0)
(if (bytes? bstr7_0)
(void)
(raise-argument-error
'bytes->path-element
"bytes?"
bstr4_0))
bstr7_0))
(check-convention 'bytes->path-element convention_0)
(check-path-bytes 'bytes->path-element bstr4_0)
(check-path-bytes 'bytes->path-element bstr7_0)
(do-bytes->path-element
bstr4_0
bstr7_0
convention_0
'bytes->path-element
bstr4_0))))))))
bstr7_0
false-on-non-element?6_0))))))))
(|#%name|
bytes->path-element
(case-lambda
((bstr_0) (begin (bytes->path-element_0 bstr_0 unsafe-undefined)))
((bstr_0 convention3_0) (bytes->path-element_0 bstr_0 convention3_0))))))
((bstr_0) (begin (bytes->path-element_0 bstr_0 unsafe-undefined #f)))
((bstr_0 convention_0 false-on-non-element?6_0)
(bytes->path-element_0 bstr_0 convention_0 false-on-non-element?6_0))
((bstr_0 convention5_0)
(bytes->path-element_0 bstr_0 convention5_0 #f))))))
(define path-element-clean.1
(|#%name|
path-element-clean
(lambda (try-quick?5_0 p7_0)
(lambda (try-quick?8_0 p10_0)
(begin
(if (1/path? p7_0)
(let ((bstr_0 (path-bytes p7_0)))
(let ((convention_0 (path-convention p7_0)))
(if (let ((or-part_0 (not try-quick?5_0)))
(if (1/path? p10_0)
(let ((bstr_0 (path-bytes p10_0)))
(let ((convention_0 (path-convention p10_0)))
(if (let ((or-part_0 (not try-quick?8_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (not (eq? convention_0 'unix))))
@ -30825,7 +30837,7 @@
(args
(raise-binding-result-arity-error 4 args)))))))))
(call-with-values
(lambda () (1/split-path p7_0))
(lambda () (1/split-path p10_0))
(case-lambda
((base_0 name_0 dir?_0)
(if (symbol? base_0) (if (1/path? name_0) name_0 #f) #f))
@ -30834,7 +30846,7 @@
#f)))))
(define path-element? (lambda (p_0) (if (path-element-clean.1 #t p_0) #t #f)))
(define do-bytes->path-element
(lambda (bstr_0 convention_0 who_0 orig-arg_0)
(lambda (bstr_0 convention_0 who_0 orig-arg_0 false-on-non-element?_0)
(let ((bad-element_0
(|#%name|
bad-element
@ -30846,7 +30858,8 @@
"path"
orig-arg_0
"explanation"
"path can be split, is not relative, or names a special element"))))))
(unquoted-printing-string
"path can be split, is not relative, or names a special element")))))))
(begin
(if (eq? 'windows convention_0)
(if (call-with-values
@ -30887,7 +30900,9 @@
(bytes->immutable-bytes bstr_0)
convention_0)
convention_0)))
(begin (if (path-element? p_0) (void) (bad-element_0)) p_0)))))))
(if (path-element? p_0)
p_0
(if false-on-non-element?_0 #f (bad-element_0)))))))))
(define 1/path-element->string
(|#%name|
path-element->string

5
racket/src/expander/eval/collection.rkt
View File

@ -2,6 +2,7 @@
(require racket/private/check
racket/private/config
racket/private/place-local
racket/private/link-path
ffi/unsafe/atomic
"parameter.rkt"
"shadow-directory.rkt"
@ -257,7 +258,7 @@
(or (string? (car p))
(eq? 'root (car p))
(eq? 'static-root (car p)))
(path-string? (cadr p))
(encoded-link-path? (cadr p))
(or (null? (cddr p))
(regexp? (caddr p)))))
v))
@ -269,7 +270,7 @@
(when (or (null? (cddr p))
(regexp-match? (caddr p) (version)))
(let ([dir (simplify-path
(path->complete-path (cadr p) dir))])
(path->complete-path (decode-link-path (cadr p)) dir))])
(cond
[(eq? (car p) 'static-root)
;; multi-collection, constant content:

23
racket/src/io/path/main.rkt
View File

@ -77,19 +77,22 @@
(check who path? #:contract "path-for-some-system?" p)
(bytes-copy (path-bytes p)))
(define/who (string->path-element s)
(define/who (string->path-element s [false-on-non-element? #f])
(check who string? s)
(check-path-string who s)
(do-bytes->path-element (string->path-bytes s)
(system-path-convention-type)
who
s))
s
false-on-non-element?))
(define/who (bytes->path-element bstr [convention (system-path-convention-type)])
(define/who (bytes->path-element bstr
[convention (system-path-convention-type)]
[false-on-non-element? #f])
(check who bytes? bstr)
(check-convention who convention)
(check-path-bytes who bstr)
(do-bytes->path-element bstr convention who bstr))
(do-bytes->path-element bstr convention who bstr false-on-non-element?))
(define (path-element-clean p #:try-quick? [try-quick? #f])
(cond
@ -118,12 +121,13 @@
(define (path-element? p)
(and (path-element-clean p #:try-quick? #t) #t))
(define (do-bytes->path-element bstr convention who orig-arg)
(define (do-bytes->path-element bstr convention who orig-arg false-on-non-element?)
(define (bad-element)
(raise-arguments-error who
"cannot be converted to a path element"
"path" orig-arg
"explanation" "path can be split, is not relative, or names a special element"))
"explanation" (unquoted-printing-string
"path can be split, is not relative, or names a special element")))
(when (eq? 'windows convention)
;; Make sure we don't call `protect-path-element` on a
;; byte string that contains a "\":
@ -133,9 +137,10 @@
(define len (bytes-length bstr))
(define p (path (protect-path-element (bytes->immutable-bytes bstr) convention)
convention))
(unless (path-element? p)
(bad-element))
p)
(cond
[(path-element? p) p]
[false-on-non-element? #f]
[else (bad-element)]))
(define/who (path-element->string p)
(define clean-p (path-element-clean p))