summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEli Zaretskii <eliz@gnu.org>2014-07-03 20:58:19 +0300
committerEli Zaretskii <eliz@gnu.org>2014-07-03 20:58:19 +0300
commit9235f805fa0bacc02a6ddaeceb9867cb37d01d85 (patch)
tree9a8a3333ad25ec7e302e511ffb6747fee119a95d
parent9dc3fc4dd474ce4da6a45dcf197e1f99a9a7047a (diff)
downloadguile-9235f805fa0bacc02a6ddaeceb9867cb37d01d85.tar.gz
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.
-rw-r--r--libguile/filesys.c4
-rw-r--r--libguile/init.c3
-rw-r--r--libguile/load.c57
-rw-r--r--libguile/load.h1
-rw-r--r--module/ice-9/boot-9.scm2
-rw-r--r--test-suite/tests/ports.test11
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: