X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/684bef36d5078e84d816e42ce6a73ae4452da2d7..5e66d4f1f8d408decca63565193d2b1424d52c7c:/pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index aae168f..3f85116 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,6 +1,6 @@
 /*    pp_hot.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -22,13 +22,6 @@
 #ifdef I_UNISTD
 #include <unistd.h>
 #endif
-#ifdef I_FCNTL
-#include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#include <sys/file.h>
-#endif
-
 
 /* Hot code. */
 
@@ -87,6 +80,8 @@ PP(pp_stringify)
     char *s;
     s = SvPV(TOPs,len);
     sv_setpvn(TARG,s,len);
+    if (SvUTF8(TOPs) && !IN_BYTE)
+	SvUTF8_on(TARG);
     SETTARG;
     RETURN;
 }
@@ -112,7 +107,6 @@ PP(pp_and)
 PP(pp_sassign)
 {
     djSP; dPOPTOPssrl;
-    MAGIC *mg;
 
     if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
 	SV *temp;
@@ -151,35 +145,102 @@ PP(pp_concat)
   {
     dPOPTOPssrl;
     STRLEN len;
-    char *s;
+    U8 *s;
+    bool left_utf;
+    bool right_utf;
+
+    if (TARG == right && SvGMAGICAL(right))
+        mg_get(right);
+    if (SvGMAGICAL(left))
+        mg_get(left);
+
+    left_utf  = DO_UTF8(left);
+    right_utf = DO_UTF8(right);
+ 
+    if (left_utf != right_utf) {
+        if (TARG == right && !right_utf) {
+            sv_utf8_upgrade(TARG); /* Now straight binary copy */
+            SvUTF8_on(TARG);
+        }
+        else {
+            /* Set TARG to PV(left), then add right */
+            U8 *l, *c, *olds = NULL;
+            STRLEN targlen;
+	    s = (U8*)SvPV(right,len);
+	    right_utf |= DO_UTF8(right);
+            if (TARG == right) {
+		/* Take a copy since we're about to overwrite TARG */
+		olds = s = (U8*)savepvn((char*)s, len);
+	    }
+	    if (!SvOK(left) && SvTYPE(left) <= SVt_PVMG) {
+	        if (SvREADONLY(left))
+		    left = sv_2mortal(newSVsv(left));
+		else
+		    sv_setpv(left, "");	/* Suppress warning. */
+	    }
+            l = (U8*)SvPV(left, targlen);
+	    left_utf |= DO_UTF8(left);
+            if (TARG != left)
+                sv_setpvn(TARG, (char*)l, targlen);
+            if (!left_utf)
+                sv_utf8_upgrade(TARG);
+            /* Extend TARG to length of right (s) */
+            targlen = SvCUR(TARG) + len;
+            if (!right_utf) {
+                /* plus one for each hi-byte char if we have to upgrade */
+                for (c = s; c < s + len; c++)  {
+                    if (*c & 0x80)
+                        targlen++;
+                }
+            }
+            SvGROW(TARG, targlen+1);
+            /* And now copy, maybe upgrading right to UTF8 on the fly */
+            for (c = (U8*)SvEND(TARG); len--; s++) {
+                 if (*s & 0x80 && !right_utf)
+                     c = uv_to_utf8(c, *s);
+                 else
+                     *c++ = *s;
+            }
+            SvCUR_set(TARG, targlen);
+            *SvEND(TARG) = '\0';
+            SvUTF8_on(TARG);
+            SETs(TARG);
+	    Safefree(olds);
+            RETURN;
+        }
+    }
+
     if (TARG != left) {
-	s = SvPV(left,len);
-	sv_setpvn(TARG,s,len);
+	s = (U8*)SvPV(left,len);
+	if (TARG == right) {
+	    sv_insert(TARG, 0, 0, (char*)s, len);
+	    SETs(TARG);
+	    RETURN;
+	}
+	sv_setpvn(TARG, (char *)s, len);
     }
-    else if (SvGMAGICAL(TARG))
-	mg_get(TARG);
-    else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) {
+    else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG)
 	sv_setpv(TARG, "");	/* Suppress warning. */
-	s = SvPV_force(TARG, len);
-    }
-    s = SvPV(right,len);
+    s = (U8*)SvPV(right,len);
     if (SvOK(TARG)) {
 #if defined(PERL_Y2KWARN)
-	if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_MISC)) {
+	if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) {
 	    STRLEN n;
 	    char *s = SvPV(TARG,n);
 	    if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
 		&& (n == 2 || !isDIGIT(s[n-3])))
 	    {
-		Perl_warner(aTHX_ WARN_MISC, "Possible Y2K bug: %s",
+		Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s",
 			    "about to append an integer to '19'");
 	    }
 	}
 #endif
