Integrate:

[ 25232]
Subject: [perl #36672] Swapped warnings for -o and -O file tests 
From: "Piotr Fusik" (via RT) <perlbug-followup@perl.org>
Date: Wed, 27 Jul 2005 15:43:17 -0700
Message-ID: <rt-3.0.11-36672-118371.6.12458378853063@perl.org>

(except the redundant test)

[ 25255]
Subject: [patch] blead@25226 on OpenVMS/vms.c - fopen bug.
From: "John E. Malmberg" <wb8tyw@qsl.net>
Date: Fri, 29 Jul 2005 10:24:15 -0400
Message-ID: <42EA3C0F.9040900@qsl.net>

[ 25269]
Subject: [patch]vms.c - buffer highwater overrun in vmsify
From: John E. Malmberg <wb8tyw@qsl.net>
Date: Mon, 01 Aug 2005 19:54:22 -0400
Message-ID: <42EEB62E.3020108@qsl.net>

[ 25335]
Subject: [patch@25334] hv.c vms environment fix.
From: "John E. Malmberg" <wb8tyw@qsl.net>
Date: Sat, 27 Aug 2005 19:20:50 -0400
Message-ID: <4310F552.8050401@qsl.net>

[ 25398]
Subject: [patch@25388] vms/vms.c Perl_cando fix.
From: "John E. Malmberg" <wb8tyw@qsl.net>
Date: Mon, 12 Sep 2005 23:56:36 -0400
Message-ID: <43264DF4.6090403@qsl.net>

[ 25502]
The second argument to Move() is the destination, so cannot possibly
be const. Pesky casting in handy.h. Getting in the way of correctness.

[ 25618]
Subject: [PATCH] Re: [BUG 5.8.7] Another major bug in PerlIO layer
From: Ilya Zakharevich <nospam-abuse@ilyaz.org>
Date: Tue, 27 Sep 2005 02:07:35 -0700
Message-ID: <20050927090734.GB3687@math.berkeley.edu>

[ 25619]
Fix by Rick Delaney for [perl #3269] no warnings "bareword" turns off
too many warnings.

[ 25621]
Subject: AW: [perl #36291] incorrect $! from open ">&nr" with too many open files
From: "Dintelmann, Peter" <Peter.Dintelmann@Dresdner-Bank.com>
Date: Tue, 27 Sep 2005 15:18:00 +0200

[ 25665]
PL_defoutgv could be used after being freed
Was giving "use of freed value" warnings in t/io/through.t
and t/io/crlf_through.t

[ 25677]
If a 'use' or 'require' fails due to too many open files (EMFILE),
give an appropriate error message rather than saying the module
cannot be found in @INC.

[ 25751]
Subject: SvPVutf8_nolen crashes [PATCH]
From: Gisle Aas <gisle@ActiveState.com>
Date: 13 Oct 2005 06:00:49 -0700
Message-ID: <lrslv56072.fsf@caliper.activestate.com>

[ 25753]
If /dev/null is not readable, perl -e fails with
an obscure error message. Make it more understandable.

[ 25759]
Grab enough room from the outset in do_tovmsspec()
p4raw-link: @25759 on //depot/perl: 23e68951924551498fcbd4c960cbe751e5dd9ccf
p4raw-link: @25753 on //depot/perl: b1681ed3d2d7fce28f676043b07816f4fad94f55
p4raw-link: @25751 on //depot/perl: 0be7d46277584d2aedd86c792092a306a69a45b8
p4raw-link: @25677 on //depot/perl: e31de809cfcd2cd474c39462e24b263d3e5fb20d
p4raw-link: @25665 on //depot/perl: a0de6cf512b37d5b6155a1ac4adba112e3a4b766
p4raw-link: @25621 on //depot/perl: b42969c054c571b3b721d68818184e59ca761058
p4raw-link: @25619 on //depot/perl: 013b78e8b7544d87392bc0a7f2840e8f7280e786
p4raw-link: @25618 on //depot/perl: 93c2c2ecd9924225ba4c26762e3e59cf95458982
p4raw-link: @25502 on //depot/perl: 706aa1c9997955fcf6fd0bef3a5f89c64f6802fe
p4raw-link: @25398 on //depot/perl: 7579600832ee021c8e462ff004f49fb7da5fca41
p4raw-link: @25335 on //depot/perl: 03026e68943709ca8a44f2b7298e79491a3245b9
p4raw-link: @25269 on //depot/perl: 755b3d5da747d89ebed76d5b58086a4d05d10ace
p4raw-link: @25255 on //depot/perl: 1c7d9af3bd40a8ae4d0b1feabf16378e4446d90a
p4raw-link: @25232 on //depot/perl: 945fa9b5e7a27e23bc3274ba0b35d4a17fdb9964

p4raw-id: //depot/maint-5.8/perl@26577
p4raw-integrated: from //depot/perl@26575 'copy in' t/io/binmode.t
	(@22423..) 'merge in' t/lib/warnings/2use (@22741..)
p4raw-integrated: from //depot/perl@25753 'edit in' perl.c (@25738..)
p4raw-edited: from //depot/perl@25677 'edit in' pp_ctl.c (@25611..)
p4raw-edited: from //depot/perl@25621 'edit in' doio.c (@25322..)
p4raw-integrated: from //depot/perl@25619 'merge in' mg.c (@25358..)
p4raw-branched: from //depot/perl@25618 'branch in' t/io/crlf_through.t
	t/io/through.t
p4raw-edited: from //depot/perl@25618 'edit in' perlio.c (@25138..)
p4raw-integrated: from //depot/perl@25618 'merge in' MANIFEST
	(@25604..)
p4raw-integrated: from //depot/perl@25502 'edit in' sv.c (@25497..)
p4raw-integrated: from //depot/perl@25398 'edit in' vms/vms.c
	(@25306..)
p4raw-edited: from //depot/perl@25335 'edit in' hv.c (@25156..)
p4raw-edited: from //depot/perl@25232 'edit in' opcode.h (@24445..)
p4raw-integrated: from //depot/perl@25232 'merge in' opcode.pl
	(@24445..)

15 files changed, 265 insertions, 49 deletions

diff --git a/MANIFEST b/MANIFEST
index 8d67eed7d8..dbcdc22d05 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2533,6 +2533,7 @@ thread.h			Threading header
 t/io/argv.t			See if ARGV stuff works
 t/io/binmode.t			See if binmode() works
 t/io/crlf.t			See if :crlf works
+t/io/crlf_through.t		See if pipe passes data intact with :crlf
 t/io/dup.t			See if >& works right
 t/io/fflush.t			See if auto-flush on fork/exec/system/qx works
 t/io/fs.t			See if directory manipulations work
@@ -2546,6 +2547,7 @@ t/io/pipe.t			See if secure pipes work
 t/io/print.t			See if print commands work
 t/io/read.t			See if read works
 t/io/tell.t			See if file seeking works
+t/io/through.t			See if pipe passes data intact
 t/io/utf8.t			See if file seeking works
 t/japh/abigail.t		Obscure tests
 t/lib/1_compile.t		See if the various libraries and extensions compile
diff --git a/doio.c b/doio.c
index 2b57a912db..9c7a2f0bb2 100644
--- a/doio.c
+++ b/doio.c
@@ -1,7 +1,7 @@
 /*    doio.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -407,7 +407,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 			else
 			    was_fdopen = TRUE;
 			if (!(fp = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
-			    if (dodup)
+			    if (dodup && fd >= 0)
 				PerlLIO_close(fd);
 			}
 		    }
diff --git a/hv.c b/hv.c
index d8d49089ef..1519bd96a9 100644
--- a/hv.c
+++ b/hv.c
@@ -1,7 +1,7 @@
 /*    hv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -1752,8 +1752,17 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 	return Null(HE*);
     }
 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
-    if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
+    if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
 	prime_env_iter();
+#ifdef VMS
+	/* The prime_env_iter() on VMS just loaded up new hash values
+	 * so the iteration count needs to be reset back to the beginning
+	 */
+	hv_iterinit(hv);
+	iter = HvAUX(hv);
+	oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
+#endif
+    }
 #endif
 
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
diff --git a/mg.c b/mg.c
index 0227f9419b..d9715cdc33 100644
--- a/mg.c
+++ b/mg.c
@@ -712,11 +712,16 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	if (*(mg->mg_ptr+1) == '\0')
 	    sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE));
 	else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
