mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

Ensure that shared substrings are handled properly when passed to

Browse source 
a system call or other foreign function.  Many thanks to Tim
Pierce!
* symbols.h (SCM_COERCE_SUBSTR): new macro.
* filesys.c (scm_chmod, scm_rename, scm_delete_file, scm_mkdir,
scm_rmdir, scm_opendir, scm_chdir, scm_symlink, scm_readlink,
scm_lstat), ports.c (scm_sys_make_void_port), posix.c (scm_utime,
scm_putenv, scm_setlocale, scm_mknod), stime.c (setzone,
scm_strftime), vports.c (scm_make_soft_port), backtrace.c
(scm_display_error_message): use RO macros when strings may be RO.
* error.c (scm_error_scm), filesys.c (scm_chown, scm_chmod,
scm_rename, scm_delete_file, scm_mkdir, scm_rmdir, scm_opendir,
scm_chdir, scm_symlink, scm_readlink, scm_lstat), ioext.c
(scm_freopen, scm_duplicate_port, scm_fdopen), net_db.c
(scm_gethost, scm_getnet, scm_getproto, scm_getserv), ports.c
(scm_sys_make_void_port), posix.c (scm_getgrgid, scm_utime,
scm_setlocale, scm_mknod), stime.c (setzone, scm_strptime,
scm_strftime), vports.c (scm_make_soft_port): use
SCM_COERCE_SUBSTR to make sure shared substrings are
null-terminated.
This commit is contained in:
Jim Blandy 1997-05-12 22:43:10 +00:00
parent dec4cca94f
commit 89958ad0ef
10 changed files with 95 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/backtrace.c
View file