-	sv_catpvn(TARG,s,len);
+	sv_catpvn(TARG, (char *)s, len);
     }
     else
-	sv_setpvn(TARG,s,len);	/* suppress warning */
+	sv_setpvn(TARG, (char *)s, len);	/* suppress warning */
+    if (left_utf)
+	SvUTF8_on(TARG);
     SETTARG;
     RETURN;
   }
@@ -206,7 +267,7 @@ PP(pp_readline)
     tryAMAGICunTARGET(iter, 0);
     PL_last_in_gv = (GV*)(*PL_stack_sp--);
     if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
-	if (SvROK(PL_last_in_gv) && SvTYPE(SvRV(PL_last_in_gv)) == SVt_PVGV) 
+	if (SvROK(PL_last_in_gv) && SvTYPE(SvRV(PL_last_in_gv)) == SVt_PVGV)
 	    PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
 	else {
 	    dSP;
@@ -221,7 +282,7 @@ PP(pp_readline)
 
 PP(pp_eq)
 {
-    djSP; tryAMAGICbinSET(eq,0); 
+    djSP; tryAMAGICbinSET(eq,0);
     {
       dPOPnv;
       SETs(boolSV(TOPn == value));
@@ -259,7 +320,7 @@ PP(pp_or)
 
 PP(pp_add)
 {
-    djSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
+    djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
     {
       dPOPTOPnnrl_ul;
       SETn( left + right );
@@ -325,9 +386,10 @@ PP(pp_print)
 	gv = (GV*)*++MARK;
     else
 	gv = PL_defoutgv;
-    if (mg = SvTIED_mg((SV*)gv, 'q')) {
+    if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
+      had_magic:
 	if (MARK == ORIGMARK) {
-	    /* If using default handle then we need to make space to 
+	    /* If using default handle then we need to make space to
 	     * pass object as 1st arg, so move other args up ...
 	     */
 	    MEXTEND(SP, 1);
@@ -348,26 +410,33 @@ PP(pp_print)
 	RETURN;
     }
     if (!(io = GvIO(gv))) {
-	if (ckWARN(WARN_UNOPENED)) {
-	    SV* sv = sv_newmortal();
-	    gv_efullname3(sv, gv, Nullch);
-            Perl_warner(aTHX_ WARN_UNOPENED, "Filehandle %s never opened",
-			SvPV(sv,n_a));
-        }
+        dTHR;
+        if ((GvEGV(gv)) && (mg = SvTIED_mg((SV*)GvEGV(gv),'q')))
+            goto had_magic;
+	if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+	    report_evil_fh(gv, io, PL_op->op_type);
 	SETERRNO(EBADF,RMS$_IFI);
 	goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
 	if (ckWARN2(WARN_CLOSED, WARN_IO))  {
-	    SV* sv = sv_newmortal();
-	    gv_efullname3(sv, gv, Nullch);
-	    if (IoIFP(io))
-		Perl_warner(aTHX_ WARN_IO,
-			    "Filehandle %s opened only for input",
-			    SvPV(sv,n_a));
-	    else if (ckWARN(WARN_CLOSED))
-		Perl_warner(aTHX_ WARN_CLOSED,
-			    "print() on closed filehandle %s", SvPV(sv,n_a));
+	    if (IoIFP(io)) {
+		/* integrate with report_evil_fh()? */
+	        char *name = NULL;
+		if (isGV(gv)) {
+		    SV* sv = sv_newmortal();
+		    gv_efullname4(sv, gv, Nullch, FALSE);
+		    name = SvPV_nolen(sv);
+		}
+		if (name && *name)
+		  Perl_warner(aTHX_ WARN_IO,
+			      "Filehandle %s opened only for input", name);
+		else
+		    Perl_warner(aTHX_ WARN_IO,
+				"Filehandle opened only for input");
+	    }
+	    else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+		report_evil_fh(gv, io, PL_op->op_type);
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
@@ -443,10 +512,10 @@ PP(pp_rv2av)
 	}
 	else {
 	    GV *gv;
-	    
+	
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
-		STRLEN n_a;
+		STRLEN len;
 
 		if (SvGMAGICAL(sv)) {
 		    mg_get(sv);
@@ -465,13 +534,17 @@ PP(pp_rv2av)
 		    }
 		    RETSETUNDEF;
 		}
-		sym = SvPV(sv,n_a);
+		sym = SvPV(sv,len);
 		if ((PL_op->op_flags & OPf_SPECIAL) &&
 		    !(PL_op->op_flags & OPf_MOD))
 		{
 		    gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV);
-		    if (!gv)
+		    if (!gv
+			&& (!is_gv_magical(sym,len,0)
+			    || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV))))
+		    {
 			RETSETUNDEF;
+		    }
 		}
 		else {
 		    if (PL_op->op_private & HINT_STRICT_REFS)
@@ -495,14 +568,14 @@ PP(pp_rv2av)
     if (GIMME == G_ARRAY) {
 	I32 maxarg = AvFILL(av) + 1;
 	(void)POPs;			/* XXXX May be optimized away? */
-	EXTEND(SP, maxarg);          
+	EXTEND(SP, maxarg);
 	if (SvRMAGICAL(av)) {
-	    U32 i; 
+	    U32 i;
 	    for (i=0; i < maxarg; i++) {
 		SV **svp = av_fetch(av, i, FALSE);
 		SP[i+1] = (svp) ? *svp : &PL_sv_undef;
 	    }
-	} 
+	}
 	else {
 	    Copy(AvARRAY(av), SP+1, maxarg, SV*);
 	}
@@ -543,10 +616,10 @@ PP(pp_rv2hv)
 	}
 	else {
 	    GV *gv;
-	    
+	
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
-		STRLEN n_a;
+		STRLEN len;
 
 		if (SvGMAGICAL(sv)) {
 		    mg_get(sv);
@@ -565,13 +638,17 @@ PP(pp_rv2hv)
 		    }
 		    RETSETUNDEF;
 		}
-		sym = SvPV(sv,n_a);
+		sym = SvPV(sv,len);
 		if ((PL_op->op_flags & OPf_SPECIAL) &&
 		    !(PL_op->op_flags & OPf_MOD))
 		{
 		    gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV);
-		    if (!gv)
+		    if (!gv
+			&& (!is_gv_magical(sym,len,0)
+			    || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV))))
+		    {
 			RETSETUNDEF;
+		    }
 		}
 		else {
 		    if (PL_op->op_private & HINT_STRICT_REFS)
@@ -611,6 +688,92 @@ PP(pp_rv2hv)
     }
 }
 
