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

1999-07-24 Gary Houston <ghouston@easynet.co.uk>

Browse source 
* gdbint.c (gdb_print, gdb_read): call scm_truncate_file.

	* ports.c (scm_truncate_file): renamed from scm_ftruncate.
	allow the 1st argument to be a fdes or filename as well as a
	port (as in the filesys.c version).

	* filesys.c (scm_truncate_file): removed.
This commit is contained in:
Gary Houston 1999-07-24 19:52:13 +00:00
parent eb9ef08b77
commit 69bc9ff335
7 changed files with 59 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

69
libguile/ports.c
View file

@ -978,40 +978,57 @@ scm_lseek (SCM object, SCM offset, SCM whence)
return scm_long2num (rv);
}
SCM_PROC (s_ftruncate, "ftruncate", 1, 1, 0, scm_ftruncate);
SCM_PROC (s_truncate_file, "truncate-file", 1, 1, 0, scm_truncate_file);
SCM
scm_ftruncate (SCM port, SCM length)
scm_truncate_file (SCM object, SCM length)
{
scm_port *pt;
scm_ptobfuns *ptob;
int rv;
off_t c_length;
/* object can be a port, fdes or filename. */
port = SCM_COERCE_OUTPORT (port);
SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1,
s_ftruncate);
pt = SCM_PTAB_ENTRY (port);
ptob = scm_ptobs + SCM_PTOBNUM (port);
if (!ptob->ftruncate)
scm_misc_error (s_ftruncate, "port is not truncatable",
scm_cons (port, SCM_EOL));
if (SCM_UNBNDP (length))
{
length = scm_lseek (port, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
/* must supply length if object is a filename. */
if (SCM_NIMP (object) && SCM_ROSTRINGP (object))
scm_wrong_num_args (scm_makfrom0str (s_truncate_file));
length = scm_lseek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR));
}
if (pt->rw_active == SCM_PORT_READ)
scm_read_flush (port);
else if (pt->rw_active == SCM_PORT_WRITE)
ptob->fflush (port);
c_length = scm_num2long (length, (char *)SCM_ARG2, s_truncate_file);
if (c_length < 0)
scm_misc_error (s_truncate_file, "negative offset", SCM_EOL);
{
off_t c_length = scm_num2long (length, (char *)SCM_ARG2, s_ftruncate);
if (c_length < 0)
scm_misc_error (s_ftruncate, "negative offset",
scm_cons (length, SCM_EOL));
ptob->ftruncate (port, c_length);
}
object = SCM_COERCE_OUTPORT (object);
if (SCM_INUMP (object))
{
SCM_SYSCALL (rv = ftruncate (SCM_INUM (object), c_length));
}
else if (SCM_NIMP (object) && SCM_OPOUTPORTP (object))
{
scm_port *pt = SCM_PTAB_ENTRY (object);
scm_ptobfuns *ptob = scm_ptobs + SCM_PTOBNUM (object);
if (!ptob->ftruncate)
scm_misc_error (s_truncate_file, "port is not truncatable", SCM_EOL);
if (pt->rw_active == SCM_PORT_READ)
scm_read_flush (object);
else if (pt->rw_active == SCM_PORT_WRITE)
ptob->fflush (object);
ptob->ftruncate (object, c_length);
rv = 0;
}
else
{
SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object),
object, SCM_ARG1, s_truncate_file);
SCM_COERCE_SUBSTR (object);
SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), c_length));
}
if (rv == -1)
scm_syserror (s_truncate_file);
return SCM_UNSPECIFIED;
}