@ -99,7 +99,7 @@ scm_display_error_message (message, args, port)
char *start; char *start;
char *p; char *p;
if (SCM_IMP (message) || !SCM_STRINGP (message) || SCM_IMP (args) if (SCM_IMP (message) || !SCM_ROSTRINGP (message) || SCM_IMP (args)
|| !scm_list_p (args)) || !scm_list_p (args))
{ {
scm_prin1 (message, port, 0); scm_prin1 (message, port, 0);
@ -107,7 +107,8 @@ scm_display_error_message (message, args, port)
return; return;
} }
start = SCM_CHARS (message); SCM_COERCE_SUBSTR (message);
start = SCM_ROCHARS (message);
for (p = start; *p != '\0'; ++p) for (p = start; *p != '\0'; ++p)
if (*p == '%') if (*p == '%')
{ {

5
libguile/error.c
View file

@ -84,7 +84,8 @@ scm_error (key, subr, message, args, rest)
/* No return, but just in case: */ /* No return, but just in case: */
write (2, "unhandled system error", sizeof ("unhandled system error") - 1); write (2, "unhandled system error\n",
sizeof ("unhandled system error\n") - 1);
exit (1); exit (1);
} }
@ -105,6 +106,8 @@ scm_error_scm (key, subr, message, args, rest)
|| (SCM_NIMP (message) && SCM_ROSTRINGP (message)), || (SCM_NIMP (message) && SCM_ROSTRINGP (message)),
message, SCM_ARG3, s_error_scm); message, SCM_ARG3, s_error_scm);
SCM_COERCE_SUBSTR (message);
scm_error (key, scm_error (key,
(SCM_FALSEP (subr)) ? NULL : SCM_ROCHARS (subr), (SCM_FALSEP (subr)) ? NULL : SCM_ROCHARS (subr),
(SCM_FALSEP (message)) ? NULL : SCM_ROCHARS (message), (SCM_FALSEP (message)) ? NULL : SCM_ROCHARS (message),

79
libguile/filesys.c
View file

@ -139,10 +139,10 @@ scm_chown (path, owner, group)
int val; int val;
SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_chown); SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1, s_chown);
if (SCM_SUBSTRP (path))
path = scm_makfromstr (SCM_ROCHARS (path), SCM_ROLENGTH (path), 0);
SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_chown); SCM_ASSERT (SCM_INUMP (owner), owner, SCM_ARG2, s_chown);
SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_chown); SCM_ASSERT (SCM_INUMP (group), group, SCM_ARG3, s_chown);
SCM_COERCE_SUBSTR (path);
SCM_SYSCALL (val = chown (SCM_ROCHARS (path), SCM_SYSCALL (val = chown (SCM_ROCHARS (path),
SCM_INUM (owner), SCM_INUM (group))); SCM_INUM (owner), SCM_INUM (group)));
if (val != 0) if (val != 0)
@ -161,8 +161,11 @@ scm_chmod (port_or_path, mode)
int rv; int rv;
SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_chmod); SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_chmod);
SCM_ASSERT (SCM_NIMP (port_or_path), port_or_path, SCM_ARG1, s_chmod); SCM_ASSERT (SCM_NIMP (port_or_path), port_or_path, SCM_ARG1, s_chmod);
if (SCM_STRINGP (port_or_path)) if (SCM_ROSTRINGP (port_or_path))
SCM_SYSCALL (rv = chmod (SCM_CHARS (port_or_path), SCM_INUM (mode))); {
SCM_COERCE_SUBSTR (port_or_path);
SCM_SYSCALL (rv = chmod (SCM_ROCHARS (port_or_path), SCM_INUM (mode)));
}
else else
{ {
SCM_ASSERT (SCM_OPFPORTP (port_or_path), port_or_path, SCM_ARG1, s_chmod); SCM_ASSERT (SCM_OPFPORTP (port_or_path), port_or_path, SCM_ARG1, s_chmod);
@ -438,22 +441,26 @@ scm_rename (oldname, newname)
SCM newname; SCM newname;
{ {
int rv; int rv;
SCM_ASSERT (SCM_NIMP (oldname) && SCM_STRINGP (oldname), oldname, SCM_ARG1, s_rename); SCM_ASSERT (SCM_NIMP (oldname) && SCM_ROSTRINGP (oldname), oldname, SCM_ARG1,
SCM_ASSERT (SCM_NIMP (newname) && SCM_STRINGP (newname), newname, SCM_ARG2, s_rename); s_rename);
SCM_ASSERT (SCM_NIMP (newname) && SCM_ROSTRINGP (newname), newname, SCM_ARG2,
s_rename);
SCM_COERCE_SUBSTR (oldname);
SCM_COERCE_SUBSTR (newname);
#ifdef HAVE_RENAME #ifdef HAVE_RENAME
SCM_SYSCALL (rv = rename (SCM_CHARS (oldname), SCM_CHARS (newname))); SCM_SYSCALL (rv = rename (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
if (rv != 0) if (rv != 0)
scm_syserror (s_rename); scm_syserror (s_rename);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#else #else
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_SYSCALL (rv = link (SCM_CHARS (oldname), SCM_CHARS (newname))); SCM_SYSCALL (rv = link (SCM_ROCHARS (oldname), SCM_ROCHARS (newname)));
if (rv == 0) if (rv == 0)
{ {
SCM_SYSCALL (rv = unlink (SCM_CHARS (oldname)));; SCM_SYSCALL (rv = unlink (SCM_ROCHARS (oldname)));;
if (rv != 0) if (rv != 0)
/* unlink failed. remove new name */ /* unlink failed. remove new name */
SCM_SYSCALL (unlink (SCM_CHARS (newname))); SCM_SYSCALL (unlink (SCM_ROCHARS (newname)));
} }
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (rv != 0) if (rv != 0)
@ -470,8 +477,9 @@ scm_delete_file (str)
SCM str; SCM str;
{ {
int ans; int ans;
SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_delete_file); SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_delete_file);
SCM_SYSCALL (ans = unlink (SCM_CHARS (str))); SCM_COERCE_SUBSTR (str);
SCM_SYSCALL (ans = unlink (SCM_ROCHARS (str)));
if (ans != 0) if (ans != 0)
scm_syserror (s_delete_file); scm_syserror (s_delete_file);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -488,17 +496,19 @@ scm_mkdir (path, mode)
#ifdef HAVE_MKDIR #ifdef HAVE_MKDIR
int rv; int rv;
mode_t mask; mode_t mask;
SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_mkdir); SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
s_mkdir);
SCM_COERCE_SUBSTR (path);
if (SCM_UNBNDP (mode)) if (SCM_UNBNDP (mode))
{ {
mask = umask (0); mask = umask (0);
umask (mask); umask (mask);
SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), 0777 ^ mask)); SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), 0777 ^ mask));
} }
else else
{ {
SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_mkdir); SCM_ASSERT (SCM_INUMP (mode), mode, SCM_ARG2, s_mkdir);
SCM_SYSCALL (rv = mkdir (SCM_CHARS (path), SCM_INUM (mode))); SCM_SYSCALL (rv = mkdir (SCM_ROCHARS (path), SCM_INUM (mode)));
} }
if (rv != 0) if (rv != 0)
scm_syserror (s_mkdir); scm_syserror (s_mkdir);
@ -520,8 +530,10 @@ scm_rmdir (path)
#ifdef HAVE_RMDIR #ifdef HAVE_RMDIR
int val; int val;
SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, SCM_ARG1, s_rmdir); SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, SCM_ARG1,
SCM_SYSCALL (val = rmdir (SCM_CHARS (path))); s_rmdir);
SCM_COERCE_SUBSTR (path);
SCM_SYSCALL (val = rmdir (SCM_ROCHARS (path)));
if (val != 0) if (val != 0)
scm_syserror (s_rmdir); scm_syserror (s_rmdir);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -546,10 +558,12 @@ scm_opendir (dirname)
{ {
DIR *ds; DIR *ds;
SCM dir; SCM dir;
SCM_ASSERT (SCM_NIMP (dirname) && SCM_STRINGP (dirname), dirname, SCM_ARG1, s_opendir); SCM_ASSERT (SCM_NIMP (dirname) && SCM_ROSTRINGP (dirname), dirname, SCM_ARG1,
s_opendir);
SCM_COERCE_SUBSTR (dirname);
SCM_NEWCELL (dir); SCM_NEWCELL (dir);
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_SYSCALL (ds = opendir (SCM_CHARS (dirname))); SCM_SYSCALL (ds = opendir (SCM_ROCHARS (dirname)));
if (ds == NULL) if (ds == NULL)
scm_syserror (s_opendir); scm_syserror (s_opendir);
SCM_SETCAR (dir, scm_tc16_dir | SCM_OPN); SCM_SETCAR (dir, scm_tc16_dir | SCM_OPN);
@ -657,8 +671,9 @@ scm_chdir (str)
{ {
int ans; int ans;
SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_chdir); SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_chdir);
SCM_SYSCALL (ans = chdir (SCM_CHARS (str))); SCM_COERCE_SUBSTR (str);
SCM_SYSCALL (ans = chdir (SCM_ROCHARS (str)));
if (ans != 0) if (ans != 0)
scm_syserror (s_chdir); scm_syserror (s_chdir);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -965,9 +980,13 @@ scm_symlink(oldpath, newpath)
#ifdef HAVE_SYMLINK #ifdef HAVE_SYMLINK
int val; int val;
SCM_ASSERT(SCM_NIMP(oldpath) && SCM_STRINGP(oldpath), oldpath, SCM_ARG1, s_symlink); SCM_ASSERT (SCM_NIMP (oldpath) && SCM_ROSTRINGP (oldpath), oldpath, SCM_ARG1,
SCM_ASSERT(SCM_NIMP(newpath) && SCM_STRINGP(newpath), newpath, SCM_ARG2, s_symlink); s_symlink);
SCM_SYSCALL (val = symlink(SCM_CHARS(oldpath), SCM_CHARS(newpath))); SCM_ASSERT (SCM_NIMP (newpath) && SCM_ROSTRINGP (newpath), newpath, SCM_ARG2,
s_symlink);
SCM_COERCE_SUBSTR (oldpath);
SCM_COERCE_SUBSTR (newpath);
SCM_SYSCALL (val = symlink(SCM_ROCHARS(oldpath), SCM_ROCHARS(newpath)));
if (val != 0) if (val != 0)
scm_syserror (s_symlink); scm_syserror (s_symlink);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -990,10 +1009,12 @@ scm_readlink(path)
scm_sizet size = 100; scm_sizet size = 100;
char *buf; char *buf;
SCM result; SCM result;
SCM_ASSERT (SCM_NIMP (path) && SCM_STRINGP (path), path, (char *) SCM_ARG1, s_readlink); SCM_ASSERT (SCM_NIMP (path) && SCM_ROSTRINGP (path), path, (char *) SCM_ARG1,
s_readlink);
SCM_COERCE_SUBSTR (path);
SCM_DEFER_INTS; SCM_DEFER_INTS;
buf = scm_must_malloc (size, s_readlink); buf = scm_must_malloc (size, s_readlink);
while ((rv = readlink (SCM_CHARS (path), buf, (scm_sizet) size)) == size) while ((rv = readlink (SCM_ROCHARS (path), buf, (scm_sizet) size)) == size)
{ {
scm_must_free (buf); scm_must_free (buf);
size *= 2; size *= 2;
@ -1023,8 +1044,10 @@ scm_lstat(str)
int rv; int rv;
struct stat stat_temp; struct stat stat_temp;
SCM_ASSERT(SCM_NIMP(str) && SCM_STRINGP(str), str, (char *)SCM_ARG1, s_lstat); SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, (char *) SCM_ARG1,
SCM_SYSCALL(rv = lstat(SCM_CHARS(str), &stat_temp)); s_lstat);
SCM_COERCE_SUBSTR (str);
SCM_SYSCALL(rv = lstat(SCM_ROCHARS(str), &stat_temp));
if (rv != 0) if (rv != 0)
{ {
int en = errno; int en = errno;

6
libguile/ioext.c
View file

@ -206,6 +206,9 @@ scm_freopen (filename, modes, port)
SCM_ARG1, s_freopen); SCM_ARG1, s_freopen);
SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2,
s_freopen); s_freopen);
SCM_COERCE_SUBSTR (filename);
SCM_COERCE_SUBSTR (modes);
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG3, s_freopen); SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG3, s_freopen);
SCM_SYSCALL (f = freopen (SCM_ROCHARS (filename), SCM_ROCHARS (modes), SCM_SYSCALL (f = freopen (SCM_ROCHARS (filename), SCM_ROCHARS (modes),
@ -247,6 +250,8 @@ scm_duplicate_port (oldpt, modes)
s_duplicate_port); s_duplicate_port);
SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2,
s_duplicate_port); s_duplicate_port);
SCM_COERCE_SUBSTR (modes);
SCM_NEWCELL (newpt); SCM_NEWCELL (newpt);
SCM_DEFER_INTS; SCM_DEFER_INTS;
oldfd = fileno ((FILE *)SCM_STREAM (oldpt)); oldfd = fileno ((FILE *)SCM_STREAM (oldpt));
@ -346,6 +351,7 @@ scm_fdopen (fdes, modes)
SCM_ASSERT (SCM_INUMP (fdes), fdes, SCM_ARG1, s_fdopen); SCM_ASSERT (SCM_INUMP (fdes), fdes, SCM_ARG1, s_fdopen);
SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2,
s_fdopen); s_fdopen);
SCM_COERCE_SUBSTR (modes);
SCM_NEWCELL (port); SCM_NEWCELL (port);
SCM_DEFER_INTS; SCM_DEFER_INTS;
f = fdopen (SCM_INUM (fdes), SCM_ROCHARS (modes)); f = fdopen (SCM_INUM (fdes), SCM_ROCHARS (modes));

5
libguile/net_db.c
View file

@ -174,6 +174,7 @@ scm_gethost (name)
} }
else if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) else if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
{ {
SCM_COERCE_SUBSTR (name);
SCM_DEFER_INTS; SCM_DEFER_INTS;
entry = gethostbyname (SCM_ROCHARS (name)); entry = gethostbyname (SCM_ROCHARS (name));
} }
@ -225,6 +226,7 @@ scm_getnet (name)
} }
else if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) else if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
{ {
SCM_COERCE_SUBSTR (name);
SCM_DEFER_INTS; SCM_DEFER_INTS;
entry = getnetbyname (SCM_ROCHARS (name)); entry = getnetbyname (SCM_ROCHARS (name));
} }
@ -264,6 +266,7 @@ scm_getproto (name)
} }
else if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) else if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
{ {
SCM_COERCE_SUBSTR (name);
SCM_DEFER_INTS; SCM_DEFER_INTS;
entry = getprotobyname (SCM_ROCHARS (name)); entry = getprotobyname (SCM_ROCHARS (name));
} }
@ -321,8 +324,10 @@ scm_getserv (name, proto)
return scm_return_entry (entry); return scm_return_entry (entry);
} }
SCM_ASSERT (SCM_NIMP (proto) && SCM_ROSTRINGP (proto), proto, SCM_ARG2, s_getserv); SCM_ASSERT (SCM_NIMP (proto) && SCM_ROSTRINGP (proto), proto, SCM_ARG2, s_getserv);
SCM_COERCE_SUBSTR (proto);
if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
{ {
SCM_COERCE_SUBSTR (name);
SCM_DEFER_INTS; SCM_DEFER_INTS;
entry = getservbyname (SCM_ROCHARS (name), SCM_ROCHARS (proto)); entry = getservbyname (SCM_ROCHARS (name), SCM_ROCHARS (proto));
} }

3
libguile/ports.c
View file

@ -815,9 +815,10 @@ SCM
scm_sys_make_void_port (mode) scm_sys_make_void_port (mode)
SCM mode; SCM mode;
{ {
SCM_ASSERT (SCM_NIMP (mode) && SCM_STRINGP (mode), mode, SCM_ASSERT (SCM_NIMP (mode) && SCM_ROSTRINGP (mode), mode,
SCM_ARG1, s_sys_make_void_port); SCM_ARG1, s_sys_make_void_port);
SCM_COERCE_SUBSTR (mode);
return scm_void_port (SCM_ROCHARS (mode)); return scm_void_port (SCM_ROCHARS (mode));
} }

17
libguile/posix.c
View file

@ -352,6 +352,7 @@ scm_getgrgid (name)
{ {
SCM_ASSERT (SCM_NIMP (name) && SCM_ROSTRINGP (name), name, SCM_ARG1, SCM_ASSERT (SCM_NIMP (name) && SCM_ROSTRINGP (name), name, SCM_ARG1,
s_getgrgid); s_getgrgid);
SCM_COERCE_SUBSTR (name);
SCM_SYSCALL (entry = getgrnam (SCM_ROCHARS (name))); SCM_SYSCALL (entry = getgrnam (SCM_ROCHARS (name)));
} }
if (!entry) if (!entry)
@ -972,9 +973,10 @@ scm_utime (pathname, actime, modtime)
int rv; int rv;
struct utimbuf utm_tmp; struct utimbuf utm_tmp;
SCM_ASSERT (SCM_NIMP (pathname) && SCM_STRINGP (pathname), pathname, SCM_ASSERT (SCM_NIMP (pathname) && SCM_ROSTRINGP (pathname), pathname,
SCM_ARG1, s_utime); SCM_ARG1, s_utime);
SCM_COERCE_SUBSTR (pathname);
if (SCM_UNBNDP (actime)) if (SCM_UNBNDP (actime))
SCM_SYSCALL (time (&utm_tmp.actime)); SCM_SYSCALL (time (&utm_tmp.actime));
else else
@ -985,7 +987,7 @@ scm_utime (pathname, actime, modtime)
else else
utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_utime); utm_tmp.modtime = scm_num2ulong (modtime, (char *) SCM_ARG3, s_utime);
SCM_SYSCALL (rv = utime (SCM_CHARS (pathname), &utm_tmp)); SCM_SYSCALL (rv = utime (SCM_ROCHARS (pathname), &utm_tmp));
if (rv != 0) if (rv != 0)
scm_syserror (s_utime); scm_syserror (s_utime);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -1026,12 +1028,13 @@ scm_putenv (str)
int rv; int rv;
char *ptr; char *ptr;
SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG1, s_putenv); SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_putenv);
/* must make a new copy to be left in the environment, safe from gc. */ /* must make a new copy to be left in the environment, safe from gc. */
ptr = malloc (SCM_LENGTH (str) + 1); ptr = malloc (SCM_LENGTH (str) + 1);
if (ptr == NULL) if (ptr == NULL)
scm_memory_error (s_putenv); scm_memory_error (s_putenv);
strcpy (ptr, SCM_CHARS (str)); strncpy (ptr, SCM_ROCHARS (str), SCM_LENGTH (str));
ptr[SCM_LENGTH(str)] = 0;
rv = putenv (ptr); rv = putenv (ptr);
if (rv < 0) if (rv < 0)
scm_syserror (s_putenv); scm_syserror (s_putenv);
@ -1056,9 +1059,10 @@ scm_setlocale (category, locale)
} }
else else
{ {
SCM_ASSERT (SCM_NIMP (locale) && SCM_STRINGP (locale), locale, SCM_ASSERT (SCM_NIMP (locale) && SCM_ROSTRINGP (locale), locale,
SCM_ARG2, s_setlocale); SCM_ARG2, s_setlocale);
clocale = SCM_CHARS (locale); SCM_COERCE_SUBSTR (locale);
clocale = SCM_ROCHARS (locale);
} }
rv = setlocale (SCM_INUM (category), clocale); rv = setlocale (SCM_INUM (category), clocale);
@ -1090,6 +1094,7 @@ scm_mknod(path, type, perms, dev)
SCM_ASSERT (SCM_NIMP(type) && SCM_SYMBOLP (type), type, SCM_ARG2, s_mknod); SCM_ASSERT (SCM_NIMP(type) && SCM_SYMBOLP (type), type, SCM_ARG2, s_mknod);
SCM_ASSERT (SCM_INUMP (perms), perms, SCM_ARG3, s_mknod); SCM_ASSERT (SCM_INUMP (perms), perms, SCM_ARG3, s_mknod);
SCM_ASSERT (SCM_INUMP(dev), dev, SCM_ARG4, s_mknod); SCM_ASSERT (SCM_INUMP(dev), dev, SCM_ARG4, s_mknod);
SCM_COERCE_SUBSTR (path);
p = SCM_CHARS (type); p = SCM_CHARS (type);
if (strcmp (p, "regular") == 0) if (strcmp (p, "regular") == 0)

