diff options
| author | Slaven Rezic <slaven@rezic.de> | 2007-02-06 00:04:07 +0100 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2007-02-11 17:13:44 +0000 |
| commit | 74f6c1ca58b1c40741f55591ab97a77b6751f510 (patch) | |
| tree | 6aa424ea5f03dcf40c2616c2261323c6292e5a51 /ext/PerlIO | |
| parent | 66b941864ac8a8f2fe5cb4315b4e9fcb08835dd8 (diff) | |
| download | perl-74f6c1ca58b1c40741f55591ab97a77b6751f510.tar.gz | |
Re: [perl #41442] segfault (dead loop) with Encoding, use open :locale, print STDERR
Message-ID: <87veiggt2g.fsf@biokovo.herceg.de>
p4raw-id: //depot/perl@30213
Diffstat (limited to 'ext/PerlIO')
| -rw-r--r-- | ext/PerlIO/encoding/encoding.pm | 2 | ||||
| -rw-r--r-- | ext/PerlIO/encoding/encoding.xs | 12 | ||||
| -rw-r--r-- | ext/PerlIO/encoding/t/nolooping.t | 9 |
3 files changed, 21 insertions, 2 deletions
diff --git a/ext/PerlIO/encoding/encoding.pm b/ext/PerlIO/encoding/encoding.pm index c99e70b5a6..dcc65f91e8 100644 --- a/ext/PerlIO/encoding/encoding.pm +++ b/ext/PerlIO/encoding/encoding.pm @@ -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"; diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs index 362d66cd84..617842f617 100644 --- a/ext/PerlIO/encoding/encoding.xs +++ b/ext/PerlIO/encoding/encoding.xs @@ -48,6 +48,7 @@ typedef struct { 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 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs * } e->chk = newSVsv(get_sv("PerlIO::encoding::fallback", 0)); + e->inEncodeCall = 0; FREETMPS; LEAVE; @@ -404,6 +406,7 @@ PerlIOEncode_flush(pTHX_ PerlIO * f) 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 @@ PerlIOEncode_flush(pTHX_ PerlIO * f) 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 @@ PerlIOEncode_flush(pTHX_ PerlIO * f) } /* 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 @@ PerlIOEncode_flush(pTHX_ PerlIO * f) 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; diff --git a/ext/PerlIO/encoding/t/nolooping.t b/ext/PerlIO/encoding/t/nolooping.t new file mode 100644 index 0000000000..9ed1e445de --- /dev/null +++ b/ext/PerlIO/encoding/t/nolooping.t @@ -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"; # „ +ok(1); # we got that far |