diff options
author | Andy Wingo <wingo@pobox.com> | 2013-02-24 13:48:02 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-02-24 14:18:27 +0100 |
commit | 4bab7f01be8a1ce321f1e30235e1077f1ea0804c (patch) | |
tree | 02647b6d32ce7dad0dfa05f7e23fdd33ae3969cb | |
parent | 65fa3923060dd66b166fd858bcd6f462f37ee8c0 (diff) | |
download | guile-4bab7f01be8a1ce321f1e30235e1077f1ea0804c.tar.gz |
load.c uses same logic as boot-9 for file names
* libguile/load.c (is_file_name_separator, is_drive_letter):
(is_absolute_file_name): New helpers, like the ones in boot-9.
Perhaps we should just define them in C.
(search_path, scm_try_auto_compile, canonical_suffix): Rewrite using
the new helpers.
-rw-r--r-- | libguile/load.c | 112 |
1 files changed, 80 insertions, 32 deletions
diff --git a/libguile/load.c b/libguile/load.c index 84b670549..f2af6c83b 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -447,6 +447,58 @@ scm_c_string_has_an_ext (char *str, size_t len, SCM extensions) return 0; } +#ifdef __MINGW32__ +#define FILE_NAME_SEPARATOR_STRING "\\" +#else +#define FILE_NAME_SEPARATOR_STRING "/" +#endif + +static int +is_file_name_separator (SCM c) +{ + if (c == SCM_MAKE_CHAR ('/')) + return 1; +#ifdef __MINGW32__ + if (c == SCM_MAKE_CHAR ('\\')) + return 1; +#endif + return 0; +} + +static int +is_drive_letter (SCM c) +{ +#ifdef __MINGW32__ + if (SCM_CHAR (c) >= 'a' && SCM_CHAR (c) <= 'z') + return 1; + else if (SCM_CHAR (c) >= 'A' && SCM_CHAR (c) <= 'Z') + return 1; +#endif + return 0; +} + +static int +is_absolute_file_name (const char *filename_chars, size_t filename_len) +{ + if (filename_len >= 1 + && is_file_name_separator (SCM_MAKE_CHAR (filename_chars[0])) +#ifdef __MINGW32__ + /* On Windows, one initial separator indicates a drive-relative + path. Two separators indicate a Universal Naming Convention + (UNC) path. UNC paths are always absolute. */ + && filename_len >= 2 + && is_file_name_separator (SCM_MAKE_CHAR (filename_chars[1])) +#endif + ) + return 1; + if (filename_len >= 3 + && is_drive_letter (SCM_MAKE_CHAR (filename_chars[0])) + && filename_chars[1] == ':' + && is_file_name_separator (SCM_MAKE_CHAR (filename_chars[2]))) + return 1; + return 0; +} + /* Search PATH for a directory containing a file named FILENAME. The file must be readable, and not a directory. If we find one, return its full pathname; otherwise, return #f. @@ -477,16 +529,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, scm_dynwind_free (filename_chars); /* If FILENAME is absolute and is still valid, return it unchanged. */ -#ifdef __MINGW32__ - if (((filename_len >= 1) && - (filename_chars[0] == '/' || filename_chars[0] == '\\')) || - ((filename_len >= 3) && filename_chars[1] == ':' && - ((filename_chars[0] >= 'a' && filename_chars[0] <= 'z') || - (filename_chars[0] >= 'A' && filename_chars[0] <= 'Z')) && - (filename_chars[2] == '/' || filename_chars[2] == '\\'))) -#else - if (filename_len >= 1 && filename_chars[0] == '/') -#endif + if (is_absolute_file_name (filename_chars, filename_len)) { if ((scm_is_false (require_exts) || scm_c_string_has_an_ext (filename_chars, filename_len, @@ -520,11 +563,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, extensions = SCM_EOL; break; } -#ifdef __MINGW32__ - else if (*endp == '/' || *endp == '\\') -#else - else if (*endp == '/') -#endif + else if (is_file_name_separator (SCM_MAKE_CHAR (*endp))) /* This filename has no extension, so keep the current list of extensions. */ break; @@ -553,12 +592,9 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, /* Concatenate the path name and the filename. */ -#ifdef __MINGW32__ - if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/') && (buf.ptr[-1] != '\\')) -#else - if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/')) -#endif - stringbuf_cat (&buf, "/"); + if (buf.ptr > buf.buf + && !is_file_name_separator (SCM_MAKE_CHAR (buf.ptr[-1]))) + stringbuf_cat (&buf, FILE_NAME_SEPARATOR_STRING); stringbuf_cat (&buf, filename_chars); sans_ext_len = buf.ptr - buf.buf; @@ -823,24 +859,36 @@ scm_try_auto_compile (SCM source) NULL, NULL); } -/* See also (system base compile):compiled-file-name. */ +/* The auto-compilation code will residualize a .go file in the cache + dir: by default, $HOME/.cache/guile/2.0/ccache/PATH.go. This + function determines the PATH to use as a key into the compilation + cache. See also (system base compile):compiled-file-name. */ static SCM canonical_suffix (SCM fname) { SCM canon; - size_t len; + /* CANON should be absolute. */ canon = scm_canonicalize_path (fname); - len = scm_c_string_length (canon); - if (len > 1 && scm_is_eq (scm_c_string_ref (canon, 0), SCM_MAKE_CHAR ('/'))) - return canon; - else if (len > 2 && scm_is_eq (scm_c_string_ref (canon, 1), SCM_MAKE_CHAR (':'))) - return scm_string_append (scm_list_3 (scm_from_latin1_string ("/"), - scm_c_substring (canon, 0, 1), - scm_c_substring (canon, 2, len))); - else - return canon; +#ifdef __MINGW32__ + { + size_t len = scm_c_string_length (canon); + + /* On Windows, an absolute file name that doesn't start with a + separator starts with a drive component. Transform the drive + component to a file name element: c:\foo -> \c\foo. */ + if (len >= 2 + && is_absolute_file_name (canon) + && !is_file_name_separator (scm_c_string_ref (canon, 0))) + return scm_string_append + (scm_list_3 (scm_from_latin1_string (FILE_NAME_SEPARATOR_STRING), + scm_c_substring (canon, 0, 1), + scm_c_substring (canon, 2, len))); + } +#endif + + return canon; } SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, |