X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/d7928d7c61f297dca574e20bb5815253e90b3a36..08c5d888d4634669634937d9f7b57145fefc848a:/libguile/load.c diff --git a/libguile/load.c b/libguile/load.c index ebf79a9eb..74f3bb49b 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2008, - * 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. + * 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -28,7 +28,6 @@ #include #include "libguile/_scm.h" -#include "libguile/private-gc.h" /* scm_getenv_int */ #include "libguile/libpath.h" #include "libguile/fports.h" #include "libguile/read.h" @@ -50,10 +49,7 @@ #include #include - -#ifdef HAVE_UNISTD_H #include -#endif /* HAVE_UNISTD_H */ #ifdef HAVE_PWD_H #include @@ -89,7 +85,6 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, { SCM hook = *scm_loc_load_hook; SCM ret = SCM_UNSPECIFIED; - char *encoding; SCM_VALIDATE_STRING (1, filename); if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook))) @@ -102,18 +97,14 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0, { SCM port; - port = scm_open_file (filename, scm_from_locale_string ("r")); + port = scm_open_file_with_encoding (filename, + scm_from_latin1_string ("r"), + SCM_BOOL_T, /* guess_encoding */ + scm_from_latin1_string ("UTF-8")); + scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); scm_i_dynwind_current_load_port (port); - encoding = scm_i_scan_for_encoding (port); - if (encoding) - scm_i_set_port_encoding_x (port, encoding); - else - /* The file has no encoding declared. We'll presume UTF-8, like - compile-file does. */ - scm_i_set_port_encoding_x (port, "UTF-8"); - while (1) { SCM reader, form; @@ -285,6 +276,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 @@ -297,7 +323,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 '("") */ @@ -310,7 +336,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 */ ; @@ -353,14 +379,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); @@ -373,24 +402,24 @@ SCM scm_listofnullstr; /* Utility functions for assembling C strings in a buffer. */ -struct stringbuf { +struct stringbuf +{ char *buf, *ptr; size_t buf_len; }; -static void -stringbuf_free (void *data) -{ - struct stringbuf *buf = (struct stringbuf *)data; - free (buf->buf); -} - static void stringbuf_grow (struct stringbuf *buf) { - size_t ptroff = buf->ptr - buf->buf; - buf->buf_len *= 2; - buf->buf = scm_realloc (buf->buf, buf->buf_len); + size_t ptroff, prev_len; + void *prev_buf = buf->buf; + + prev_len = buf->buf_len; + ptroff = buf->ptr - buf->buf; + + buf->buf_len *= 2; + buf->buf = scm_gc_malloc_pointerless (buf->buf_len, "search-path"); + memcpy (buf->buf, prev_buf, prev_len); buf->ptr = buf->buf + ptroff; } @@ -440,31 +469,29 @@ stringbuf_cat (struct stringbuf *buf, char *str) } } - +/* Return non-zero if STR is suffixed by a dot followed by one of + EXTENSIONS. */ static int -scm_c_string_has_an_ext (char *str, size_t len, SCM extensions) +string_has_an_ext (SCM str, SCM extensions) { for (; !scm_is_null (extensions); extensions = SCM_CDR (extensions)) { - char *ext; - size_t extlen; - int match; - ext = scm_to_locale_string (SCM_CAR (extensions)); - extlen = strlen (ext); - match = (len > extlen && str[len - extlen - 1] == '.' - && strncmp (str + (len - extlen), ext, extlen) == 0); - free (ext); - if (match) - return 1; + SCM extension; + + extension = SCM_CAR (extensions); + if (scm_is_true (scm_string_suffix_p (extension, str, + SCM_UNDEFINED, SCM_UNDEFINED, + SCM_UNDEFINED, SCM_UNDEFINED))) + return 1; } + 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) @@ -529,6 +556,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, char *filename_chars; size_t filename_len; SCM result = SCM_BOOL_F; + char initial_buffer[256]; if (scm_ilength (path) < 0) scm_misc_error ("%search-path", "path is not a proper list: ~a", @@ -547,8 +575,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, if (is_absolute_file_name (filename)) { if ((scm_is_false (require_exts) || - scm_c_string_has_an_ext (filename_chars, filename_len, - extensions)) + string_has_an_ext (filename, extensions)) && stat (filename_chars, stat_buf) == 0 && !(stat_buf->st_mode & S_IFDIR)) result = filename; @@ -566,8 +593,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, if (*endp == '.') { if (scm_is_true (require_exts) && - !scm_c_string_has_an_ext (filename_chars, filename_len, - extensions)) + !string_has_an_ext (filename, extensions)) { /* This filename has an extension, but not one of the right ones... */ @@ -590,9 +616,8 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, if (scm_is_null (extensions)) extensions = scm_listofnullstr; - buf.buf_len = 512; - buf.buf = scm_malloc (buf.buf_len); - scm_dynwind_unwind_handler (stringbuf_free, &buf, SCM_F_WIND_EXPLICITLY); + buf.buf_len = sizeof initial_buffer; + buf.buf = initial_buffer; /* Try every path element. */ @@ -628,7 +653,8 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, if (stat (buf.buf, stat_buf) == 0 && ! (stat_buf->st_mode & S_IFDIR)) { - result = scm_from_locale_string (buf.buf); + result = + scm_from_locale_string (scm_i_mirror_backslashes (buf.buf)); goto end; } } @@ -885,7 +911,7 @@ canonical_suffix (SCM fname) /* CANON should be absolute. */ canon = scm_canonicalize_path (fname); - + #ifdef __MINGW32__ { size_t len = scm_c_string_length (canon);