> From: l...@gnu.org (Ludovic Courtès)
> Cc: guile-devel@gnu.org
> Date: Wed, 02 Jul 2014 22:57:41 +0200
>
> Eli Zaretskii <e...@gnu.org> skribis:
>
> >> From: l...@gnu.org (Ludovic Courtès)
> >> Cc: guile-devel@gnu.org
> >> Date: Tue, 01 Jul 2014 17:38:04 +0200
>
> [...]
>
> >> You can look at load.c, and in particular scm_init_load_path.
> >
> > OK, thanks for the pointer.
> >
> > I've reviewed the related code, and below is what I suggest to push.
> > (This supersedes what I sent in
> > http://lists.gnu.org/archive/html/guile-devel/2014-06/msg00066.html.)
>
> Also, could you add tests for that? Namely, a ‘search-path’ use that
> currently returns a file name with backslashes, and will now return a
> file name with forward slashes.
Is the below OK?
--- libguile/load.c~0 2014-02-28 23:01:27 +0200
+++ libguile/load.c 2014-07-03 09:58:29 +0300
@@ -277,6 +277,41 @@ SCM_DEFINE (scm_parse_path_with_ellipsis
}
#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
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);
--- libguile/load.h~0 2013-03-19 00:30:13 +0200
+++ libguile/load.h 2014-07-03 09:59:17 +0300
@@ -44,6 +44,7 @@ SCM_INTERNAL void scm_init_load_path (vo
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 */
--- libguile/filesys.c~0 2014-02-28 23:01:27 +0200
+++ libguile/filesys.c 2014-07-03 10:03:25 +0300
@@ -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 +1248,9 @@ SCM_DEFINE (scm_getcwd, "getcwd", 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;
--- libguile/init.c~0 2014-02-28 23:01:27 +0200
+++ libguile/init.c 2014-07-03 10:02:03 +0300
@@ -311,6 +311,9 @@ scm_boot_guile (int argc, char ** argv,
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;
--- module/ice-9/boot-9.scm~ 2014-02-15 01:00:33 +0200
+++ module/ice-9/boot-9.scm 2014-06-29 16:15:07 +0300
@@ -1657,7 +1657,7 @@
(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)
--- test-suite/tests/ports.test~2 2014-06-29 16:06:51 +0300
+++ test-suite/tests/ports.test 2014-07-03 10:55:30 +0300
@@ -1866,6 +1865,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:
