[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.11-47-g9235f
From: |
Eli Zaretskii |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.11-47-g9235f80 |
Date: |
Thu, 03 Jul 2014 18:00:05 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=9235f805fa0bacc02a6ddaeceb9867cb37d01d85
The branch, stable-2.0 has been updated
via 9235f805fa0bacc02a6ddaeceb9867cb37d01d85 (commit)
from 9dc3fc4dd474ce4da6a45dcf197e1f99a9a7047a (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 9235f805fa0bacc02a6ddaeceb9867cb37d01d85
Author: Eli Zaretskii <address@hidden>
Date: Thu Jul 3 20:58:19 2014 +0300
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.
-----------------------------------------------------------------------
Summary of changes:
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 09f6cf9..301040a 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 87a6988..61b81e9 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 50b3180..d4bb9ef 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 ab75ea3..986948d 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 c6d4be1..b2cf481 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 e7acd63..6f8fae0 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:
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.11-47-g9235f80,
Eli Zaretskii <=