Fix the crlf.t buffer leak

 - actually a generic PerlIOBuf_xxx derived leak-on-pop, but :crlf
   flagged it because it is more often popped without stream
   being closed.
 - Define non-noop PerlIOBuf_popped(), use it and export it.

p4raw-id: //depot/perlio@16657

diff --git a/makedef.pl b/makedef.pl
index 1d35103..0a1e7ed 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -738,6 +738,7 @@ my @layer_syms = qw(
                         PerlIOBase_error
                         PerlIOBase_fileno
                         PerlIOBase_pushed
+                        PerlIOBase_popped
                         PerlIOBase_read
                         PerlIOBase_setlinebuf
                         PerlIOBase_unread
@@ -749,6 +750,7 @@ my @layer_syms = qw(
                         PerlIOBuf_get_ptr
                         PerlIOBuf_open
                         PerlIOBuf_pushed
+                        PerlIOBuf_popped
                         PerlIOBuf_read
                         PerlIOBuf_seek
                         PerlIOBuf_set_ptrcnt
@@ -1348,7 +1350,7 @@ perl_destruct
 perl_free
 perl_parse
 perl_run
-# Oddities from PerlIO 
+# Oddities from PerlIO
 PerlIO_binmode
 PerlIO_getpos
 PerlIO_init

diff --git a/perlio.c b/perlio.c
index 3ece5e0..f5d528e 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -2359,7 +2359,7 @@ PerlIO_funcs PerlIO_unix = {
     sizeof(PerlIOUnix),
     PERLIO_K_RAW,
     PerlIOUnix_pushed,
-    PerlIOBase_noop_ok,
+    PerlIOBase_popped,
     PerlIOUnix_open,
     NULL,
     PerlIOUnix_fileno,
@@ -2814,7 +2814,7 @@ PerlIO_funcs PerlIO_stdio = {
     sizeof(PerlIOStdio),
     PERLIO_K_BUFFERED,
     PerlIOBase_pushed,
-    PerlIOBase_noop_ok,
+    PerlIOBase_popped,
     PerlIOStdio_open,
     NULL,
     PerlIOStdio_fileno,
@@ -3243,6 +3243,20 @@ PerlIOBuf_tell(pTHX_ PerlIO *f)
 }
 
 IV
+PerlIOBuf_popped(pTHX_ PerlIO *f)
+{
+    IV code = PerlIOBase_popped(aTHX_ f);
+    PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
+    if (b->buf && b->buf != (STDCHAR *) & b->oneword) {
+       Safefree(b->buf);
+    }
+    b->buf = NULL;
+    b->ptr = b->end = b->buf;
+    PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
+    return code;
+}
+
+IV
 PerlIOBuf_close(pTHX_ PerlIO *f)
 {
     IV code = PerlIOBase_close(aTHX_ f);
@@ -3331,7 +3345,7 @@ PerlIO_funcs PerlIO_perlio = {
     sizeof(PerlIOBuf),
     PERLIO_K_BUFFERED,
     PerlIOBuf_pushed,
-    PerlIOBase_noop_ok,
+    PerlIOBuf_popped,
     PerlIOBuf_open,
     NULL,
     PerlIOBase_fileno,
@@ -3452,7 +3466,7 @@ PerlIO_funcs PerlIO_pending = {
     sizeof(PerlIOBuf),
     PERLIO_K_BUFFERED,
     PerlIOPending_pushed,
-    PerlIOBase_noop_ok,
+    PerlIOBuf_popped,
     NULL,
     NULL,
     PerlIOBase_fileno,
@@ -3745,7 +3759,7 @@ PerlIO_funcs PerlIO_crlf = {
     sizeof(PerlIOCrlf),
     PERLIO_K_BUFFERED | PERLIO_K_CANCRLF,
     PerlIOCrlf_pushed,
-    PerlIOBase_noop_ok,         /* popped */
+    PerlIOBuf_popped,         /* popped */
     PerlIOBuf_open,
     NULL,
     PerlIOBase_fileno,
@@ -4060,7 +4074,7 @@ PerlIO_funcs PerlIO_mmap = {
     sizeof(PerlIOMmap),
     PERLIO_K_BUFFERED,
     PerlIOBuf_pushed,
-    PerlIOBase_noop_ok,
+    PerlIOBuf_popped,
     PerlIOBuf_open,
     NULL,
     PerlIOBase_fileno,

diff --git a/perliol.h b/perliol.h
index f7bd359..8595c2e 100644 (file)
--- a/perliol.h
+++ b/perliol.h
@@ -167,6 +167,7 @@ extern PerlIO *PerlIOBuf_open(pTHX_ PerlIO_funcs *self,
                              const char *mode, int fd, int imode,
                              int perm, PerlIO *old, int narg, SV **args);
 extern IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg);
+extern IV PerlIOBuf_popped(pTHX_ PerlIO *f);
 extern PerlIO *PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
 extern SSize_t PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
 extern SSize_t PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count);