diff --git a/collects/scribblings/reference/filesystem.scrbl b/collects/scribblings/reference/filesystem.scrbl index 03169c51e5..56ad60f7ee 100644 --- a/collects/scribblings/reference/filesystem.scrbl +++ b/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?]{ diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 1de9260827..0e126dfa2f 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/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 diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index 246863aba7..ec6329dd83 100644 --- a/src/racket/include/mzwin.def +++ b/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 diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index f02f978382..54e07a2563 100644 --- a/src/racket/include/mzwin3m.def +++ b/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 diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index d18d90800d..f623663913 100644 --- a/src/racket/include/racket.exp +++ b/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 diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index 95412d5de5..74417004cd 100644 --- a/src/racket/include/racket3m.exp +++ b/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 diff --git a/src/racket/src/file.c b/src/racket/src/file.c index aab6cc435c..f1f6194a1c 100644 --- a/src/racket/src/file.c +++ b/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,18 +2476,20 @@ Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, intptr_t fd, char *pa return scheme_bin_plus(devn, inon); } - if (!path) { - scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, - "port-file-identity: error obtaining identity\n" - " system error: %)", - errid); - } else { - scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, - "file-or-directory-identity: error obtaining identity for path\n" - " path: %q\n" - " system error: %E", - path, - errid); + if (!noerr) { + if (!path) { + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + "port-file-identity: error obtaining identity\n" + " system error: %)", + errid); + } else { + scheme_raise_exn(MZEXN_FAIL_FILESYSTEM, + "file-or-directory-identity: error obtaining identity for path\n" + " path: %q\n" + " system error: %E", + 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[]) diff --git a/src/racket/src/port.c b/src/racket/src/port.c index 43757bc074..5d9eab3593 100644 --- a/src/racket/src/port.c +++ b/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) diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index f0ad804030..93ba9fbd14 100644 --- a/src/racket/src/schemef.h +++ b/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 */ /*========================================================================*/ diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index ba67b539b3..e68bca152e 100644 --- a/src/racket/src/schemex.h +++ b/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 */ /*========================================================================*/ diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index ae1769ab64..9705412080 100644 --- a/src/racket/src/schemex.inc +++ b/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; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index 17c64710e6..2ff2a2fe4f 100644 --- a/src/racket/src/schemexm.h +++ b/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) diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 913789560d..058b8ee7b7 100644 --- a/src/racket/src/schpriv.h +++ b/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); diff --git a/src/racket/src/string.c b/src/racket/src/string.c index 63b589842a..7eb90b9195 100644 --- a/src/racket/src/string.c +++ b/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 { diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 034645d906..ccf66d0365 100644 --- a/src/racket/src/thread.c +++ b/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);