From 9235f805fa0bacc02a6ddaeceb9867cb37d01d85 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 3 Jul 2014 20:58:19 +0300 Subject: [PATCH] Fix problems with Windows file names that use backslashes. * libguile/load.c (scm_i_mirror_backslashes): New function. (scm_init_load_path): Call it to produce MS-Windows file names with forward slashes. (FILE_NAME_SEPARATOR_STRING): Define as "/" on all platforms. * libguile/load.h (scm_i_mirror_backslashes): Add prototype. * libguile/init.c (scm_boot_guile): Call scm_i_mirror_backslashes on argv[0]. * libguile/filesys.c (scm_getcwd): Call scm_i_mirror_backslashes on the directory name returned by getcwd. * test-suite/tests/ports.test ("file name separators"): New test. --- libguile/filesys.c | 4 +++ libguile/init.c | 3 ++ libguile/load.c | 57 ++++++++++++++++++++++++++++++------- libguile/load.h | 1 + module/ice-9/boot-9.scm | 2 +- test-suite/tests/ports.test | 11 +++++++ 6 files changed, 67 insertions(+), 11 deletions(-) diff --git a/libguile/filesys.c b/libguile/filesys.c index 09f6cf9a5..301040a7d 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -51,6 +51,7 @@ #include "libguile/validate.h" #include "libguile/filesys.h" +#include "libguile/load.h" /* for scm_i_mirror_backslashes */ #ifdef HAVE_IO_H @@ -1235,6 +1236,9 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0, errno = save_errno; SCM_SYSERROR; } + /* On Windows, convert backslashes in current directory to forward + slashes. */ + scm_i_mirror_backslashes (wd); result = scm_from_locale_stringn (wd, strlen (wd)); free (wd); return result; diff --git a/libguile/init.c b/libguile/init.c index 87a69884e..61b81e954 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -311,6 +311,9 @@ scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure) void *res; struct main_func_closure c; + /* On Windows, convert backslashes in argv[0] to forward + slashes. */ + scm_i_mirror_backslashes (argv[0]); c.main_func = main_func; c.closure = closure; c.argc = argc; diff --git a/libguile/load.c b/libguile/load.c index 50b3180e6..d4bb9ef85 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -277,6 +277,41 @@ SCM_DEFINE (scm_parse_path_with_ellipsis, "parse-path-with-ellipsis", 2, 0, 0, } #undef FUNC_NAME +/* On Posix hosts, just return PATH unaltered. On Windows, + destructively replace all backslashes in PATH with Unix-style + forward slashes, so that Scheme code always gets d:/foo/bar style + file names. This avoids multiple subtle problems with comparing + file names as strings, and with redirections in /bin/sh command + lines. + + Note that, if PATH is result of a call to 'getenv', this + destructively modifies the environment variables, so both + scm_getenv and subprocesses will afterwards see the values with + forward slashes. That is OK as long as applied to Guile-specific + environment variables, since having scm_getenv return the same + value as used by the callers of this function is good for + consistency and file-name comparison. Avoid using this function on + values returned by 'getenv' for general-purpose environment + variables; instead, make a copy of the value and work on that. */ +SCM_INTERNAL char * +scm_i_mirror_backslashes (char *path) +{ +#ifdef __MINGW32__ + if (path) + { + char *p = path; + + while (*p) + { + if (*p == '\\') + *p = '/'; + p++; + } + } +#endif + + return path; +} /* Initialize the global variable %load-path, given the value of the SCM_SITE_DIR and SCM_LIBRARY_DIR preprocessor symbols and the @@ -289,7 +324,7 @@ scm_init_load_path () SCM cpath = SCM_EOL; #ifdef SCM_LIBRARY_DIR - env = getenv ("GUILE_SYSTEM_PATH"); + env = scm_i_mirror_backslashes (getenv ("GUILE_SYSTEM_PATH")); if (env && strcmp (env, "") == 0) /* special-case interpret system-path=="" as meaning no system path instead of '("") */ @@ -302,7 +337,7 @@ scm_init_load_path () scm_from_locale_string (SCM_GLOBAL_SITE_DIR), scm_from_locale_string (SCM_PKGDATA_DIR)); - env = getenv ("GUILE_SYSTEM_COMPILED_PATH"); + env = scm_i_mirror_backslashes (getenv ("GUILE_SYSTEM_COMPILED_PATH")); if (env && strcmp (env, "") == 0) /* like above */ ; @@ -345,14 +380,17 @@ scm_init_load_path () cachedir[0] = 0; if (cachedir[0]) - *scm_loc_compile_fallback_path = scm_from_locale_string (cachedir); + { + scm_i_mirror_backslashes (cachedir); + *scm_loc_compile_fallback_path = scm_from_locale_string (cachedir); + } } - env = getenv ("GUILE_LOAD_PATH"); + env = scm_i_mirror_backslashes (getenv ("GUILE_LOAD_PATH")); if (env) path = scm_parse_path_with_ellipsis (scm_from_locale_string (env), path); - env = getenv ("GUILE_LOAD_COMPILED_PATH"); + env = scm_i_mirror_backslashes (getenv ("GUILE_LOAD_COMPILED_PATH")); if (env) cpath = scm_parse_path_with_ellipsis (scm_from_locale_string (env), cpath); @@ -452,11 +490,10 @@ scm_c_string_has_an_ext (char *str, size_t len, SCM extensions) return 0; } -#ifdef __MINGW32__ -#define FILE_NAME_SEPARATOR_STRING "\\" -#else +/* Defined as "/" for Unix and Windows alike, so that file names + constructed by the functions in this module wind up with Unix-style + forward slashes as directory separators. */ #define FILE_NAME_SEPARATOR_STRING "/" -#endif static int is_file_name_separator (SCM c) @@ -877,7 +914,7 @@ canonical_suffix (SCM fname) /* CANON should be absolute. */ canon = scm_canonicalize_path (fname); - + #ifdef __MINGW32__ { size_t len = scm_c_string_length (canon); diff --git a/libguile/load.h b/libguile/load.h index ab75ea3b3..986948d3f 100644 --- a/libguile/load.h +++ b/libguile/load.h @@ -44,6 +44,7 @@ SCM_INTERNAL void scm_init_load_path (void); SCM_INTERNAL void scm_init_load (void); SCM_INTERNAL void scm_init_load_should_auto_compile (void); SCM_INTERNAL void scm_init_eval_in_scheme (void); +SCM_INTERNAL char *scm_i_mirror_backslashes (char *path); #endif /* SCM_LOAD_H */ diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index c6d4be111..b2cf48186 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1657,7 +1657,7 @@ VALUE." (or (char=? c #\/) (char=? c #\\))) - (define file-name-separator-string "\\") + (define file-name-separator-string "/") (define (absolute-file-name? file-name) (define (file-name-separator-at-index? idx) diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index e7acd6332..6f8fae02e 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -1888,6 +1888,17 @@ (with-fluids ((%file-port-name-canonicalization 'absolute)) (port-filename (open-input-file (%search-load-path "ice-9/q.scm")))))) +(with-test-prefix "file name separators" + + (pass-if "no backslash separators in Windows file names" + ;; In Guile 2.0.11 and earlier, %load-path on Windows could + ;; include file names with backslashes, and `getcwd' on Windows + ;; would always return a directory name with backslashes. + (or (not (file-name-separator? #\\)) + (with-load-path (cons (getcwd) %load-path) + (not (string-index (%search-load-path (basename (test-file))) + #\\)))))) + (delete-file (test-file)) ;;; Local Variables: -- 2.20.1