From 24bd6abecb47ed9acdeb74a2c08ab8238e7ac1b0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 30 Oct 2020 08:25:43 -0600 Subject: [PATCH] cs: `_path` should not force an absolute path While sending an absolute path to a foreign library is usually the right idea to ensure that it's relative to `(current-directory)`, the `_path` FFI type should not do that automatically --- because sometimes it's useful to send a relative path to a foreign library, but most because it hasn't been defined that way in BC. --- racket/src/cs/schemified/io.scm | 16 ++++++++++------ racket/src/io/demo.rkt | 2 -- racket/src/io/host/bootstrap-rktio.rkt | 11 +++++++---- racket/src/io/path/ffi.rkt | 5 +++-- 4 files changed, 20 insertions(+), 14 deletions(-) diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm index 775e1121bf..06dfe85bad 100644 --- a/racket/src/cs/schemified/io.scm +++ b/racket/src/cs/schemified/io.scm @@ -32065,7 +32065,11 @@ (if or-part_0 or-part_0 (path-string? p_0))) (void) (raise-argument-error '_path "(or/c path-string? #f)" p_0)) - (if p_0 (bytes-append (->host p_0 #f '()) #vu8(0)) #f))) + (if p_0 + (bytes-append + (let ((app_0 path-bytes)) (|#%app| app_0 (->path p_0))) + #vu8(0)) + #f))) (lambda (bstr_0) (if (check-not-unsafe-undefined bstr_0 'bstr_119) (path1.1 @@ -35995,11 +35999,11 @@ 'subprocess "(or/c (and/c output-port? file-stream-port?) #f 'stdout)" stderr_0)) - (let ((lr3726 unsafe-undefined) + (let ((lr3728 unsafe-undefined) (group_0 unsafe-undefined) (command_0 unsafe-undefined) (exact/args_0 unsafe-undefined)) - (set! lr3726 + (set! lr3728 (call-with-values (lambda () (if (path-string? group/command_0) @@ -36054,9 +36058,9 @@ ((group_1 command_1 exact/args_1) (vector group_1 command_1 exact/args_1)) (args (raise-binding-result-arity-error 3 args))))) - (set! group_0 (unsafe-vector*-ref lr3726 0)) - (set! command_0 (unsafe-vector*-ref lr3726 1)) - (set! exact/args_0 (unsafe-vector*-ref lr3726 2)) + (set! group_0 (unsafe-vector*-ref lr3728 0)) + (set! command_0 (unsafe-vector*-ref lr3728 1)) + (set! exact/args_0 (unsafe-vector*-ref lr3728 2)) (call-with-values (lambda () (if (if (pair? exact/args_0) diff --git a/racket/src/io/demo.rkt b/racket/src/io/demo.rkt index 10c6f7ced9..a0e5e5393f 100644 --- a/racket/src/io/demo.rkt +++ b/racket/src/io/demo.rkt @@ -15,8 +15,6 @@ (path->string (current-directory)) (set-string->number?! string->number) -(split-path (bytes->path #"c:" 'windows)) - (let () (define-values (i o) (make-pipe 4096)) diff --git a/racket/src/io/host/bootstrap-rktio.rkt b/racket/src/io/host/bootstrap-rktio.rkt index 710402ad2e..3ff6758f4a 100644 --- a/racket/src/io/host/bootstrap-rktio.rkt +++ b/racket/src/io/host/bootstrap-rktio.rkt @@ -28,13 +28,16 @@ (define-syntax-rule (define-constant n v) (define n v)) (define-syntax (define-type stx) - (syntax-case stx (rktio_bool_t rktio_ok_t) + (syntax-case stx (rktio_bool_t rktio_ok_t rktio_const_string_t) [(_ rktio_bool_t _) (with-syntax ([(_ rktio_bool_t _) stx]) #'(define rktio_bool_t _bool))] [(_ rktio_ok_t _) (with-syntax ([(_ rktio_ok_t _) stx]) #'(define rktio_ok_t _bool))] + [(_ rktio_const_string_t t) + (with-syntax ([(_ rktio_const_string_t _) stx]) + #'(define rktio_const_string_t _bytes/nul-terminated))] [(_ n t) #'(define n t)])) (define-syntax (define-struct-type stx) @@ -48,8 +51,8 @@ (define-cstruct _n ([name type] ...)) (define n _n-pointer)))])) -(define-syntax-rule (ref t) _pointer) (define-syntax-rule (*ref t) _pointer) +(define-syntax-rule (ref t) _pointer) (define-syntax-rule (array n t) (_array t n)) (define-syntax-rule (define-function flags ret-type name ([arg-type arg-name] ...)) @@ -138,10 +141,10 @@ [(and len (= i len)) null] [else - (define bs (ptr-ref lls _bytes i)) + (define bs (ptr-ref lls _pointer i)) (if bs (cons (begin0 - (bytes-copy bs) + (cast bs _pointer _bytes) (rktio_free bs)) (loop (add1 i))) null)])) diff --git a/racket/src/io/path/ffi.rkt b/racket/src/io/path/ffi.rkt index 8259d9c2e4..a2f3d94b2a 100644 --- a/racket/src/io/path/ffi.rkt +++ b/racket/src/io/path/ffi.rkt @@ -1,7 +1,6 @@ #lang racket/base (require '#%foreign "../common/check.rkt" - "../file/host.rkt" "path.rkt") (provide _path) @@ -10,6 +9,8 @@ (make-ctype _bytes (lambda (p) (check who path-string? #:or-false p) - (and p (bytes-append (->host p #f '()) #"\0"))) + ;; Don't use `->host`, because it converts relative paths + ;; to absolute paths: + (and p (bytes-append (path-bytes (->path p)) #"\0"))) (lambda (bstr) (and bstr (path (bytes->immutable-bytes bstr) (system-path-convention-type))))))