-	    if (PL_compiling.cop_warnings == pWARN_NONE ||
-	        PL_compiling.cop_warnings == pWARN_STD)
-	    {
+	    if (PL_compiling.cop_warnings == pWARN_NONE) {
 	        sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
-            }
+	    }
+	    else if (PL_compiling.cop_warnings == pWARN_STD) {
+		sv_setpvn(
+		    sv, 
+		    (PL_dowarn & G_WARN_ON) ? WARN_ALLstring : WARN_NONEstring,
+		    WARNsize
+		);
+	    }
             else if (PL_compiling.cop_warnings == pWARN_ALL) {
 		/* Get the bit mask for $warnings::Bits{all}, because
 		 * it could have been extended by warnings::register */
diff --git a/opcode.h b/opcode.h
index 93f8dce61e..b3280e9304 100644
--- a/opcode.h
+++ b/opcode.h
@@ -3,7 +3,7 @@
  *    opcode.h
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -633,8 +633,8 @@ EXT char *PL_op_desc[] = {
 	"-w",
 	"-x",
 	"-e",
-	"-O",
 	"-o",
+	"-O",
 	"-z",
 	"-s",
 	"-M",
diff --git a/opcode.pl b/opcode.pl
index 675516a0b5..cc38f005e2 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -792,8 +792,8 @@ fteread		-r			ck_ftst		isu-	F-
 ftewrite	-w			ck_ftst		isu-	F-
 fteexec		-x			ck_ftst		isu-	F-
 ftis		-e			ck_ftst		isu-	F-
-fteowned	-O			ck_ftst		isu-	F-
-ftrowned	-o			ck_ftst		isu-	F-
+fteowned	-o			ck_ftst		isu-	F-
+ftrowned	-O			ck_ftst		isu-	F-
 ftzero		-z			ck_ftst		isu-	F-
 ftsize		-s			ck_ftst		istu-	F-
 ftmtime		-M			ck_ftst		stu-	F-
diff --git a/perl.c b/perl.c
index cc6617dd41..7415448870 100644
--- a/perl.c
+++ b/perl.c
@@ -843,6 +843,8 @@ perl_destruct(pTHXx)
 	 */
 	sv_clean_objs();
 	PL_sv_objcount = 0;
+	if (PL_defoutgv && !SvREFCNT(PL_defoutgv))
+	    PL_defoutgv = Nullgv; /* may have been freed */
     }
 
     /* unhook hooks which will soon be, or use, destroyed data */
@@ -3696,8 +3698,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 #endif /* IAMSUID */
     if (!PL_rsfp) {
 	/* PSz 16 Sep 03  Keep neat error message */
-	Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
-		CopFILE(PL_curcop), Strerror(errno));
+	if (PL_e_script)
+	    Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno));
+	else
+	    Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
+		    CopFILE(PL_curcop), Strerror(errno));
     }
 }
 