+STATIC int
+S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem,
+		 SV **lastrelem)
+{
+    OP *leftop;
+    I32 i;
+
+    leftop = ((BINOP*)PL_op)->op_last;
+    assert(leftop);
+    assert(leftop->op_type == OP_NULL && leftop->op_targ == OP_LIST);
+    leftop = ((LISTOP*)leftop)->op_first;
+    assert(leftop);
+    /* Skip PUSHMARK and each element already assigned to. */
+    for (i = lelem - firstlelem; i > 0; i--) {
+	leftop = leftop->op_sibling;
+	assert(leftop);
+    }
+    if (leftop->op_type != OP_RV2HV)
+	return 0;
+
+    /* pseudohash */
+    if (av_len(ary) > 0)
+	av_fill(ary, 0);		/* clear all but the fields hash */
+    if (lastrelem >= relem) {
+	while (relem < lastrelem) {	/* gobble up all the rest */
+	    SV *tmpstr;
+	    assert(relem[0]);
+	    assert(relem[1]);
+	    /* Avoid a memory leak when avhv_store_ent dies. */
+	    tmpstr = sv_newmortal();
+	    sv_setsv(tmpstr,relem[1]);	/* value */
+	    relem[1] = tmpstr;
+	    if (avhv_store_ent(ary,relem[0],tmpstr,0))
+		(void)SvREFCNT_inc(tmpstr);
+	    if (SvMAGICAL(ary) != 0 && SvSMAGICAL(tmpstr))
+		mg_set(tmpstr);
+	    relem += 2;
+	    TAINT_NOT;
+	}
+    }
+    if (relem == lastrelem)
+	return 1;
+    return 2;
+}
+
+STATIC void
+S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
+{
+    if (*relem) {
+	SV *tmpstr;
+	if (ckWARN(WARN_MISC)) {
+	    if (relem == firstrelem &&
+		SvROK(*relem) &&
+		(SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+		 SvTYPE(SvRV(*relem)) == SVt_PVHV))
+	    {
+		Perl_warner(aTHX_ WARN_MISC,
+			    "Reference found where even-sized list expected");
+	    }
+	    else
+		Perl_warner(aTHX_ WARN_MISC,
+			    "Odd number of elements in hash assignment");
+	}
+	if (SvTYPE(hash) == SVt_PVAV) {
+	    /* pseudohash */
+	    tmpstr = sv_newmortal();
+	    if (avhv_store_ent((AV*)hash,*relem,tmpstr,0))
+		(void)SvREFCNT_inc(tmpstr);
+	    if (SvMAGICAL(hash) && SvSMAGICAL(tmpstr))
+		mg_set(tmpstr);
+	}
+	else {
+	    HE *didstore;
+	    tmpstr = NEWSV(29,0);
+	    didstore = hv_store_ent(hash,*relem,tmpstr,0);
+	    if (SvMAGICAL(hash)) {
+		if (SvSMAGICAL(tmpstr))
+		    mg_set(tmpstr);
+		if (!didstore)
+		    sv_2mortal(tmpstr);
+	    }
+	}
+	TAINT_NOT;
+    }
+}
+
 PP(pp_aassign)
 {
     djSP;
@@ -636,21 +799,22 @@ PP(pp_aassign)
      * special care that assigning the identifier on the left doesn't
      * clobber a value on the right that's used later in the list.
      */
-    if (PL_op->op_private & OPpASSIGN_COMMON) {
+    if (PL_op->op_private & (OPpASSIGN_COMMON)) {
 	EXTEND_MORTAL(lastrelem - firstrelem + 1);
-        for (relem = firstrelem; relem <= lastrelem; relem++) {
-            /*SUPPRESS 560*/
-            if (sv = *relem) {
+	for (relem = firstrelem; relem <= lastrelem; relem++) {
+	    /*SUPPRESS 560*/
+	    if ((sv = *relem)) {
 		TAINT_NOT;	/* Each item is independent */
-                *relem = sv_mortalcopy(sv);
+		*relem = sv_mortalcopy(sv);
 	    }
-        }
+	}
     }
 
     relem = firstrelem;
     lelem = firstlelem;
     ary = Null(AV*);
     hash = Null(HV*);
+
     while (lelem <= lastlelem) {
 	TAINT_NOT;		/* Each item stands on its own, taintwise. */
 	sv = *lelem++;
@@ -658,7 +822,19 @@ PP(pp_aassign)
 	case SVt_PVAV:
 	    ary = (AV*)sv;
 	    magic = SvMAGICAL(ary) != 0;
-	    
+	    if (PL_op->op_private & OPpASSIGN_HASH) {
+		switch (do_maybe_phash(ary, lelem, firstlelem, relem,
+				       lastrelem))
+		{
+		case 0:
+		    goto normal_array;
+		case 1:
+		    do_oddball((HV*)ary, relem, firstrelem);
+		}
+		relem = lastrelem + 1;
+		break;
+	    }
+	normal_array:
 	    av_clear(ary);
 	    av_extend(ary, lastrelem - relem);
 	    i = 0;
@@ -678,7 +854,7 @@ PP(pp_aassign)
 		TAINT_NOT;
 	    }
 	    break;
-	case SVt_PVHV: {
+	case SVt_PVHV: {				/* normal hash */
 		SV *tmpstr;
 
 		hash = (HV*)sv;
@@ -705,27 +881,7 @@ PP(pp_aassign)
 		    TAINT_NOT;
 		}
 		if (relem == lastrelem) {
-		    if (*relem) {
-			HE *didstore;
-			if (ckWARN(WARN_UNSAFE)) {
-			    if (relem == firstrelem &&
-				SvROK(*relem) &&
-				( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
-				  SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
-				Perl_warner(aTHX_ WARN_UNSAFE, "Reference found where even-sized list expected");
-			    else
-				Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
-			}
-			tmpstr = NEWSV(29,0);
-			didstore = hv_store_ent(hash,*relem,tmpstr,0);
-			if (magic) {
-			    if (SvSMAGICAL(tmpstr))
-				mg_set(tmpstr);
-			    if (!didstore)
-				sv_2mortal(tmpstr);
-			}
-			TAINT_NOT;
-		    }
+		    do_oddball(hash, relem, firstrelem);
 		    relem++;
 		}
 	    }
@@ -889,16 +1045,16 @@ PP(pp_match)
     truebase = t = s;
 
     /* XXXX What part of this is needed with true \G-support? */
-    if (global = pm->op_pmflags & PMf_GLOBAL) {
+    if ((global = pm->op_pmflags & PMf_GLOBAL)) {
 	rx->startp[0] = -1;
 	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 	    MAGIC* mg = mg_find(TARG, 'g');
 	    if (mg && mg->mg_len >= 0) {
 		if (!(rx->reganch & ROPT_GPOS_SEEN))
-		    rx->endp[0] = rx->startp[0] = mg->mg_len; 
+		    rx->endp[0] = rx->startp[0] = mg->mg_len;
 		else if (rx->reganch & ROPT_ANCH_GPOS) {
 		    r_flags |= REXEC_IGNOREPOS;
-		    rx->endp[0] = rx->startp[0] = mg->mg_len; 
+		    rx->endp[0] = rx->startp[0] = mg->mg_len;
 		}
 		minmatch = (mg->mg_flags & MGf_MINMATCH);
 		update_minmatch = 0;
@@ -908,7 +1064,7 @@ PP(pp_match)
     if ((gimme != G_ARRAY && !global && rx->nparens)
 	    || SvTEMP(TARG) || PL_sawampersand)
 	r_flags |= REXEC_COPY_STR;
-    if (SvSCREAM(TARG)) 
+    if (SvSCREAM(TARG))
 	r_flags |= REXEC_SCREAM;
 
     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
@@ -930,10 +1086,11 @@ play_it_again:
 	if (!s)
 	    goto nope;
 	if ( (rx->reganch & ROPT_CHECK_ALL)
-	     && !PL_sawampersand 
+	     && !PL_sawampersand
 	     && ((rx->reganch & ROPT_NOSCAN)
 		 || !((rx->reganch & RE_INTUIT_TAIL)
-		      && (r_flags & REXEC_SCREAM))))
+		      && (r_flags & REXEC_SCREAM)))
+	     && !SvROK(TARG))	/* Cannot trust since INTUIT cannot guess ^ */
 	    goto yup;
     }
     if (CALLREGEXEC(aTHX_ rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
@@ -969,6 +1126,10 @@ play_it_again:
 		len = rx->endp[i] - rx->startp[i];
 		s = rx->startp[i] + truebase;
 		sv_setpvn(*SP, s, len);
+		if ((pm->op_pmdynflags & PMdf_UTF8) && !IN_BYTE) {
+		    SvUTF8_on(*SP);
+		    sv_utf8_downgrade(*SP, TRUE);
+		}
 	    }
 	}
 	if (global) {
@@ -1021,7 +1182,7 @@ yup:					/* Confirmed by INTUIT */
 	rx->endp[0] = s - truebase + rx->minlen;
 	rx->sublen = strend - truebase;
 	goto gotcha;
-    } 
+    }
     if (PL_sawampersand) {
 	I32 off;
 
@@ -1035,6 +1196,7 @@ yup:					/* Confirmed by INTUIT */
 	rx->startp[0] = s - truebase;
 	rx->endp[0] = s - truebase + rx->minlen;
     }
+    rx->nparens = rx->lastparen = 0;	/* used by @- and @+ */
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
@@ -1066,7 +1228,7 @@ Perl_do_readline(pTHX)
     I32 gimme = GIMME_V;
     MAGIC *mg;
 
-    if (mg = SvTIED_mg((SV*)PL_last_in_gv, 'q')) {
+    if ((mg = SvTIED_mg((SV*)PL_last_in_gv, 'q'))) {
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
 	PUTBACK;
@@ -1181,7 +1343,7 @@ Perl_do_readline(pTHX)
 		        }
 		        else {
 		           PerlIO_rewind(tmpfp);
-		           IoTYPE(io) = '<';
+		           IoTYPE(io) = IoTYPE_RDONLY;
 		           IoIFP(io) = fp = tmpfp;
 		           IoFLAGS(io) &= ~IOf_UNTAINT;  /* maybe redundant */
 		        }
@@ -1235,28 +1397,33 @@ Perl_do_readline(pTHX)
 	else if (type == OP_GLOB)
 	    SP--;
 	else if (ckWARN(WARN_IO)	/* stdout/stderr or other write fh */
-		 && (IoTYPE(io) == '>' || fp == PerlIO_stdout()
+		 && (IoTYPE(io) == IoTYPE_WRONLY || fp == PerlIO_stdout()
 		     || fp == PerlIO_stderr()))
 	{
-	    SV* sv = sv_newmortal();
-	    gv_efullname3(sv, PL_last_in_gv, Nullch);
-	    Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
-			SvPV_nolen(sv));
+	    /* integrate with report_evil_fh()? */
+	    char *name = NULL;
+	    if (isGV(PL_last_in_gv)) { /* can this ever fail? */
+		SV* sv = sv_newmortal();
+		gv_efullname4(sv, PL_last_in_gv, Nullch, FALSE);
+		name = SvPV_nolen(sv);
+	    }
+	    if (name && *name)
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle %s opened only for output", name);
+	    else
+		Perl_warner(aTHX_ WARN_IO,
+			    "Filehandle opened only for output");
 	}
     }
     if (!fp) {
-	if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) {
+	if (ckWARN2(WARN_GLOB, WARN_CLOSED)
+		&& (!io || !(IoFLAGS(io) & IOf_START))) {
 	    if (type == OP_GLOB)
-		Perl_warner(aTHX_ WARN_CLOSED,
+		Perl_warner(aTHX_ WARN_GLOB,
 			    "glob failed (can't start child: %s)",
 			    Strerror(errno));
-	    else {
-		SV* sv = sv_newmortal();
-		gv_efullname3(sv, PL_last_in_gv, Nullch);
-		Perl_warner(aTHX_ WARN_CLOSED,
-			    "readline() on closed filehandle %s",
-			    SvPV_nolen(sv));
-	    }
+	    else
+		report_evil_fh(PL_last_in_gv, io, PL_op->op_type);
 	}
 	if (gimme == G_SCALAR) {
 	    (void)SvOK_off(TARG);
@@ -1286,8 +1453,7 @@ Perl_do_readline(pTHX)
 /* delay EOF state for a snarfed empty file */
 #define SNARF_EOF(gimme,rs,io,sv) \
     (gimme != G_SCALAR || SvCUR(sv)					\
-     || !RsSNARF(rs) || (IoFLAGS(io) & IOf_NOLINE)			\
-     || ((IoFLAGS(io) |= IOf_NOLINE), FALSE))
+     || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs))
 
     for (;;) {
 	if (!sv_gets(sv, fp, offset)
@@ -1301,10 +1467,10 @@ Perl_do_readline(pTHX)
 		(void)do_close(PL_last_in_gv, FALSE);
 	    }
 	    else if (type == OP_GLOB) {
-		if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
-		    Perl_warner(aTHX_ WARN_CLOSED,
+		if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) {
+		    Perl_warner(aTHX_ WARN_GLOB,
 			   "glob failed (child exited with status %d%s)",
-			   STATUS_CURRENT >> 8,
+			   (int)(STATUS_CURRENT >> 8),
 			   (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
 		}
 	    }
@@ -1320,6 +1486,7 @@ Perl_do_readline(pTHX)
 	    SvTAINTED_on(sv);
 	}
 	IoLINES(io)++;
+	IoFLAGS(io) |= IOf_NOLINE;
 	SvSETMAGIC(sv);
 	XPUSHs(sv);
 	if (type == OP_GLOB) {
@@ -1392,15 +1559,16 @@ PP(pp_helem)
     U32 lval = PL_op->op_flags & OPf_MOD;
     U32 defer = PL_op->op_private & OPpLVAL_DEFER;
     SV *sv;
+    U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
 
     if (SvTYPE(hv) == SVt_PVHV) {
-	he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
+	he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
 	svp = he ? &HeVAL(he) : 0;
     }
     else if (SvTYPE(hv) == SVt_PVAV) {
 	if (PL_op->op_private & OPpLVAL_INTRO)
 	    DIE(aTHX_ "Can't localize pseudo-hash element");
-	svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, 0);
+	svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, hash);
     }
     else {
 	RETPUSHUNDEF;
@@ -1529,7 +1697,7 @@ PP(pp_iter)
 		    /* safe to reuse old SV */
 		    sv_setsv(*itersvp, cur);
 		}
-		else 
+		else
 #endif
 		{
 		    /* we need a fresh SV every time so that loop body sees a
@@ -1555,7 +1723,7 @@ PP(pp_iter)
 	    /* safe to reuse old SV */
 	    sv_setiv(*itersvp, cx->blk_loop.iterix++);
 	}
-	else 
+	else
 #endif
 	{
 	    /* we need a fresh SV every time so that loop body sees a
@@ -1573,9 +1741,9 @@ PP(pp_iter)
 
     SvREFCNT_dec(*itersvp);
 
-    if (sv = (SvMAGICAL(av)) 
-	    ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE) 
-	    : AvARRAY(av)[++cx->blk_loop.iterix])
+    if ((sv = SvMAGICAL(av)
+	      ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE)
+	      : AvARRAY(av)[++cx->blk_loop.iterix]))
 	SvTEMP_off(sv);
     else
 	sv = &PL_sv_undef;
@@ -1626,7 +1794,6 @@ PP(pp_subst)
     STRLEN len;
     int force_on_match = 0;
     I32 oldsave = PL_savestack_ix;
-    I32 update_minmatch = 1;
 
     /* known replacement string? */
     dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
@@ -1635,7 +1802,9 @@ PP(pp_subst)
     else {
 	TARG = DEFSV;
 	EXTEND(SP,1);
-    }                  
+    }
+    if (SvFAKE(TARG) && SvREADONLY(TARG))
+	sv_force_normal(TARG);
     if (SvREADONLY(TARG)
 	|| (SvTYPE(TARG) > SVt_PVLV
 	    && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
@@ -1656,7 +1825,7 @@ PP(pp_subst)
 	DIE(aTHX_ "panic: do_subst");
 
     strend = s + len;
-    maxiters = 2*(strend - s) + 10;	/* We can match twice at each 
+    maxiters = 2*(strend - s) + 10;	/* We can match twice at each
 					   position, once with zero-length,
 					   second time with non-zero. */
 
@@ -1680,7 +1849,7 @@ PP(pp_subst)
 	    goto nope;
 	/* How to do it in subst? */
 /*	if ( (rx->reganch & ROPT_CHECK_ALL)
-	     && !PL_sawampersand 
+	     && !PL_sawampersand
 	     && ((rx->reganch & ROPT_NOSCAN)
 		 || !((rx->reganch & RE_INTUIT_TAIL)
 		      && (r_flags & REXEC_SCREAM))))
@@ -1732,7 +1901,7 @@ PP(pp_subst)
 		SvCUR_set(TARG, m - s);
 	    }
 	    /*SUPPRESS 560*/
-	    else if (i = m - s) {	/* faster from front */
+	    else if ((i = m - s)) {	/* faster from front */
 		d -= clen;
 		m = d;
 		sv_chop(TARG, d-i);
@@ -1761,7 +1930,7 @@ PP(pp_subst)
 		rxtainted |= RX_MATCH_TAINTED(rx);
 		m = rx->startp[0] + orig;
 		/*SUPPRESS 560*/
-		if (i = m - s) {
+		if ((i = m - s)) {
 		    if (s != d)
 			Move(s, d, i, char);
 		    d += i;
@@ -1784,7 +1953,7 @@ PP(pp_subst)
 	    SPAGAIN;
 	    PUSHs(sv_2mortal(newSViv((I32)iters)));
 	}
-	(void)SvPOK_only(TARG);
+	(void)SvPOK_only_UTF8(TARG);
 	TAINT_IF(rxtainted);
 	if (SvSMAGICAL(TARG)) {
 	    PUTBACK;
@@ -1858,7 +2027,7 @@ PP(pp_subst)
     goto ret_no;
 
 nope:
-ret_no:         
+ret_no:
     SPAGAIN;
     PUSHs(&PL_sv_no);
     LEAVE_SCOPE(oldsave);
@@ -1917,7 +2086,7 @@ PP(pp_leavesub)
     SV *sv;
 
     POPBLOCK(cx,newpm);
- 
+
     TAINT_NOT;
     if (gimme == G_SCALAR) {
 	MARK = newsp + 1;
@@ -1929,8 +2098,10 @@ PP(pp_leavesub)
 		    sv_2mortal(*MARK);
 		}
 		else {
+		    sv = SvREFCNT_inc(TOPs);	/* FREETMPS could clobber it */
 		    FREETMPS;
-		    *MARK = sv_mortalcopy(TOPs);
+		    *MARK = sv_mortalcopy(sv);
+		    SvREFCNT_dec(sv);
 		}
 	    }
 	    else
@@ -1951,7 +2122,7 @@ PP(pp_leavesub)
 	}
     }
     PUTBACK;
-    
+
     POPSUB(cx,sv);	/* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
@@ -1973,7 +2144,7 @@ PP(pp_leavesublv)
     SV *sv;
 
     POPBLOCK(cx,newpm);
- 
+
     TAINT_NOT;
 
     if (cx->blk_sub.lval & OPpENTERSUB_INARGS) {
@@ -2059,7 +2230,6 @@ PP(pp_leavesublv)
 			: "an uninitialized value");
 		}
 		else {
-		    mortalize:
 		    /* Can be a localized value subject to deletion. */
 		    PL_tmps_stack[++PL_tmps_ix] = *mark;
 		    (void)SvREFCNT_inc(*mark);
@@ -2079,8 +2249,10 @@ PP(pp_leavesublv)
 			sv_2mortal(*MARK);
 		    }
 		    else {
+			sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
 			FREETMPS;
-			*MARK = sv_mortalcopy(TOPs);
+			*MARK = sv_mortalcopy(sv);
+			SvREFCNT_dec(sv);
 		    }
 		}
 		else
@@ -2103,7 +2275,7 @@ PP(pp_leavesublv)
 	}
     }
     PUTBACK;
-    
+
     POPSUB(cx,sv);	/* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
@@ -2124,21 +2296,23 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 
 	save_item(dbsv);
 	if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
-	     || strEQ(GvNAME(gv), "END") 
+	     || strEQ(GvNAME(gv), "END")
 	     || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
 		 !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv)
 		    && (gv = (GV*)*svp) ))) {
 	    /* Use GV from the stack as a fallback. */
 	    /* GV is potentially non-unique, or contain different CV. */
-	    sv_setsv(dbsv, newRV((SV*)cv));
+	    SV *tmp = newRV((SV*)cv);
+	    sv_setsv(dbsv, tmp);
+	    SvREFCNT_dec(tmp);
 	}
 	else {
 	    gv_efullname3(dbsv, gv, Nullch);
 	}
     }
     else {
-	SvUPGRADE(dbsv, SVt_PVIV);
-	SvIOK_on(dbsv);
+	(void)SvUPGRADE(dbsv, SVt_PVIV);
+	(void)SvIOK_on(dbsv);
 	SAVEIV(SvIVX(dbsv));
 	SvIVX(dbsv) = PTR2IV(cv);	/* Do it the quickest way  */
     }
@@ -2400,7 +2574,7 @@ try_autoload:
 	    }
 	    PL_stack_sp = mark + 1;
 	    fp3 = (I32(*)(int,int,int))CvXSUB(cv);
-	    items = (*fp3)(CvXSUBANY(cv).any_i32, 
+	    items = (*fp3)(CvXSUBANY(cv).any_i32,
 			   MARK - PL_stack_base + 1,
 			   items);
 	    PL_stack_sp = PL_stack_base + items;
@@ -2430,7 +2604,7 @@ try_autoload:
 		    EXTEND(SP, items);
 		    Copy(AvARRAY(av), SP + 1, items, SV*);
 		    SP += items;
-		    PUTBACK ;		    
+		    PUTBACK ;		
 		}
 	    }
 	    /* We assume first XSUB in &DB::sub is the called one. */
@@ -2524,7 +2698,7 @@ try_autoload:
 		EXTEND(SP, items);
 		Copy(AvARRAY(av), SP + 1, items, SV*);
 		SP += items;
-		PUTBACK ;		    
+		PUTBACK ;		
 	    }
 	}
 #endif /* USE_THREADS */		
@@ -2553,6 +2727,7 @@ try_autoload:
 	    cx->blk_sub.savearray = GvAV(PL_defgv);
 	    GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
 #endif /* USE_THREADS */
+	    cx->blk_sub.oldcurpad = PL_curpad;
 	    cx->blk_sub.argarray = av;
 	    ++MARK;
 
@@ -2571,7 +2746,7 @@ try_autoload:
 	    }
 	    Copy(MARK,AvARRAY(av),items,SV*);
 	    AvFILLp(av) = items - 1;
-	    
+	
 	    while (items--) {
 		if (*MARK)
 		    SvTEMP_off(*MARK);
@@ -2601,7 +2776,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
     else {
 	SV* tmpstr = sv_newmortal();
 	gv_efullname3(tmpstr, CvGV(cv), Nullch);
-	Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on subroutine \"%s\"", 
+	Perl_warner(aTHX_ WARN_RECURSION, "Deep recursion on subroutine \"%s\"",
 		SvPVX(tmpstr));
     }
 }
