Unix: initialize `current-directory' from the PWD environment variables

... when PWD is defined and when it refers to the same directory
as the result of getcwd().

A shell sets PWD before starting Racket to communicate a preferred
way of referring to the current directory, which may involve soft
links that are not reflected in getpwd().

collects/scribblings/reference/filesystem.scrbl

@@ -405,7 +405,13 @@ simplification raise an exception if the path is ill-formed. Thus, the
 current value of @racket[current-directory] is always a cleansed,
 simplified, complete, directory path.
 
-The path is not checked for existence when the parameter is set.}
+The path is not checked for existence when the parameter is set.
+
+On Unix and Mac OS X, the initial value of the parameter for a Racket
+process is taken from the @indexed-envvar{PWD} environment
+variable---if the value of the environment variable identifies the
+same directory as the operating system's report of the current
+directory.}
 
 
 @defproc[(current-drive) path?]{

doc/release-notes/racket/HISTORY.txt

@@ -1,5 +1,6 @@
 Version 5.3.4.3
 Added make-environment-variables
+Changed initialization of current-directory to use PWD
 net/url: add support for HTTP/1.1 connections
 
 Version 5.3.4.2

src/racket/include/mzwin.def

@@ -346,6 +346,7 @@ EXPORTS
  scheme_utf16_to_ucs4
  scheme_open_converter
  scheme_close_converter
+ scheme_getenv
  scheme_make_bignum
  scheme_make_bignum_from_unsigned
  scheme_make_bignum_from_long_long

src/racket/include/mzwin3m.def

@@ -361,6 +361,7 @@ EXPORTS
  scheme_utf16_to_ucs4
  scheme_open_converter
  scheme_close_converter
+ scheme_getenv
  scheme_make_bignum
  scheme_make_bignum_from_unsigned
  scheme_make_bignum_from_long_long

src/racket/include/racket.exp

@@ -363,6 +363,7 @@ scheme_ucs4_to_utf16
 scheme_utf16_to_ucs4
 scheme_open_converter
 scheme_close_converter
+scheme_getenv
 scheme_make_bignum
 scheme_make_bignum_from_unsigned
 scheme_make_bignum_from_long_long

src/racket/include/racket3m.exp

@@ -369,6 +369,7 @@ scheme_ucs4_to_utf16
 scheme_utf16_to_ucs4
 scheme_open_converter
 scheme_close_converter
+scheme_getenv
 scheme_make_bignum
 scheme_make_bignum_from_unsigned
 scheme_make_bignum_from_long_long

src/racket/src/file.c

@@ -2391,7 +2391,7 @@ static Scheme_Object *link_exists(int argc, Scheme_Object **argv)
 #endif
 }
 
-Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, intptr_t fd, char *path)
+Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, intptr_t fd, char *path, int noerr)
 /* If path is supplied, then fd is 0 for stat, 1 for lstat */
 {
   int errid = 0;
@@ -2476,6 +2476,7 @@ Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, intptr_t fd, char *pa
     return scheme_bin_plus(devn, inon);
   }
 
+  if (!noerr) {
     if (!path) {
       scheme_raise_exn(MZEXN_FAIL_FILESYSTEM,
                        "port-file-identity: error obtaining identity\n"
@@ -2489,6 +2490,7 @@ Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, intptr_t fd, char *pa
                        path, 
                        errid);
     }
+  }
 
   return NULL;
 }
@@ -5761,7 +5763,7 @@ static Scheme_Object *file_identity(int argc, Scheme_Object *argv[])
   if (argc > 1)
     as_link = SCHEME_TRUEP(argv[1]);
 
-  return scheme_get_fd_identity(NULL, as_link, filename);
+  return scheme_get_fd_identity(NULL, as_link, filename, 0);
 }
 
 static Scheme_Object *file_size(int argc, Scheme_Object *argv[])

src/racket/src/port.c

@@ -4420,7 +4420,7 @@ Scheme_Object *scheme_file_identity(int argc, Scheme_Object *argv[])
     return NULL;
   }
 
-  return scheme_get_fd_identity(p, fd, NULL);
+  return scheme_get_fd_identity(p, fd, NULL, 0);
 }
 
 static int is_fd_terminal(intptr_t fd)

src/racket/src/schemef.h

@@ -696,6 +696,8 @@ MZ_EXTERN mzchar *scheme_utf16_to_ucs4(const unsigned short *text, intptr_t star
 MZ_EXTERN Scheme_Object *scheme_open_converter(const char *from_e, const char *to_e);
 MZ_EXTERN void scheme_close_converter(Scheme_Object *conv);
 
+MZ_EXTERN char *scheme_getenv(char *name);
+
 /*========================================================================*/
 /*                               bignums                                  */
 /*========================================================================*/

src/racket/src/schemex.h

@@ -561,6 +561,7 @@ mzchar *(*scheme_utf16_to_ucs4)(const unsigned short *text, intptr_t start, intp
 				       intptr_t *ulen, intptr_t term_size);
 Scheme_Object *(*scheme_open_converter)(const char *from_e, const char *to_e);
 void (*scheme_close_converter)(Scheme_Object *conv);
+char *(*scheme_getenv)(char *name);
 /*========================================================================*/
 /*                               bignums                                  */
 /*========================================================================*/

src/racket/src/schemex.inc

@@ -406,6 +406,7 @@
   scheme_extension_table->scheme_utf16_to_ucs4 = scheme_utf16_to_ucs4;
   scheme_extension_table->scheme_open_converter = scheme_open_converter;
   scheme_extension_table->scheme_close_converter = scheme_close_converter;
+  scheme_extension_table->scheme_getenv = scheme_getenv;
   scheme_extension_table->scheme_make_bignum = scheme_make_bignum;
   scheme_extension_table->scheme_make_bignum_from_unsigned = scheme_make_bignum_from_unsigned;
   scheme_extension_table->scheme_make_bignum_from_long_long = scheme_make_bignum_from_long_long;

src/racket/src/schemexm.h

@@ -406,6 +406,7 @@
 #define scheme_utf16_to_ucs4 (scheme_extension_table->scheme_utf16_to_ucs4)
 #define scheme_open_converter (scheme_extension_table->scheme_open_converter)
 #define scheme_close_converter (scheme_extension_table->scheme_close_converter)
+#define scheme_getenv (scheme_extension_table->scheme_getenv)
 #define scheme_make_bignum (scheme_extension_table->scheme_make_bignum)
 #define scheme_make_bignum_from_unsigned (scheme_extension_table->scheme_make_bignum_from_unsigned)
 #define scheme_make_bignum_from_long_long (scheme_extension_table->scheme_make_bignum_from_long_long)

src/racket/src/schpriv.h

@@ -3707,7 +3707,7 @@ int scheme_is_special_filename(const char *_f, int not_nul);
 char *scheme_get_exec_path(void);
 Scheme_Object *scheme_get_run_cmd(void);
 
-Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, intptr_t fd, char *path);
+Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, intptr_t fd, char *path, int noerr);
 
 Scheme_Object *scheme_extract_relative_to(Scheme_Object *obj, Scheme_Object *dir);
 

src/racket/src/string.c

@@ -2257,6 +2257,15 @@ static Scheme_Object *normalize_env_case(Scheme_Object *bs)
   return bs;
 }
 
+char *scheme_getenv(char *name)
+{
+#ifdef DOS_FILE_SYSTEM
+  return dos_win_getenv(name);
+#else
+  return getenv(name);
+#endif
+}
+
 static Scheme_Object *sch_getenv(int argc, Scheme_Object *argv[])
 {
   char *name;
@@ -2278,11 +2287,7 @@ static Scheme_Object *sch_getenv(int argc, Scheme_Object *argv[])
   if (!ht) {
     name = SCHEME_BYTE_STR_VAL(bs);
 
-#ifdef DOS_FILE_SYSTEM
-    value = dos_win_getenv(name);
-#else
-    value = getenv(name);
-#endif
+    value = scheme_getenv(name);
 
     return value ? scheme_make_byte_string(value) : scheme_false;
   } else {

src/racket/src/thread.c

@@ -7396,11 +7396,38 @@ static void make_initial_config(Scheme_Thread *p)
 
   init_param(cells, paramz, MZCONFIG_COLLECTION_PATHS,  scheme_null);
 
+  {
+    Scheme_Security_Guard *sg;
+
+    sg = MALLOC_ONE_TAGGED(Scheme_Security_Guard);
+    sg->so.type = scheme_security_guard_type;
+    init_param(cells, paramz, MZCONFIG_SECURITY_GUARD, (Scheme_Object *)sg);
+  }
+
   {
     Scheme_Object *s;
+    char *pwd;
     s = scheme_make_path(scheme_os_getcwd(NULL, 0, NULL, 1));
     s = scheme_path_to_directory_path(s);
     init_param(cells, paramz, MZCONFIG_CURRENT_DIRECTORY, s);
+#ifndef DOS_FILE_SYSTEM
+    pwd = scheme_getenv("PWD");
+    if (pwd) {
+      Scheme_Object *id1, *id2, *a[2];
+      id1 = scheme_get_fd_identity(NULL, 0, pwd, 1);
+      if (id1) {
+        id2 = scheme_get_fd_identity(NULL, 0, SCHEME_PATH_VAL(s), 1);
+        if (id2 && scheme_eqv(id1, id2)) {
+          s = scheme_make_path(pwd);
+          a[0] = s;
+          a[1] = scheme_true;
+          s = scheme_simplify_path(2, a);
+          s = scheme_path_to_directory_path(s);
+          init_param(cells, paramz, MZCONFIG_CURRENT_DIRECTORY, s);
+        }
+      }
+    }
+#endif
     scheme_set_original_dir(s);
   }
 
@@ -7484,14 +7511,6 @@ static void make_initial_config(Scheme_Thread *p)
     init_param(cells, paramz, MZCONFIG_CMDLINE_ARGS, zlv);
   }
 
-  {
-    Scheme_Security_Guard *sg;
-
-    sg = MALLOC_ONE_TAGGED(Scheme_Security_Guard);
-    sg->so.type = scheme_security_guard_type;
-    init_param(cells, paramz, MZCONFIG_SECURITY_GUARD, (Scheme_Object *)sg);
-  }
-
   {
     Scheme_Thread_Set *t_set;
     t_set = create_thread_set(NULL);