diff options
author | Nick Ing-Simmons <nik@tiuk.ti.com> | 2001-03-26 17:32:06 +0000 |
---|---|---|
committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 2001-03-26 17:32:06 +0000 |
commit | a9c883f63197ffe78a9fa90fb454b99d9d4027c2 (patch) | |
tree | e981b5bc2bbda851f6a58188b6b22ea388b67c09 | |
parent | 9133bbab1b418762e5735878fdd7f85407fdd45a (diff) | |
download | perl-a9c883f63197ffe78a9fa90fb454b99d9d4027c2.tar.gz |
Implement flush of linebuffered streams on read of a tty.
p4raw-id: //depot/perlio@9361
-rw-r--r-- | perlio.c | 23 | ||||
-rw-r--r-- | perliol.h | 2 |
2 files changed, 24 insertions, 1 deletions
@@ -1140,6 +1140,25 @@ PerlIO_flush(PerlIO *f) } } +void +PerlIOBase_flush_linebuf() +{ + PerlIO **table = &_perlio; + PerlIO *f; + while ((f = *table)) + { + int i; + table = (PerlIO **)(f++); + for (i=1; i < PERLIO_TABLE_SIZE; i++) + { + if (*f && (PerlIOBase(f)->flags & (PERLIO_F_LINEBUF|PERLIO_F_CANWRITE)) + == (PERLIO_F_LINEBUF|PERLIO_F_CANWRITE)) + PerlIO_flush(f); + f++; + } + } +} + #undef PerlIO_fill int PerlIO_fill(PerlIO *f) @@ -2331,7 +2350,7 @@ PerlIOBuf_pushed(PerlIO *f, const char *mode, SV *arg) dTHX; if (fd >= 0 && PerlLIO_isatty(fd)) { - PerlIOBase(f)->flags |= PERLIO_F_LINEBUF; + PerlIOBase(f)->flags |= PERLIO_F_LINEBUF|PERLIO_F_TTY; } posn = PerlIO_tell(PerlIONext(f)); if (posn != (Off_t) -1) @@ -2450,6 +2469,8 @@ PerlIOBuf_fill(PerlIO *f) */ if (PerlIO_flush(f) != 0) return -1; + if (PerlIOBase(f)->flags & PERLIO_F_TTY) + PerlIOBase_flush_linebuf(); if (!b->buf) PerlIO_get_base(f); /* allocate via vtable */ @@ -74,6 +74,7 @@ struct _PerlIO #define PERLIO_F_TEMP 0x00100000 #define PERLIO_F_OPEN 0x00200000 #define PERLIO_F_FASTGETS 0x00400000 +#define PERLIO_F_TTY 0x00800000 #define PerlIOBase(f) (*(f)) #define PerlIOSelf(f,type) ((type *)PerlIOBase(f)) @@ -118,6 +119,7 @@ extern IV PerlIOBase_flush (PerlIO *f); extern IV PerlIOBase_fill (PerlIO *f); extern IV PerlIOBase_close (PerlIO *f); extern void PerlIOBase_setlinebuf(PerlIO *f); +extern void PerlIOBase_flush_linebuf(void); extern IV PerlIOBase_noop_ok (PerlIO *f); extern IV PerlIOBase_noop_fail (PerlIO *f); |