@@ -2610,7 +2785,7 @@ PP(pp_aelem)
 {
     djSP;
     SV** svp;
-    I32 elem = POPi;
+    IV elem = POPi;
     AV* av = (AV*)POPs;
     U32 lval = PL_op->op_flags & OPf_MOD;
     U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
@@ -2709,7 +2884,6 @@ PP(pp_method_named)
 STATIC SV *
 S_method_common(pTHX_ SV* meth, U32* hashp)
 {
-    djSP;
     SV* sv;
     SV* ob;
     GV* gv;
@@ -2722,6 +2896,9 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     name = SvPV(meth, namelen);
     sv = *(PL_stack_base + TOPMARK + 1);
 
+    if (!sv)
+	Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
+
     if (SvGMAGICAL(sv))
         mg_get(sv);
     if (SvROK(sv))
@@ -2735,8 +2912,8 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	    !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
 	    !(ob=(SV*)GvIO(iogv)))
 	{
-	    if (!packname || 
-		((*(U8*)packname >= 0xc0 && IN_UTF8)
+	    if (!packname ||
+		((*(U8*)packname >= 0xc0 && DO_UTF8(sv))
 		    ? !isIDFIRST_utf8((U8*)packname)
 		    : !isIDFIRST(*packname)
 		))
@@ -2751,9 +2928,13 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	*(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
     }
 
-    if (!ob || !SvOBJECT(ob))
+    if (!ob || !(SvOBJECT(ob)
+		 || (SvTYPE(ob) == SVt_PVGV && (ob = (SV*)GvIO((GV*)ob))
+		     && SvOBJECT(ob))))
+    {
 	Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
 		   name);
+    }
 
     stash = SvSTASH(ob);
 
@@ -2774,6 +2955,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	char* leaf = name;
 	char* sep = Nullch;
 	char* p;
+	GV* gv;
 
 	for (p = name; *p; p++) {
 	    if (*p == '\'')
@@ -2789,9 +2971,18 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	    packname = name;
 	    packlen = sep - name;
 	}
-	Perl_croak(aTHX_
-		   "Can't locate object method \"%s\" via package \"%s\"",
-		   leaf, packname);
+	gv = gv_fetchpv(packname, 0, SVt_PVHV);
+	if (gv && isGV(gv)) {
+	    Perl_croak(aTHX_
+		       "Can't locate object method \"%s\" via package \"%s\"",
+		       leaf, packname);
+	}
+	else {
+	    Perl_croak(aTHX_
+		       "Can't locate object method \"%s\" via package \"%s\""
+		       " (perhaps you forgot to load \"%s\"?)",
+		       leaf, packname, packname);
+	}
     }
     return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
 }