Change 30213: Re: [perl #41442] segfault (dead loop) with Encoding, use open :locale, print STDERR

[Rafael Garcia-Suarez]

Change 30213 by [EMAIL PROTECTED] on 2007/02/11 17:13:44

        Subject: Re: [perl #41442] segfault (dead loop) with Encoding, use open 
:locale, print STDERR
        From: Slaven Rezic <[EMAIL PROTECTED]>
        Date: 05 Feb 2007 23:04:07 +0100
        Message-ID: <[EMAIL PROTECTED]>

Affected files ...

... //depot/perl/MANIFEST#1520 edit
... //depot/perl/ext/PerlIO/encoding/encoding.pm#16 edit
... //depot/perl/ext/PerlIO/encoding/encoding.xs#26 edit
... //depot/perl/ext/PerlIO/encoding/t/nolooping.t#1 add

Differences ...

==== //depot/perl/MANIFEST#1520 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1519~30211~   2007-02-11 08:20:15.000000000 -0800
+++ perl/MANIFEST       2007-02-11 09:13:44.000000000 -0800
@@ -933,6 +933,7 @@
 ext/PerlIO/encoding/encoding.xs        PerlIO::encoding
 ext/PerlIO/encoding/Makefile.PL        PerlIO::encoding makefile writer
 ext/PerlIO/encoding/MANIFEST   PerlIO::encoding list of files
+ext/PerlIO/encoding/t/nolooping.t      Tests for PerlIO::encoding
 ext/PerlIO/scalar/Makefile.PL  PerlIO layer for scalars
 ext/PerlIO/scalar/scalar.pm    PerlIO layer for scalars
 ext/PerlIO/scalar/scalar.xs    PerlIO layer for scalars

==== //depot/perl/ext/PerlIO/encoding/encoding.pm#16 (text) ====
Index: perl/ext/PerlIO/encoding/encoding.pm
--- perl/ext/PerlIO/encoding/encoding.pm#15~29173~      2006-10-31 
06:29:07.000000000 -0800
+++ perl/ext/PerlIO/encoding/encoding.pm        2007-02-11 09:13:44.000000000 
-0800
@@ -1,7 +1,7 @@
 package PerlIO::encoding;
 
 use strict;
-our $VERSION = '0.09';
+our $VERSION = '0.10';
 our $DEBUG = 0;
 $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n";
 

==== //depot/perl/ext/PerlIO/encoding/encoding.xs#26 (text) ====
Index: perl/ext/PerlIO/encoding/encoding.xs
--- perl/ext/PerlIO/encoding/encoding.xs#25~26175~      2005-11-19 
10:06:14.000000000 -0800
+++ perl/ext/PerlIO/encoding/encoding.xs        2007-02-11 09:13:44.000000000 
-0800
@@ -48,6 +48,7 @@
     SV *enc;                   /* the encoding object */
     SV *chk;                    /* CHECK in Encode methods */
     int flags;                 /* Flags currently just needs lines */
+    int inEncodeCall;          /* trap recursive encode calls */
 } PerlIOEncode;
 
 #define NEEDS_LINES    1
@@ -147,6 +148,7 @@
     }
 
     e->chk = newSVsv(get_sv("PerlIO::encoding::fallback", 0));
+    e->inEncodeCall = 0;
 
     FREETMPS;
     LEAVE;
@@ -404,6 +406,7 @@
        STRLEN len;
        SSize_t count = 0;
        if ((PerlIOBase(f)->flags & PERLIO_F_WRBUF) && (e->base.ptr > 
e->base.buf)) {
+           if (e->inEncodeCall) return 0;
            /* Write case - encode the buffer and write() to layer below */
            PUSHSTACKi(PERLSI_MAGIC);
            SPAGAIN;
@@ -416,9 +419,12 @@
            XPUSHs(e->bufsv);
            XPUSHs(e->chk);
            PUTBACK;
+           e->inEncodeCall = 1;
            if (call_method("encode", G_SCALAR) != 1) {
+               e->inEncodeCall = 0;
                Perl_die(aTHX_ "panic: encode did not return a value");
            }
+           e->inEncodeCall = 0;
            SPAGAIN;
            str = POPs;
            PUTBACK;
@@ -453,6 +459,7 @@
            }
            /* See if there is anything left in the buffer */
            if (e->base.ptr < e->base.end) {
+               if (e->inEncodeCall) return 0;
                /* Bother - have unread data.
                   re-encode and unread() to layer below
                 */
@@ -472,9 +479,12 @@
                XPUSHs(str);
                XPUSHs(e->chk);
                PUTBACK;
+               e->inEncodeCall = 1;
                if (call_method("encode", G_SCALAR) != 1) {
-                    Perl_die(aTHX_ "panic: encode did not return a value");
+                   e->inEncodeCall = 0;
+                   Perl_die(aTHX_ "panic: encode did not return a value");
                }
+               e->inEncodeCall = 0;
                SPAGAIN;
                str = POPs;
                PUTBACK;

==== //depot/perl/ext/PerlIO/encoding/t/nolooping.t#1 (text) ====
Index: perl/ext/PerlIO/encoding/t/nolooping.t
--- /dev/null   2007-01-16 11:55:45.526841103 -0800
+++ perl/ext/PerlIO/encoding/t/nolooping.t      2007-02-11 09:13:44.000000000 
-0800
@@ -0,0 +1,9 @@
+#!perl -w
+
+use Test::More tests => 1;
+
+# bug #41442
+use open ':locale';
+if (-e '/dev/null') { open STDERR, '>', '/dev/null' }
+warn "# \x{201e}\n"; # &bdquo;
+ok(1); # we got that far
End of Patch.