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

io: use PWD to initialize current-directory

Browse Source
This commit is contained in:
Matthew Flatt 2019-01-19 11:09:23 -07:00
parent 24121798bd
commit bf2fac74f2
3 changed files with 52 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
racket/src/io/file/identity.rkt
View File

@ -11,7 +11,8 @@
#:host-path [host-path #f]
#:as-link? [as-link? #f] ; used only if `host-path`
#:fd [fd #f]
#:port [port #f]) ; for errors, and non-#f if `fd` provided
#:port [port #f] ; for errors, and non-#f if `fd` provided
#:no-error? [no-error? #f])
(define r0 (if host-path
(rktio_path_identity rktio host-path (not as-link?))
(rktio_fd_identity rktio fd)))
@ -21,20 +22,23 @@
(rktio_identity_to_vector r0)
(rktio_free r0))))
(end-atomic)
(when (rktio-error? r0)
(raise-filesystem-error who
r
(if host-path
(format (string-append
"error obtaining identity for path\n"
" path: ~a")
(host-> host-path))
(format (string-append
"error obtaining identity for port\n"
" port: ~v")
port))))
(+ (vector-ref r 0)
(arithmetic-shift (vector-ref r 1)
(vector-ref r 3))
(arithmetic-shift (vector-ref r 2)
(+ (vector-ref r 3) (vector-ref r 4)))))
(cond
[(rktio-error? r0)
(and (not no-error?)
(raise-filesystem-error who
r
(if host-path
(format (string-append
"error obtaining identity for path\n"
" path: ~a")
(host-> host-path))
(format (string-append
"error obtaining identity for port\n"
" port: ~v")
port))))]
[else
(+ (vector-ref r 0)
(arithmetic-shift (vector-ref r 1)
(vector-ref r 3))
(arithmetic-shift (vector-ref r 2)
(+ (vector-ref r 3) (vector-ref r 4))))]))

30
racket/src/io/path/system.rkt
View File

@ -5,6 +5,8 @@
"../host/error.rkt"
"../security/main.rkt"
"../file/host.rkt"
"../envvar/main.rkt"
"../file/identity.rkt"
"path.rkt"
"parameter.rkt"
"directory-path.rkt")
@ -57,8 +59,32 @@
(define run-file #f)
(define (set-run-file! p) (set! run-file p))
(define orig-dir (path->directory-path
(host-> (rktio_to_bytes (rktio_get_current_directory rktio)))))
(define orig-dir
(let ()
(define os-host-dir (rktio_to_bytes (rktio_get_current_directory rktio)))
(define os-dir (path->directory-path (host-> os-host-dir)))
(case (system-type 'os)
[(windows) os-dir]
[else
;; Check `PWD` environment variable, and use it when it
;; refers to the same directory as `os-dir`. That's useful
;; when `PWD` refers to a link, for example.
(define pwd (environment-variables-ref (current-environment-variables) #"PWD"))
(cond
[(not pwd) os-dir]
[else
(define os-dir-id
(begin
(start-atomic)
(path-or-fd-identity 'original-directory #:host-path os-host-dir #:no-error? #t)))
(define pwd-id
(begin
(start-atomic)
(path-or-fd-identity 'original-directory #:host-path pwd #:no-error? #t)))
(cond
[(and os-dir-id (eqv? os-dir-id pwd-id ))
(path->directory-path (host-> pwd))]
[else os-dir])])])))
(define collects-dir #f)
(define (set-collects-dir! p) (set! collects-dir p))

2
racket/src/racket/src/file.c
View File

@ -1833,6 +1833,8 @@ Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, intptr_t fd, char *pa
}
if (!ident) {
if (noerr)
return NULL;
if (!path) {
scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
"port-file-identity: error obtaining identity\n"