Re: Windows file name separators

[Eli Zaretskii <eliz@gnu.org>]

> From: ludo@gnu.org (Ludovic Courtès)
> Cc: guile-devel@gnu.org
> Date: Wed, 02 Jul 2014 22:57:41 +0200
> 
> Eli Zaretskii <eliz@gnu.org> skribis:
> 
> >> From: ludo@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 */
 
 \f
 #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: