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.

diff --git a/libguile/filesys.c b/libguile/filesys.c
index 09f6cf9..301040a 100644 (file)
--- 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 */
 
 \f
 #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 87a6988..61b81e9 100644 (file)
--- 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 50b3180..d4bb9ef 100644 (file)
--- 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 ab75ea3..986948d 100644 (file)
--- 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 c6d4be1..b2cf481 100644 (file)
--- 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 e7acd63..6f8fae0 100644 (file)
--- 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: