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

cs: _path should not force an absolute path

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2020-10-30 08:25:43 -06:00
parent 943102d8f1
commit 24bd6abecb
4 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -32065,7 +32065,11 @@
(if or-part_0 or-part_0 (path-string? p_0))) (if or-part_0 or-part_0 (path-string? p_0)))
(void) (void)
(raise-argument-error '_path "(or/c path-string? #f)" p_0)) (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) (lambda (bstr_0)
(if (check-not-unsafe-undefined bstr_0 'bstr_119) (if (check-not-unsafe-undefined bstr_0 'bstr_119)
(path1.1 (path1.1
@ -35995,11 +35999,11 @@
'subprocess 'subprocess
"(or/c (and/c output-port? file-stream-port?) #f 'stdout)" "(or/c (and/c output-port? file-stream-port?) #f 'stdout)"
stderr_0)) stderr_0))
(let ((lr3726 unsafe-undefined) (let ((lr3728 unsafe-undefined)
(group_0 unsafe-undefined) (group_0 unsafe-undefined)
(command_0 unsafe-undefined) (command_0 unsafe-undefined)
(exact/args_0 unsafe-undefined)) (exact/args_0 unsafe-undefined))
(set! lr3726 (set! lr3728
(call-with-values (call-with-values
(lambda () (lambda ()
(if (path-string? group/command_0) (if (path-string? group/command_0)
@ -36054,9 +36058,9 @@
((group_1 command_1 exact/args_1) ((group_1 command_1 exact/args_1)
(vector group_1 command_1 exact/args_1)) (vector group_1 command_1 exact/args_1))
(args (raise-binding-result-arity-error 3 args))))) (args (raise-binding-result-arity-error 3 args)))))
(set! group_0 (unsafe-vector*-ref lr3726 0)) (set! group_0 (unsafe-vector*-ref lr3728 0))
(set! command_0 (unsafe-vector*-ref lr3726 1)) (set! command_0 (unsafe-vector*-ref lr3728 1))
(set! exact/args_0 (unsafe-vector*-ref lr3726 2)) (set! exact/args_0 (unsafe-vector*-ref lr3728 2))
(call-with-values (call-with-values
(lambda () (lambda ()
(if (if (pair? exact/args_0) (if (if (pair? exact/args_0)

2
racket/src/io/demo.rkt
View File

@ -15,8 +15,6 @@
(path->string (current-directory)) (path->string (current-directory))
(set-string->number?! string->number) (set-string->number?! string->number)
(split-path (bytes->path #"c:" 'windows))
(let () (let ()
(define-values (i o) (make-pipe 4096)) (define-values (i o) (make-pipe 4096))

11
racket/src/io/host/bootstrap-rktio.rkt
View File

@ -28,13 +28,16 @@
(define-syntax-rule (define-constant n v) (define n v)) (define-syntax-rule (define-constant n v) (define n v))
(define-syntax (define-type stx) (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 _) [(_ rktio_bool_t _)
(with-syntax ([(_ rktio_bool_t _) stx]) (with-syntax ([(_ rktio_bool_t _) stx])
#'(define rktio_bool_t _bool))] #'(define rktio_bool_t _bool))]
[(_ rktio_ok_t _) [(_ rktio_ok_t _)
(with-syntax ([(_ rktio_ok_t _) stx]) (with-syntax ([(_ rktio_ok_t _) stx])
#'(define rktio_ok_t _bool))] #'(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)])) [(_ n t) #'(define n t)]))
(define-syntax (define-struct-type stx) (define-syntax (define-struct-type stx)
@ -48,8 +51,8 @@
(define-cstruct _n ([name type] ...)) (define-cstruct _n ([name type] ...))
(define n _n-pointer)))])) (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 (ref t) _pointer)
(define-syntax-rule (array n t) (_array t n)) (define-syntax-rule (array n t) (_array t n))
(define-syntax-rule (define-function flags ret-type name ([arg-type arg-name] ...)) (define-syntax-rule (define-function flags ret-type name ([arg-type arg-name] ...))
@ -138,10 +141,10 @@
[(and len (= i len)) [(and len (= i len))
null] null]
[else [else
(define bs (ptr-ref lls _bytes i)) (define bs (ptr-ref lls _pointer i))
(if bs (if bs
(cons (begin0 (cons (begin0
(bytes-copy bs) (cast bs _pointer _bytes)
(rktio_free bs)) (rktio_free bs))
(loop (add1 i))) (loop (add1 i)))
null)])) null)]))

5
racket/src/io/path/ffi.rkt
View File

@ -1,7 +1,6 @@
#lang racket/base #lang racket/base
(require '#%foreign (require '#%foreign
"../common/check.rkt" "../common/check.rkt"
"../file/host.rkt"
"path.rkt") "path.rkt")
(provide _path) (provide _path)
@ -10,6 +9,8 @@
(make-ctype _bytes (make-ctype _bytes
(lambda (p) (lambda (p)
(check who path-string? #:or-false 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) (lambda (bstr) (and bstr (path (bytes->immutable-bytes bstr)
(system-path-convention-type)))))) (system-path-convention-type))))))