diff --git a/perlio.c b/perlio.c
index 2519eecfad..e07d13ea2f 100644
--- a/perlio.c
+++ b/perlio.c
@@ -1,5 +1,5 @@
 /*
- * perlio.c Copyright (c) 1996-2005, Nick Ing-Simmons You may distribute
+ * perlio.c Copyright (c) 1996-2006, Nick Ing-Simmons You may distribute
  * under the terms of either the GNU General Public License or the
  * Artistic License, as specified in the README file.
  */
@@ -2066,6 +2066,8 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 	    return 0;
 	}
 	while (count > 0) {
+	 get_cnt:
+	  {
 	    SSize_t avail = PerlIO_get_cnt(f);
 	    SSize_t take = 0;
 	    if (avail > 0)
@@ -2076,11 +2078,14 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 		PerlIO_set_ptrcnt(f, ptr + take, (avail -= take));
 		count -= take;
 		buf += take;
+		if (avail == 0)		/* set_ptrcnt could have reset avail */
+		    goto get_cnt;
 	    }
 	    if (count > 0 && avail <= 0) {
 		if (PerlIO_fill(f) != 0)
 		    break;
 	    }
+	  }
 	}
 	return (buf - (STDCHAR *) vbuf);
     }
@@ -3534,7 +3539,11 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 
 /*
  * This "flush" is akin to sfio's sync in that it handles files in either
- * read or write state
+ * read or write state.  For write state, we put the postponed data through
+ * the next layers.  For read state, we seek() the next layers to the
+ * offset given by current position in the buffer, and discard the buffer
+ * state (XXXX supposed to be for seek()able buffers only, but now it is done
+ * in any case?).  Then the pass the stick further in chain.
  */
 IV
 PerlIOBuf_flush(pTHX_ PerlIO *f)