10
libguile/stime.c
View file

@ -245,14 +245,15 @@ setzone (SCM zone, int pos, char *subr)
char *buf; char *buf;
/* if zone was supplied, set the environment variable TZ temporarily. */ /* if zone was supplied, set the environment variable TZ temporarily. */
SCM_ASSERT (SCM_NIMP (zone) && SCM_STRINGP (zone), zone, pos, subr); SCM_ASSERT (SCM_NIMP (zone) && SCM_ROSTRINGP (zone), zone, pos, subr);
SCM_COERCE_SUBSTR (zone);
buf = malloc (SCM_LENGTH (zone) + 4); buf = malloc (SCM_LENGTH (zone) + 4);
if (buf == 0) if (buf == 0)
scm_memory_error (subr); scm_memory_error (subr);
oldtz = getenv ("TZ"); oldtz = getenv ("TZ");
if (oldtz != NULL) if (oldtz != NULL)
oldtz = oldtz - 3; oldtz = oldtz - 3;
sprintf (buf, "TZ=%s", SCM_CHARS (zone)); sprintf (buf, "TZ=%s", SCM_ROCHARS (zone));
if (putenv (buf) < 0) if (putenv (buf) < 0)
scm_syserror (subr); scm_syserror (subr);
tzset(); tzset();
@ -474,10 +475,11 @@ scm_strftime (format, stime)
char *fmt; char *fmt;
int len; int len;
SCM_ASSERT (SCM_NIMP (format) && SCM_STRINGP (format), format, SCM_ARG1, SCM_ASSERT (SCM_NIMP (format) && SCM_ROSTRINGP (format), format, SCM_ARG1,
s_strftime); s_strftime);
bdtime2c (stime, &t, SCM_ARG2, s_strftime); bdtime2c (stime, &t, SCM_ARG2, s_strftime);
SCM_COERCE_SUBSTR (format);
fmt = SCM_ROCHARS (format); fmt = SCM_ROCHARS (format);
len = SCM_ROLENGTH (format); len = SCM_ROLENGTH (format);
@ -507,6 +509,8 @@ scm_strptime (format, string)
SCM_ASSERT (SCM_NIMP (string) && SCM_ROSTRINGP (string), string, SCM_ARG2, SCM_ASSERT (SCM_NIMP (string) && SCM_ROSTRINGP (string), string, SCM_ARG2,
s_strptime); s_strptime);
SCM_COERCE_SUBSTR (format);
SCM_COERCE_SUBSTR (string);
fmt = SCM_ROCHARS (format); fmt = SCM_ROCHARS (format);
str = SCM_ROCHARS (string); str = SCM_ROCHARS (string);

