/* 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
#include <stdio.h>
#include "libguile/_scm.h"
-#include "libguile/private-gc.h" /* scm_getenv_int */
#include "libguile/libpath.h"
#include "libguile/fports.h"
#include "libguile/read.h"
#include <sys/types.h>
#include <sys/stat.h>
-
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#endif /* HAVE_UNISTD_H */
#ifdef HAVE_PWD_H
#include <pwd.h>
{
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)))
{
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;
}
#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
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 '("") */
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 */
;
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);
/* 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;
}
}
}
-
+/* 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)
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",
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;
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... */
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.
*/
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;
}
}
/* CANON should be absolute. */
canon = scm_canonicalize_path (fname);
-
+
#ifdef __MINGW32__
{
size_t len = scm_c_string_length (canon);
HCoop / bpt / guile.git / blobdiff