diff options
author | Mark H Weaver <mhw@netris.org> | 2013-03-31 19:06:51 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2013-04-04 17:48:37 -0400 |
commit | 45c0878b8665182f06a917e391169031c1dc7db6 (patch) | |
tree | 8c7dfcacacdc33272d7e5e7c30625397fd607669 | |
parent | 0426b3f8f8036364aca13c24ef769283937faa3d (diff) | |
download | guile-45c0878b8665182f06a917e391169031c1dc7db6.tar.gz |
Peeks do not consume EOFs.
Fixes <http://bugs.gnu.org/12216>.
* libguile/ports-internal.h (struct scm_port_internal): Add
'pending_eof' flag.
* libguile/ports.c (scm_i_set_pending_eof, scm_i_clear_pending_eof): New
static functions.
(scm_new_port_table_entry): Initialize 'pending_eof'.
(scm_i_fill_input): Check for 'pending_eof'.
(scm_i_peek_byte_or_eof): Set 'pending_eof' flag before returning EOF.
(scm_end_input, scm_unget_byte, scm_seek, scm_truncate): Clear
'pending_eof'.
(scm_peek_char): Set 'pending_eof' flag before returning EOF.
* test-suite/tests/ports.test ("pending EOF behavior"): Add tests.
-rw-r--r-- | libguile/ports-internal.h | 1 | ||||
-rw-r--r-- | libguile/ports.c | 50 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 84 |
3 files changed, 128 insertions, 7 deletions
diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h index 73a788f39..333d4fbc8 100644 --- a/libguile/ports-internal.h +++ b/libguile/ports-internal.h @@ -48,6 +48,7 @@ struct scm_port_internal { scm_t_port_encoding_mode encoding_mode; scm_t_iconv_descriptors *iconv_descriptors; + int pending_eof; SCM alist; }; diff --git a/libguile/ports.c b/libguile/ports.c index eaa204788..f210cdabd 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -241,6 +241,18 @@ scm_set_port_input_waiting (scm_t_bits tc, int (*input_waiting) (SCM)) scm_ptobs[SCM_TC2PTOBNUM (tc)].input_waiting = input_waiting; } +static void +scm_i_set_pending_eof (SCM port) +{ + SCM_PORT_GET_INTERNAL (port)->pending_eof = 1; +} + +static void +scm_i_clear_pending_eof (SCM port) +{ + SCM_PORT_GET_INTERNAL (port)->pending_eof = 0; +} + SCM scm_i_port_alist (SCM port) { @@ -645,6 +657,7 @@ scm_new_port_table_entry (scm_t_bits tag) entry->input_cd = pti; /* XXX pointer to the internal port structure */ entry->output_cd = NULL; /* XXX unused */ + pti->pending_eof = 0; pti->alist = SCM_EOL; SCM_SET_CELL_TYPE (z, tag); @@ -1326,8 +1339,11 @@ get_iconv_codepoint (SCM port, scm_t_wchar *codepoint, return 0; } else - /* EOF found in the middle of a multibyte character. */ - return EILSEQ; + { + /* EOF found in the middle of a multibyte character. */ + scm_i_set_pending_eof (port); + return EILSEQ; + } } buf[input_size++] = byte_read; @@ -1431,9 +1447,16 @@ static int scm_i_fill_input (SCM port) { scm_t_port *pt = SCM_PTAB_ENTRY (port); + scm_t_port_internal *pti = SCM_PORT_GET_INTERNAL (port); assert (pt->read_pos == pt->read_end); + if (pti->pending_eof) + { + pti->pending_eof = 0; + return EOF; + } + if (pt->read_buf == pt->putback_buf) { /* finished reading put-back chars. */ @@ -1489,7 +1512,10 @@ scm_slow_peek_byte_or_eof (SCM port) if (pt->read_pos >= pt->read_end) { if (SCM_UNLIKELY (scm_i_fill_input (port) == EOF)) - return EOF; + { + scm_i_set_pending_eof (port); + return EOF; + } } return *pt->read_pos; @@ -1721,6 +1747,7 @@ scm_end_input (SCM port) long offset; scm_t_port *pt = SCM_PTAB_ENTRY (port); + scm_i_clear_pending_eof (port); if (pt->read_buf == pt->putback_buf) { offset = pt->read_end - pt->read_pos; @@ -1744,6 +1771,7 @@ scm_unget_byte (int c, SCM port) { scm_t_port *pt = SCM_PTAB_ENTRY (port); + scm_i_clear_pending_eof (port); if (pt->read_buf == pt->putback_buf) /* already using the put-back buffer. */ { @@ -1915,7 +1943,10 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0, result = SCM_BOOL_F; } else if (c == EOF) - result = SCM_EOF_VAL; + { + scm_i_set_pending_eof (port); + result = SCM_EOF_VAL; + } else result = SCM_MAKE_CHAR (c); @@ -2014,7 +2045,10 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0, SCM_MISC_ERROR ("port is not seekable", scm_cons (fd_port, SCM_EOL)); else - rv = ptob->seek (fd_port, off, how); + { + scm_i_clear_pending_eof (fd_port); + rv = ptob->seek (fd_port, off, how); + } return scm_from_off_t_or_off64_t (rv); } else /* file descriptor?. */ @@ -2103,14 +2137,16 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0, off_t_or_off64_t c_length = scm_to_off_t_or_off64_t (length); scm_t_port *pt = SCM_PTAB_ENTRY (object); scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (object); - + if (!ptob->truncate) SCM_MISC_ERROR ("port is not truncatable", SCM_EOL); + + scm_i_clear_pending_eof (object); if (pt->rw_active == SCM_PORT_READ) scm_end_input (object); else if (pt->rw_active == SCM_PORT_WRITE) ptob->flush (object); - + ptob->truncate (object, c_length); rv = 0; } diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 886ab2418..7b6ee22a8 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -1110,6 +1110,90 @@ (char-ready?)))))) +;;;; pending-eof behavior + +(with-test-prefix "pending EOF behavior" + ;; Make a test port that will produce the given sequence. Each + ;; element of 'lst' may be either a character or #f (which means EOF). + (define (test-soft-port . lst) + (make-soft-port + (vector (lambda (c) #f) ; write char + (lambda (s) #f) ; write string + (lambda () #f) ; flush + (lambda () ; read char + (let ((c (car lst))) + (set! lst (cdr lst)) + c)) + (lambda () #f)) ; close + "rw")) + + (define (call-with-port p proc) + (dynamic-wind + (lambda () #f) + (lambda () (proc p)) + (lambda () (close-port p)))) + + (define (call-with-test-file str proc) + (let ((filename (test-file))) + (dynamic-wind + (lambda () (call-with-output-file filename + (lambda (p) (display str p)))) + (lambda () (call-with-input-file filename proc)) + (lambda () (delete-file (test-file)))))) + + (pass-if "peek-char does not swallow EOF (soft port)" + (call-with-port (test-soft-port #\a #f #\b) + (lambda (p) + (and (char=? #\a (peek-char p)) + (char=? #\a (read-char p)) + (eof-object? (peek-char p)) + (eof-object? (read-char p)) + (char=? #\b (peek-char p)) + (char=? #\b (read-char p)))))) + + (pass-if "unread clears pending EOF (soft port)" + (call-with-port (test-soft-port #\a #f #\b) + (lambda (p) + (and (char=? #\a (read-char p)) + (eof-object? (peek-char p)) + (begin (unread-char #\u p) + (char=? #\u (read-char p))))))) + + (pass-if "unread clears pending EOF (string port)" + (call-with-input-string "a" + (lambda (p) + (and (char=? #\a (read-char p)) + (eof-object? (peek-char p)) + (begin (unread-char #\u p) + (char=? #\u (read-char p))))))) + + (pass-if "unread clears pending EOF (file port)" + (call-with-test-file + "a" + (lambda (p) + (and (char=? #\a (read-char p)) + (eof-object? (peek-char p)) + (begin (unread-char #\u p) + (char=? #\u (read-char p))))))) + + (pass-if "seek clears pending EOF (string port)" + (call-with-input-string "a" + (lambda (p) + (and (char=? #\a (read-char p)) + (eof-object? (peek-char p)) + (begin (seek p 0 SEEK_SET) + (char=? #\a (read-char p))))))) + + (pass-if "seek clears pending EOF (file port)" + (call-with-test-file + "a" + (lambda (p) + (and (char=? #\a (read-char p)) + (eof-object? (peek-char p)) + (begin (seek p 0 SEEK_SET) + (char=? #\a (read-char p)))))))) + + ;;;; Close current-input-port, and make sure everyone can handle it. (with-test-prefix "closing current-input-port" |