mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 00:10:21 +02:00
Code Activity

* load.c (scm_search_path): Don't try extensions which already are

Browse source 
present at the end of the filename.
(scm_init_load): Check .scm first. (Thanks to Keisuke Nishida.)
This commit is contained in:
Mikael Djurfeldt 1999-08-29 14:22:29 +00:00
parent 81123e6d05
commit 0a74e31d21
1 changed files with 46 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

82
libguile/load.c
View file

@ -221,10 +221,11 @@ scm_search_path (path, filename, extensions)
SCM filename; SCM filename;
SCM extensions; SCM extensions;
{ {
char *buf; char *buf, *endp;
int filename_len; int filename_len;
size_t max_path_len; size_t max_path_len;
size_t max_ext_len; size_t max_ext_len;
SCM result = SCM_BOOL_F;
SCM_ASSERT (scm_ilength (path) >= 0, path, SCM_ARG1, s_search_path); SCM_ASSERT (scm_ilength (path) >= 0, path, SCM_ARG1, s_search_path);
SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename,
@ -252,8 +253,8 @@ scm_search_path (path, filename, extensions)
SCM_ASSERT (SCM_NIMP (elt) && SCM_ROSTRINGP (elt), elt, SCM_ASSERT (SCM_NIMP (elt) && SCM_ROSTRINGP (elt), elt,
"path is not a list of strings", "path is not a list of strings",
s_search_path); s_search_path);
if (SCM_LENGTH (elt) > max_path_len) if (SCM_ROLENGTH (elt) > max_path_len)
max_path_len = SCM_LENGTH (elt); max_path_len = SCM_ROLENGTH (elt);
} }
} }
@ -269,11 +270,22 @@ scm_search_path (path, filename, extensions)
SCM_ASSERT (SCM_NIMP (elt) && SCM_ROSTRINGP (elt), elt, SCM_ASSERT (SCM_NIMP (elt) && SCM_ROSTRINGP (elt), elt,
"extension list is not a list of strings", "extension list is not a list of strings",
s_search_path); s_search_path);
if (SCM_LENGTH (elt) > max_ext_len) if (SCM_ROLENGTH (elt) > max_ext_len)
max_ext_len = SCM_LENGTH (elt); max_ext_len = SCM_ROLENGTH (elt);
} }
} }
/* Remove the same extension that FILENAME already has. */
for (endp = SCM_ROCHARS (filename) + filename_len - 1;
endp > SCM_ROCHARS (filename) && *endp != '/'; endp--)
if (*endp == '.')
{
extensions = scm_delete (scm_makfromstr (endp, SCM_ROCHARS (filename)
+ filename_len - endp, 0),
extensions);
break;
}
SCM_DEFER_INTS; SCM_DEFER_INTS;
buf = scm_must_malloc (max_path_len + 1 + filename_len + max_ext_len + 1, buf = scm_must_malloc (max_path_len + 1 + filename_len + max_ext_len + 1,
@ -283,45 +295,43 @@ scm_search_path (path, filename, extensions)
list of strings. */ list of strings. */
for (; SCM_NIMP (path); path = SCM_CDR (path)) for (; SCM_NIMP (path); path = SCM_CDR (path))
{ {
SCM path_elt = SCM_CAR (path), exts; int len;
SCM dir = SCM_CAR (path), exts;
/* Concatenate the path name and the filename. */
len = SCM_ROLENGTH (dir);
memcpy (buf, SCM_ROCHARS (dir), len);
if (len >= 1 && buf[len - 1] != '/')
buf[len++] = '/';
memcpy (buf + len, SCM_ROCHARS (filename), filename_len);
endp = buf + len + filename_len;
/* Try every extension. At this point, we know it's a proper /* Try every extension. At this point, we know it's a proper
list of strings. */ list of strings. */
for (exts = extensions; SCM_NIMP (exts); exts = SCM_CDR (exts)) for (exts = extensions; SCM_NIMP (exts); exts = SCM_CDR (exts))
{ {
SCM ext_elt = SCM_CAR (exts); SCM ext = SCM_CAR (exts);
int i; struct stat mode;
/* Concatenate the path name, the filename, and the extension. */ /* Concatenate the extension. */
i = SCM_ROLENGTH (path_elt); len = SCM_ROLENGTH (ext);
memcpy (buf, SCM_ROCHARS (path_elt), i); memcpy (endp, SCM_ROCHARS (ext), len);
if (i >= 1 && buf[i - 1] != '/') *(endp + len) = '\0';
buf[i++] = '/';
memcpy (buf + i, SCM_ROCHARS (filename), filename_len);
i += filename_len;
memcpy (buf + i, SCM_ROCHARS (ext_elt), SCM_LENGTH (ext_elt));
i += SCM_LENGTH (ext_elt);
buf[i] = '\0';
{ if (stat (buf, &mode) == 0
struct stat mode; && ! (mode.st_mode & S_IFDIR)
&& access (buf, R_OK) == 0)
if (stat (buf, &mode) >= 0 {
&& ! (mode.st_mode & S_IFDIR) result = scm_makfromstr (buf, endp + len - buf, 0);
&& access (buf, R_OK) == 0) goto end;
{ }
SCM result = scm_makfromstr (buf, i, 0);
scm_must_free (buf);
SCM_ALLOW_INTS;
return result;
}
}
} }
} }
end:
scm_must_free (buf); scm_must_free (buf);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return SCM_BOOL_F; return result;
} }
@ -363,7 +373,7 @@ scm_primitive_load_path (filename)
if (SCM_FALSEP (full_filename)) if (SCM_FALSEP (full_filename))
{ {
int absolute = (SCM_LENGTH (filename) >= 1 int absolute = (SCM_ROLENGTH (filename) >= 1
&& SCM_ROCHARS (filename)[0] == '/'); && SCM_ROCHARS (filename)[0] == '/');
scm_misc_error (s_primitive_load_path, scm_misc_error (s_primitive_load_path,
(absolute (absolute
@ -421,8 +431,8 @@ scm_init_load ()
scm_loc_load_path = SCM_CDRLOC (scm_sysintern ("%load-path", SCM_EOL)); scm_loc_load_path = SCM_CDRLOC (scm_sysintern ("%load-path", SCM_EOL));
scm_loc_load_extensions scm_loc_load_extensions
= SCM_CDRLOC (scm_sysintern ("%load-extensions", = SCM_CDRLOC (scm_sysintern ("%load-extensions",
scm_listify (scm_makfrom0str (""), scm_listify (scm_makfrom0str (".scm"),
scm_makfrom0str (".scm"), scm_makfrom0str (""),
SCM_UNDEFINED))); SCM_UNDEFINED)));
scm_loc_load_hook = SCM_CDRLOC (scm_sysintern ("%load-hook", SCM_BOOL_F)); scm_loc_load_hook = SCM_CDRLOC (scm_sysintern ("%load-hook", SCM_BOOL_F));