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

String ports can be truncated

Browse source 
* libguile/strports.c (string_port_truncate):
  (scm_make_string_port_type): Support truncate-file on string ports.
* test-suite/tests/ports.test ("string ports"): Add tests.
This commit is contained in:
Andy Wingo 2017-03-01 14:14:06 +01:00
parent fcebf93ecb
commit 1da66a6ab1
2 changed files with 52 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/strports.c
View file

@ -134,6 +134,18 @@ string_port_seek (SCM port, scm_t_off offset, int whence)
}
#undef FUNC_NAME
static void
string_port_truncate (SCM port, scm_t_off length)
#define FUNC_NAME "string_port_truncate"
{
struct string_port *stream = (void *) SCM_STREAM (port);
if (0 <= length && stream->pos <= length && length <= stream->len)
stream->len = length;
else
scm_out_of_range (FUNC_NAME, scm_from_off_t_or_off64_t (length));
}
#undef FUNC_NAME
/* The initial size in bytes of a string port's buffer. */
@ -372,6 +384,7 @@ scm_make_string_port_type ()
string_port_read,
string_port_write);
scm_set_port_seek (ptob, string_port_seek);
scm_set_port_truncate (ptob, string_port_truncate);
return ptob;
}

39
test-suite/tests/ports.test
View file

@ -735,6 +735,45 @@
(pass-if "output check"
(string=? text result)))
(pass-if-exception "truncating input string fails"
exception:wrong-type-arg
(call-with-input-string "hej"
(lambda (p)
(truncate-file p 0))))
(pass-if-equal "truncating output string" "hej"
(call-with-output-string
(lambda (p)
(truncate-file p 0)
(display "hej" p))))
(pass-if-exception "truncating output string before position"
exception:out-of-range
(call-with-output-string
(lambda (p)
(display "hej" p)
(truncate-file p 0))))
(pass-if-equal "truncating output string at position" "hej"
(call-with-output-string
(lambda (p)
(display "hej" p)
(truncate-file p 3))))
(pass-if-equal "truncating output string after seek" ""
(call-with-output-string
(lambda (p)
(display "hej" p)
(seek p 0 SEEK_SET)
(truncate-file p 0))))
(pass-if-equal "truncating output string after seek to end" "hej"
(call-with-output-string
(lambda (p)
(display "hej" p)
(seek p 0 SEEK_SET)
(truncate-file p 3))))
(pass-if "%default-port-encoding is ignored"
(let ((str "ĉu bone?"))
;; Latin-1 cannot represent ‘ĉ’.