Integrate:

[ 28629]
Subject: [PATCH] z/OS: an easy test nit
From: Jarkko Hietaniemi <jhi@cc.hut.fi>
Date: Thu, 27 Jul 2006 20:00:02 +0300 (EEST)
Message-Id: <200607271700.k6RH02V1355005@kosh.hut.fi>

[ 28766]
Fix PerlIO::scalar fileno() documentation as suggested in:
Subject: [perl #40245] POD error for PerlIO::scalar in 5.8.8 
From: "Shawn Boyette" (via RT) <perlbug-followup@perl.org>
Date: Mon, 28 Aug 2006 00:21:25 -0700
Message-ID: <rt-3.5.HEAD-31263-1156749685-634.40245-75-0@perl.org>

[ 28798]
Fix for [perl #40267] PerlIO::scalar doesn't respect readonly-ness

[ 28799]
Bump version of PerlIO::scalar

[ 28903]
Subject: [PATCH] PerlIO::scalar (aka open(my $fh, >\$foo)): zero-filling seekand don't talk to negative strangers
From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Fri, 29 Sep 2006 17:41:28 +0300
Message-ID: <451D3098.1000305@iki.fi>

[ 29173]
Doc clarification for PerlIO::encoding
(thanks to Steve Hay)

[ 29702]
Bump version of PerlIO::via after last change

[ 29751]
Fix bug #40407: after a seek on a PerlIO::scalar filehandle,
ensure there's a string buffer in the scalar

[ 30213]
Subject: Re: [perl #41442] segfault (dead loop) with Encoding, use open :locale, print STDERR
From: Slaven Rezic <slaven@rezic.de>
Date: 05 Feb 2007 23:04:07 +0100
Message-ID: <87veiggt2g.fsf@biokovo.herceg.de>

[ 30214]
Explicitly load PerlIO::encoding when testing it.
(so we know what we're testing)

[ 30233]
Skip this test if "use open" fails due to an unknown encoding
p4raw-link: @30233 on //depot/perl: 771ed9f
p4raw-link: @30214 on //depot/perl: af65d5c
p4raw-link: @30213 on //depot/perl: 74f6c1c
p4raw-link: @29751 on //depot/perl: 8b8eea9
p4raw-link: @29702 on //depot/perl: c02d432
p4raw-link: @29173 on //depot/perl: 51dfe3f
p4raw-link: @28903 on //depot/perl: 42bc49d
p4raw-link: @28799 on //depot/perl: ad95c6e
p4raw-link: @28798 on //depot/perl: b35bc0c
p4raw-link: @28766 on //depot/perl: 846c5ed
p4raw-link: @28629 on //depot/perl: 501f55b

p4raw-id: //depot/maint-5.8/perl@30340
p4raw-branched: from //depot/perl@30339 'branch in'
	ext/PerlIO/encoding/t/nolooping.t (@30214..)
p4raw-integrated: from //depot/perl@30339 'copy in'
	ext/PerlIO/t/encoding.t (@23631..)
	ext/PerlIO/encoding/encoding.xs (@26175..)
	ext/PerlIO/via/via.pm (@26817..) ext/PerlIO/t/scalar.t
	(@28798..) ext/PerlIO/encoding/encoding.pm (@29173..)
p4raw-integrated: from //depot/perl@30213 'merge in' MANIFEST
	(@30211..)
p4raw-integrated: from //depot/perl@28903 'merge in' pod/perldiag.pod
	(@28868..)
p4raw-integrated: from //depot/perl@28766 'ignore'
	ext/PerlIO/scalar/scalar.pm (@24543..)
p4raw-integrated: from //depot/perl@24271 'ignore'
	ext/PerlIO/scalar/scalar.xs (@24248..) 'merge in'
	ext/PerlIO/via/via.xs (@20614..)

MANIFEST

@@ -759,6 +759,7 @@ ext/PerlIO/encoding/encoding.pm	PerlIO::encoding
 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

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";
 
@@ -25,6 +25,8 @@ PerlIO::encoding - encoding layer
 
 =head1 SYNOPSIS
 
+  use PerlIO::encoding;
+
   open($f, "<:encoding(foo)", "infoo");
   open($f, ">:encoding(bar)", "outbar");
 
@@ -33,16 +35,16 @@ PerlIO::encoding - encoding layer
 
 =head1 DESCRIPTION
 
-Open a filehandle with a transparent encoding filter.
+This PerlIO layer opens a filehandle with a transparent encoding filter.
 
-On input, convert the bytes expected to be in the specified
+On input, it converts the bytes expected to be in the specified
 character set and encoding to Perl string data (Unicode and
-Perl's internal Unicode encoding, UTF-8).  On output, convert
+Perl's internal Unicode encoding, UTF-8).  On output, it converts
 Perl string data into the specified character set and encoding.
 
-When the layer is pushed the current value of C<$PerlIO::encoding::fallback>
-is saved and used as the CHECK argument when calling the Encode methods encode()
-and decode().
+When the layer is pushed, the current value of C<$PerlIO::encoding::fallback>
+is saved and used as the CHECK argument when calling the Encode methods
+encode() and decode().
 
 =head1 SEE ALSO
 

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;

ext/PerlIO/encoding/t/nolooping.t

@@ -0,0 +1,16 @@
+#!perl -w
+
+use Test::More tests => 1;
+
+BEGIN {
+    $SIG{__WARN__} = sub { $warn .= $_[0] };
+}
+
+# bug #41442
+use PerlIO::encoding;
+use open ':locale';
+if ($warn !~ /Cannot find encoding/) {
+    if (-e '/dev/null') { open STDERR, '>', '/dev/null' }
+    warn "# \x{201e}\n"; # „
+}
+ok(1); # we got that far

ext/PerlIO/scalar/scalar.pm

@@ -1,5 +1,5 @@
 package PerlIO::scalar;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
 use XSLoader ();
 XSLoader::load 'PerlIO::scalar';
 1;
@@ -30,7 +30,7 @@ or
 A filehandle is opened but the file operations are performed "in-memory"
 on a scalar variable.  All the normal file operations can be performed
 on the handle. The scalar is considered a stream of bytes.  Currently
-fileno($fh) returns C<undef>.
+fileno($fh) returns -1.
 
 =head1 IMPLEMENTATION NOTE
 

ext/PerlIO/scalar/scalar.xs

@@ -24,6 +24,12 @@ PerlIOScalar_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg,
      */
     if (arg) {
 	if (SvROK(arg)) {
+	    if (SvREADONLY(SvRV(arg)) && mode && *mode != 'r') {
+		if (ckWARN(WARN_LAYER))
+		    Perl_warner(aTHX_ packWARN(WARN_LAYER), PL_no_modify);
+		SETERRNO(EINVAL, SS_IVCHAN);
+		return -1;
+	    }
 	    s->var = SvREFCNT_inc(SvRV(arg));
 	    if (!SvPOK(s->var) && SvTYPE(SvRV(arg)) > SVt_NULL)
 		(void)SvPV_nolen(s->var);
@@ -77,20 +83,36 @@ IV
 PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
 {
     PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
+    STRLEN oldcur = SvCUR(s->var);
+    STRLEN newlen;
     switch (whence) {
-    case 0:
+    case SEEK_SET:
 	s->posn = offset;
 	break;
-    case 1:
+    case SEEK_CUR:
 	s->posn = offset + s->posn;
 	break;
-    case 2:
+    case SEEK_END:
 	s->posn = offset + SvCUR(s->var);
 	break;
     }
-    if ((STRLEN) s->posn > SvCUR(s->var)) {
-	(void) SvGROW(s->var, (STRLEN) s->posn);
+    if (s->posn < 0) {
+        if (ckWARN(WARN_LAYER))
+	    Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string");
+	SETERRNO(EINVAL, SS_IVCHAN);
+	return -1;
     }
+    newlen = (STRLEN) s->posn;
+    if (newlen > oldcur) {
+	(void) SvGROW(s->var, newlen);
+	Zero(SvPVX(s->var) + oldcur, newlen - oldcur, char);
+	/* No SvCUR_set(), though.  This is just a seek, not a write. */
+    }
+    else if (!SvPVX(s->var)) {
+	/* ensure there's always a character buffer */
+	(void)SvGROW(s->var,1);
+    }
+    SvPOK_on(s->var);
     return 0;
 }
 
@@ -253,7 +275,7 @@ PerlIOScalar_dup(pTHX_ PerlIO * f, PerlIO * o, CLONE_PARAMS * param,
     return f;
 }
 
-PerlIO_funcs PerlIO_scalar = {
+PERLIO_FUNCS_DECL(PerlIO_scalar) = {
     sizeof(PerlIO_funcs),
     "scalar",
     sizeof(PerlIOScalar),
@@ -294,7 +316,7 @@ PROTOTYPES: ENABLE
 BOOT:
 {
 #ifdef PERLIO_LAYERS
- PerlIO_define_layer(aTHX_ &PerlIO_scalar);
+ PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_scalar));
 #endif
 }
 

ext/PerlIO/t/encoding.t

@@ -152,13 +152,21 @@ print "ok 14\n";
 
 # Try decoding some bad stuff
 open(F,'>:raw',$threebyte) || die "Cannot open $threebyte:$!";
-print F "foo\xF0\x80\x80\x80bar\n\x80foo\n";
+if (ord('A') == 193) { # EBCDIC
+    print F "foo\x8c\x80\x80\x80bar\n\x80foo\n";
+} else {
+    print F "foo\xF0\x80\x80\x80bar\n\x80foo\n";
+}
 close(F);
 
 open(F,'<:encoding(utf-8)',$threebyte) || die "Cannot open $threebyte:$!";
 $dstr = join(":", <F>);
 close(F);
-print "not " unless $dstr eq "foo\\xF0\\x80\\x80\\x80bar\n:\\x80foo\n";
+if (ord('A') == 193) { # EBCDIC
+    print "not " unless $dstr eq "foo\\x8C\\x80\\x80\\x80bar\n:\\x80foo\n";
+} else {
+    print "not " unless $dstr eq "foo\\xF0\\x80\\x80\\x80bar\n:\\x80foo\n";
+}
 print "ok 15\n";
 
 END {