[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: String ports can be truncated
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/02: String ports can be truncated |
Date: |
Wed, 1 Mar 2017 08:26:29 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 1da66a6ab14b6aaedeea2a77dce130c8b397cbf0
Author: Andy Wingo <address@hidden>
Date: Wed Mar 1 14:14:06 2017 +0100
String ports can be truncated
* 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.
---
libguile/strports.c | 13 +++++++++++++
test-suite/tests/ports.test | 39 +++++++++++++++++++++++++++++++++++++++
2 files changed, 52 insertions(+)
diff --git a/libguile/strports.c b/libguile/strports.c
index b12d669..5f78785 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -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;
}
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 86165fd..207c0cf 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -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 ‘ĉ’.