3
libguile/symbols.h
View file

@ -100,6 +100,9 @@ extern int scm_symhash_dim;
#define SCM_SUBSTR_STR(x) (SCM_CDDR (x)) #define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x)) #define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
#define SCM_COERCE_SUBSTR(x) { if (SCM_SUBSTRP (x)) \
x = scm_makfromstr (SCM_ROCHARS (x), \
SCM_ROLENGTH (x), 0); }

5
libguile/vports.c
View file

@ -180,11 +180,12 @@ scm_make_soft_port (pv, modes)
struct scm_port_table * pt; struct scm_port_table * pt;
SCM z; SCM z;
SCM_ASSERT (SCM_NIMP (pv) && SCM_VECTORP (pv) && 5 == SCM_LENGTH (pv), pv, SCM_ARG1, s_make_soft_port); SCM_ASSERT (SCM_NIMP (pv) && SCM_VECTORP (pv) && 5 == SCM_LENGTH (pv), pv, SCM_ARG1, s_make_soft_port);
SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_make_soft_port); SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_make_soft_port);
SCM_COERCE_SUBSTR (modes);
SCM_NEWCELL (z); SCM_NEWCELL (z);
SCM_DEFER_INTS; SCM_DEFER_INTS;
pt = scm_add_to_port_table (z); pt = scm_add_to_port_table (z);
SCM_SETCAR (z, scm_tc16_sfport | scm_mode_bits (SCM_CHARS (modes))); SCM_SETCAR (z, scm_tc16_sfport | scm_mode_bits (SCM_ROCHARS (modes)));
SCM_SETPTAB_ENTRY (z, pt); SCM_SETPTAB_ENTRY (z, pt);
SCM_SETSTREAM (z, pv); SCM_SETSTREAM (z, pv);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;