@@ -3593,6 +3602,10 @@ PerlIOBuf_flush(pTHX_ PerlIO *f)
     return code;
 }
 
+/* This discards the content of the buffer after b->ptr, and rereads
+ * the buffer from the position off in the layer downstream; here off
+ * is at offset corresponding to b->ptr - b->buf.
+ */
 IV
 PerlIOBuf_fill(pTHX_ PerlIO *f)
 {
@@ -3603,7 +3616,7 @@ PerlIOBuf_fill(pTHX_ PerlIO *f)
      * Down-stream flush is defined not to loose read data so is harmless.
      * we would not normally be fill'ing if there was data left in anycase.
      */
-    if (PerlIO_flush(f) != 0)
+    if (PerlIO_flush(f) != 0)	/* XXXX Check that its seek() succeeded?! */
 	return -1;
     if (PerlIOBase(f)->flags & PERLIO_F_TTY)
 	PerlIOBase_flush_linebuf(aTHX);
@@ -4079,6 +4092,14 @@ PERLIO_FUNCS_DECL(PerlIO_pending) = {
  * crlf - translation On read translate CR,LF to "\n" we do this by
  * overriding ptr/cnt entries to hand back a line at a time and keeping a
  * record of which nl we "lied" about. On write translate "\n" to CR,LF
+ *
+ * c->nl points on the first byte of CR LF pair when it is temporarily
+ * replaced by LF, or to the last CR of the buffer.  In the former case
+ * the caller thinks that the buffer ends at c->nl + 1, in the latter
+ * that it ends at c->nl; these two cases can be distinguished by
+ * *c->nl.  c->nl is set during _getcnt() call, and unset during
+ * _unread() and _flush() calls.
+ * It only matters for read operations.
  */
 
 typedef struct {
@@ -4123,7 +4144,7 @@ SSize_t
 PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
     PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
-    if (c->nl) {
+    if (c->nl) {	/* XXXX Shouldn't it be done only if b->ptr > c->nl? */
 	*(c->nl) = 0xd;
 	c->nl = NULL;
     }
@@ -4153,8 +4174,10 @@ PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 			count--;
 		    }
 		    else {
-			buf++;
-			break;
+		    /* If b->ptr - 1 == b->buf, we are undoing reading 0xa */
+			*--(b->ptr) = 0xa;	/* Works even if 0xa == '\r' */
+			unread++;
+			count--;
 		    }
 		}
 		else {
@@ -4168,6 +4191,7 @@ PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     }
 }
 
+/* XXXX This code assumes that buffer size >=2, but does not check it... */
 SSize_t
 PerlIOCrlf_get_cnt(pTHX_ PerlIO *f)
 {
diff --git a/pp_ctl.c b/pp_ctl.c
index 6407c5c102..bcaba7c3b0 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,7 +1,7 @@
 /*    pp_ctl.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -3300,25 +3300,32 @@ PP(pp_require)
     if (!tryrsfp) {
 	if (PL_op->op_type == OP_REQUIRE) {
 	    const char *msgstr = name;
-	    if (namesv) {			/* did we lookup @INC? */
+	    if(errno == EMFILE) {
 		SV *msg = sv_2mortal(newSVpv(msgstr,0));
-		SV *dirmsgsv = NEWSV(0, 0);
-		AV *ar = GvAVn(PL_incgv);
-		I32 i;
-		sv_catpvn(msg, " in @INC", 8);
-		if (instr(SvPVX_const(msg), ".h "))
-		    sv_catpv(msg, " (change .h to .ph maybe?)");
-		if (instr(SvPVX_const(msg), ".ph "))
-		    sv_catpv(msg, " (did you run h2ph?)");
-		sv_catpv(msg, " (@INC contains:");
-		for (i = 0; i <= AvFILL(ar); i++) {
-		    const char *dir = SvPVx_nolen_const(*av_fetch(ar, i, TRUE));
-		    Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
-		    sv_catsv(msg, dirmsgsv);
-		}
-		sv_catpvn(msg, ")", 1);
-		SvREFCNT_dec(dirmsgsv);
+		sv_catpv(msg, ":  "); 
+		sv_catpv(msg, Strerror(errno));
 		msgstr = SvPV_nolen_const(msg);
+	    } else {
+	        if (namesv) {			/* did we lookup @INC? */
+		    SV *msg = sv_2mortal(newSVpv(msgstr,0));
+		    SV *dirmsgsv = NEWSV(0, 0);
+		    AV *ar = GvAVn(PL_incgv);
+		    I32 i;
+		    sv_catpvn(msg, " in @INC", 8);
+		    if (instr(SvPVX_const(msg), ".h "))
+		        sv_catpv(msg, " (change .h to .ph maybe?)");
+		    if (instr(SvPVX_const(msg), ".ph "))
+		        sv_catpv(msg, " (did you run h2ph?)");
+		    sv_catpv(msg, " (@INC contains:");
+		    for (i = 0; i <= AvFILL(ar); i++) {
+		        const char *dir = SvPVx_nolen_const(*av_fetch(ar, i, TRUE));
+		        Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
+		        sv_catsv(msg, dirmsgsv);
+		    }
+		    sv_catpvn(msg, ")", 1);
+		    SvREFCNT_dec(dirmsgsv);
+		    msgstr = SvPV_nolen_const(msg);
+		}    
 	    }
 	    DIE(aTHX_ "Can't locate %s", msgstr);
 	}
diff --git a/sv.c b/sv.c
index 3b3eb67b2a..f2ab173adf 100644
--- a/sv.c
+++ b/sv.c
@@ -3390,7 +3390,7 @@ char *
 Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp)
 {
     sv_utf8_upgrade(sv);
-    return SvPV(sv,*lp);
+    return lp ? SvPV(sv,*lp) : SvPV_nolen(sv);
 }
 
 /*
@@ -4316,7 +4316,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags)
 	    SvFAKE_off(sv);
 	    SvREADONLY_off(sv);
 	    SvGROW(sv, len + 1);
-	    Move(pvx,SvPVX_const(sv),len,char);
+	    Move(pvx,SvPVX(sv),len,char);
 	    *SvEND(sv) = '\0';
 	    unsharepvn(pvx, SvUTF8(sv) ? -(I32)len : len, hash);
 	}
@@ -4374,7 +4374,7 @@ Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)
 	    const char *pvx = SvPVX_const(sv);
 	    const STRLEN len = SvCUR(sv);
 	    SvGROW(sv, len + 1);
-	    Move(pvx,SvPVX_const(sv),len,char);
+	    Move(pvx,SvPVX(sv),len,char);
 	    *SvEND(sv) = '\0';
 	}
 	SvIV_set(sv, 0);
@@ -7591,7 +7591,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
 		sv_unref(sv);
 	    (void)SvUPGRADE(sv, SVt_PV);		/* Never FALSE */
 	    SvGROW(sv, len + 1);
