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

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

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

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 (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)]))

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

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