io: use PWD to initialize current-directory

racket/src/io/file/identity.rkt

@@ -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,7 +22,9 @@
                   (rktio_identity_to_vector r0)
                   (rktio_free r0))))
   (end-atomic)
-  (when (rktio-error? r0)
+  (cond
+    [(rktio-error? r0)
+     (and (not no-error?)
           (raise-filesystem-error who
                                   r
                                   (if host-path
@@ -32,9 +35,10 @@
                                       (format (string-append
                                                "error obtaining identity for port\n"
                                                "  port: ~v")
-                                        port))))
+                                              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)))))
+                          (+ (vector-ref r 3) (vector-ref r 4))))]))

racket/src/io/path/system.rkt

@@ -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
+(define orig-dir
-                  (host-> (rktio_to_bytes (rktio_get_current_directory rktio)))))
+  (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))

racket/src/racket/src/file.c

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