-	    Move(s,SvPVX_const(sv),len,char);
+	    Move(s,SvPVX(sv),len,char);
 	    SvCUR_set(sv, len);
 	    *SvEND(sv) = '\0';
 	}
diff --git a/t/io/binmode.t b/t/io/binmode.t
index be198ae645..41eff4a24f 100644
--- a/t/io/binmode.t
+++ b/t/io/binmode.t
@@ -35,7 +35,7 @@ SKIP: {
     skip "minitest", 1 if $ENV{PERL_CORE_MINITEST};
     skip "no EBADF", 1 if (!exists &Errno::EBADF);
 
-    no warnings 'io';
+    no warnings 'io', 'once';
     $! = 0;
     binmode(B);
     ok($! == &Errno::EBADF);
diff --git a/t/io/crlf_through.t b/t/io/crlf_through.t
new file mode 100644
index 0000000000..3a5522a76e
--- /dev/null
+++ b/t/io/crlf_through.t
@@ -0,0 +1,9 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+$main::use_crlf = 1;
+do './io/through.t' or die "no kid script";
diff --git a/t/io/through.t b/t/io/through.t
new file mode 100644
index 0000000000..d664b08a18
--- /dev/null
+++ b/t/io/through.t
@@ -0,0 +1,139 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+require './test.pl';
+
+my $Perl = which_perl();
+
+my $data = <<'EOD';
+x
+ yy
+z
+EOD
+
+(my $data2 = $data) =~ s/\n/\n\n/g;
+
+my $t1 = { data => $data,  write_c => [1,2,length $data],  read_c => [1,2,3,length $data]};
+my $t2 = { data => $data2, write_c => [1,2,length $data2], read_c => [1,2,3,length $data2]};
+
+$_->{write_c} = [1..length($_->{data})],
+  $_->{read_c} = [1..length($_->{data})+1, 0xe000]  # Need <0xffff for REx
+    for (); # $t1, $t2;
+
+my $c;	# len write tests, for each: one _all test, and 3 each len+2
+$c += @{$_->{write_c}} * (1 + 3*@{$_->{read_c}}) for $t1, $t2;
+$c *= 3*2*2;	# $how_w, file/pipe, 2 reports
+
+$c += 6;	# Tests with sleep()...
+
+print "1..$c\n";
+
+my $set_out = '';
+$set_out = "binmode STDOUT, ':crlf'" if $main::use_crlf = 1;
+
+sub testread ($$$$$$$) {
+  my ($fh, $str, $read_c, $how_r, $write_c, $how_w, $why) = @_;
+  my $buf = '';
+  if ($how_r eq 'readline_all') {
+    $buf .= $_ while <$fh>;
+  } elsif ($how_r eq 'readline') {
+    $/ = \$read_c;
+    $buf .= $_ while <$fh>;
+  } elsif ($how_r eq 'read') {
+    my($in, $c);
+    $buf .= $in while $c = read($fh, $in, $read_c);
+  } elsif ($how_r eq 'sysread') {
+    my($in, $c);
+    $buf .= $in while $c = sysread($fh, $in, $read_c);
+  } else {
+    die "Unrecognized read: '$how_r'";
+  }
+  close $fh or die "close: $!";
+  # The only contamination allowed is with sysread/prints
+  $buf =~ s/\r\n/\n/g if $how_r eq 'sysread' and $how_w =~ /print/;
+  is(length $buf, length $str, "length with wrc=$write_c, rdc=$read_c, $how_w, $how_r, $why");
+  is($buf, $str, "content with wrc=$write_c, rdc=$read_c, $how_w, $how_r, $why");
+}
+
+sub testpipe ($$$$$$) {
+  my ($str, $write_c, $read_c, $how_w, $how_r, $why) = @_;
+  (my $quoted = $str) =~ s/\n/\\n/g;;
+  my $fh;
+  if ($how_w eq 'print') {	# AUTOFLUSH???
+    # Should be shell-neutral:
+    open $fh, '-|', qq[$Perl -we "$set_out;print for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+  } elsif ($how_w eq 'print/flush') {
+    # shell-neutral and miniperl-enabled autoflush? qq(\x24\x7c) eq '$|'
+    open $fh, '-|', qq[$Perl -we "$set_out;eval qq(\\x24\\x7c = 1) or die;print for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+  } elsif ($how_w eq 'syswrite') {
+    ### How to protect \$_
+    open $fh, '-|', qq[$Perl -we "$set_out;eval qq(sub w {syswrite STDOUT, \\x24_} 1) or die; w() for grep length, split /(.{1,$write_c})/s, qq($quoted)"] or die "open: $!";
+  } else {
+    die "Unrecognized write: '$how_w'";
+  }
+  binmode $fh, ':crlf' if $main::use_crlf = 1;
+  testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "pipe$why");
+}
+
+sub testfile ($$$$$$) {
+  my ($str, $write_c, $read_c, $how_w, $how_r, $why) = @_;
+  my @data = grep length, split /(.{1,$write_c})/s, $str;
+
+  open my $fh, '>', 'io_io.tmp' or die;
+  select $fh;
+  binmode $fh, ':crlf' if $main::use_crlf = 1;
+  if ($how_w eq 'print') {	# AUTOFLUSH???
+    $| = 0;
+    print $fh $_ for @data;
+  } elsif ($how_w eq 'print/flush') {
+    $| = 1;
+    print $fh $_ for @data;
+  } elsif ($how_w eq 'syswrite') {
+    syswrite $fh, $_ for @data;
+  } else {
+    die "Unrecognized write: '$how_w'";
+  }
+  close $fh or die "close: $!";
+  open $fh, '<', 'io_io.tmp' or die;
+  binmode $fh, ':crlf' if $main::use_crlf = 1;
+  testread($fh, $str, $read_c, $how_r, $write_c, $how_w, "file$why");
+}
+
+# shell-neutral and miniperl-enabled autoflush? qq(\x24\x7c) eq '$|'
+open my $fh, '-|', qq[$Perl -we "eval qq(\\x24\\x7c = 1) or die; binmode STDOUT; sleep 1, print for split //, qq(a\nb\n\nc\n\n\n)"] or die "open: $!";
+ok(1, 'open pipe');
+binmode $fh, q(:crlf);
+ok(1, 'binmode');
+my (@c, $c);
+push @c, ord $c while $c = getc $fh;
+ok(1, 'got chars');
+is(scalar @c, 9, 'got 9 chars');
+is("@c", '97 10 98 10 10 99 10 10 10', 'got expected chars');
+ok(close($fh), 'close');
+
+for my $s (1..2) {
+  my $t = ($t1, $t2)[$s-1];
+  my $str = $t->{data};
+  my $r = $t->{read_c};
+  my $w = $t->{write_c};
+  for my $read_c (@$r) {
+    for my $write_c (@$w) {
+      for my $how_r (qw(readline_all readline read sysread)) {
+	next if $how_r eq 'readline_all' and $read_c != 1;
+        for my $how_w (qw(print print/flush syswrite)) {
+	  testfile($str, $write_c, $read_c, $how_w, $how_r, $s);
+	  testpipe($str, $write_c, $read_c, $how_w, $how_r, $s);
+        }
+      }
+    }
+  }
+}
+
+unlink 'io_io.tmp';
+
+1;
diff --git a/t/lib/warnings/2use b/t/lib/warnings/2use
index b700ef70dc..d8ef72f4d9 100644
--- a/t/lib/warnings/2use
+++ b/t/lib/warnings/2use
@@ -72,6 +72,12 @@ my $a =+ 1 ;
 EXPECT
 Reversed += operator at - line 3.
 ########
+-w
+no warnings 'reserved' ;
+foo.bar;
+EXPECT
+Useless use of concatenation (.) or string in void context at - line 3.
+########
 
 --FILE-- abc
 my $a =+ 1 ;
diff --git a/vms/vms.c b/vms/vms.c
index d0233c8cd3..12821de0eb 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -3816,7 +3816,7 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
 
   if (path == NULL) return NULL;
   if (buf) rslt = buf;
-  else if (ts) Newx(rslt,strlen(path)+9,char);
+  else if (ts) Newx(rslt,NAM$C_MAXRSS+1,char);
   else rslt = __tovmsspec_retbuf;
   if (strpbrk(path,"]:>") ||
       (dirend = strrchr(path,'/')) == NULL) {
@@ -3842,7 +3842,6 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
 
     while (*(cp2+1) == '/') cp2++;  /* Skip multiple /s */
     if (!*(cp2+1)) {
-      if (!buf & ts) Renew(rslt,18,char);
       strcpy(rslt,"sys$disk:[000000]");
       return rslt;
     }
@@ -3865,8 +3864,10 @@ static char *mp_do_tovmsspec(pTHX_ char *path, char *buf, int ts) {
         if (!buf && ts) Renew(rslt,strlen(path)-strlen(rslt)+trnend+4,char);
         strcpy(rslt,trndev);
         cp1 = rslt + trnend;
-        *(cp1++) = '.';
-        cp2++;
+	if (*cp2 != 0) {
+          *(cp1++) = '.';
+          cp2++;
+        }
       }
       else {
         *(cp1++) = ':';
@@ -5323,7 +5324,7 @@ setup_cmddsc(pTHX_ char *cmd, int check_img, int *suggest_quote,
       *s = '\0';
 
       /* check that it's really not DCL with no file extension */
-      fp = fopen(resspec,"r","ctx=bin,shr=get");
+      fp = fopen(resspec,"r","ctx=bin","shr=get");
       if (fp) {
         char b[4] = {0,0,0,0};
         read(fileno(fp),b,4);
@@ -6906,7 +6907,16 @@ int
 Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
 {
   if (!fstat(fd,(stat_t *) statbufp)) {
-    if (statbufp == (Stat_t *) &PL_statcache) *namecache == '\0';
+    if (statbufp == (Stat_t *) &PL_statcache) {
+    char *cptr;
+
+	/* Save name for cando by name in VMS format */
+	cptr = getname(fd, namecache, 1);
+
+	/* This should not happen, but just in case */
+	if (cptr == NULL)
+	   namecache[0] = '\0';
+    }
     statbufp->st_dev = encode_dev(aTHX_ statbufp->st_devnam);
 #   ifdef RTL_USES_UTC
 #   ifdef VMSISH_TIME