Integrate with Sarathy.

p4raw-id: //depot/cfgperl@3742

26 files changed, 176 insertions, 50 deletions

diff --git a/dump.c b/dump.c
index f506de8492..28233e9822 100644
--- a/dump.c
+++ b/dump.c
@@ -524,6 +524,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
     case OP_CONST:
 	Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv));
 	break;
+    case OP_SETSTATE:
     case OP_NEXTSTATE:
     case OP_DBSTATE:
 	if (cCOPo->cop_line)
diff --git a/embed.h b/embed.h
index c90f50dced..f2b0bfac1d 100644
--- a/embed.h
+++ b/embed.h
@@ -764,6 +764,7 @@
 #define scalarboolean		S_scalarboolean
 #define too_few_arguments	S_too_few_arguments
 #define too_many_arguments	S_too_many_arguments
+#define op_clear		S_op_clear
 #define null			S_null
 #define pad_findlex		S_pad_findlex
 #define newDEFSVOP		S_newDEFSVOP
@@ -1274,6 +1275,7 @@
 #define pp_seq			Perl_pp_seq
 #define pp_setpgrp		Perl_pp_setpgrp
 #define pp_setpriority		Perl_pp_setpriority
+#define pp_setstate		Perl_pp_setstate
 #define pp_sge			Perl_pp_sge
 #define pp_sgrent		Perl_pp_sgrent
 #define pp_sgt			Perl_pp_sgt
@@ -2075,6 +2077,7 @@
 #define scalarboolean(a)	S_scalarboolean(aTHX_ a)
 #define too_few_arguments(a,b)	S_too_few_arguments(aTHX_ a,b)
 #define too_many_arguments(a,b)	S_too_many_arguments(aTHX_ a,b)
+#define op_clear(a)		S_op_clear(aTHX_ a)
 #define null(a)			S_null(aTHX_ a)
 #define pad_findlex(a,b,c,d,e,f,g)	S_pad_findlex(aTHX_ a,b,c,d,e,f,g)
 #define newDEFSVOP()		S_newDEFSVOP(aTHX)
@@ -2584,6 +2587,7 @@
 #define pp_seq()		Perl_pp_seq(aTHX)
 #define pp_setpgrp()		Perl_pp_setpgrp(aTHX)
 #define pp_setpriority()	Perl_pp_setpriority(aTHX)
+#define pp_setstate()		Perl_pp_setstate(aTHX)
 #define pp_sge()		Perl_pp_sge(aTHX)
 #define pp_sgrent()		Perl_pp_sgrent(aTHX)
 #define pp_sgt()		Perl_pp_sgt(aTHX)
@@ -4107,6 +4111,8 @@
 #define too_few_arguments	S_too_few_arguments
 #define S_too_many_arguments	CPerlObj::S_too_many_arguments
 #define too_many_arguments	S_too_many_arguments
+#define S_op_clear		CPerlObj::S_op_clear
+#define op_clear		S_op_clear
 #define S_null			CPerlObj::S_null
 #define null			S_null
 #define S_pad_findlex		CPerlObj::S_pad_findlex
@@ -5081,6 +5087,8 @@
 #define pp_setpgrp		Perl_pp_setpgrp
 #define Perl_pp_setpriority	CPerlObj::Perl_pp_setpriority
 #define pp_setpriority		Perl_pp_setpriority
+#define Perl_pp_setstate	CPerlObj::Perl_pp_setstate
+#define pp_setstate		Perl_pp_setstate
 #define Perl_pp_sge		CPerlObj::Perl_pp_sge
 #define pp_sge			Perl_pp_sge
 #define Perl_pp_sgrent		CPerlObj::Perl_pp_sgrent
diff --git a/embed.pl b/embed.pl
index cbd2294633..cca15c4443 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1800,6 +1800,7 @@ s	|OP*	|no_fh_allowed	|OP *o
 s	|OP*	|scalarboolean	|OP *o
 s	|OP*	|too_few_arguments|OP *o|char* name
 s	|OP*	|too_many_arguments|OP *o|char* name
+s	|void	|op_clear	|OP* o
 s	|void	|null		|OP* o
 s	|PADOFFSET|pad_findlex	|char* name|PADOFFSET newoff|U32 seq \
 				|CV* startcv|I32 cx_ix|I32 saweval|U32 flags
diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 1a41c21c2b..62ad464070 100644
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -11,8 +11,8 @@
 #  define dTHR int dummy_thr
 #endif	/* dTHR */ 
 
-/*#define DBG_SUB 1     /* */
-/*#define DBG_TIMER 1   /* */
+/*#define DBG_SUB 1      */
+/*#define DBG_TIMER 1    */
 
 #ifdef DBG_SUB
 #  define DBG_SUB_NOTIFY(A,B) warn( A, B )
@@ -285,6 +285,7 @@ prof_mark( opcode ptype )
 
 #ifdef PERLDBf_NONAME
 	{
+	    dTHX;
 	    SV **svp;
 	    char *gname, *pname;
 	    static U32 lastid;
@@ -419,6 +420,7 @@ static void
 test_time(clock_t *r, clock_t *u, clock_t *s)
 {
     dTHR;
+    dTHX;
     CV *cv = perl_get_cv("Devel::DProf::NONESUCH_noxs", FALSE);
     int i, j, k = 0;
     HV *oldstash = curstash;
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index ac91b780ec..ac6abc7e54 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -332,7 +332,7 @@ invert_opset function.
 
     cond_expr flip flop andassign orassign and or xor
 
-    warn die lineseq nextstate scope enter leave
+    warn die lineseq nextstate scope enter leave setstate
 
     rv2cv anoncode prototype
 
diff --git a/objXSUB.h b/objXSUB.h
index 8134c177a5..abd3b0c9fd 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -4782,6 +4782,10 @@
 #define Perl_pp_setpriority	pPerl->Perl_pp_setpriority
 #undef  pp_setpriority
 #define pp_setpriority		Perl_pp_setpriority
+#undef  Perl_pp_setstate
+#define Perl_pp_setstate	pPerl->Perl_pp_setstate
+#undef  pp_setstate
+#define pp_setstate		Perl_pp_setstate
 #undef  Perl_pp_sge
 #define Perl_pp_sge		pPerl->Perl_pp_sge
 #undef  pp_sge
diff --git a/op.c b/op.c
index b605e669ab..755c34e77e 100644
--- a/op.c
+++ b/op.c
@@ -648,6 +648,7 @@ void
 Perl_op_free(pTHX_ OP *o)
 {
     register OP *kid, *nextkid;
+    OPCODE type;
 
     if (!o || o->op_seq == (U16)-1)
 	return;
@@ -658,22 +659,42 @@ Perl_op_free(pTHX_ OP *o)
 	    op_free(kid);
 	}
     }
+    type = o->op_type;
+    if (type == OP_NULL)
+	type = o->op_targ;
+
+    /* COP* is not cleared by op_clear() so that we may track line
+     * numbers etc even after null() */
+    if (type == OP_NEXTSTATE || type == OP_SETSTATE || type == OP_DBSTATE)
+	cop_free((COP*)o);
 
+    op_clear(o);
+
+#ifdef PL_OP_SLAB_ALLOC
+    if ((char *) o == PL_OpPtr)
+     {
+     }
+#else
+    Safefree(o);
+#endif
+}
+
+STATIC void
+S_op_clear(pTHX_ OP *o)
+{
     switch (o->op_type) {
-    case OP_NULL:
-	o->op_targ = 0;	/* Was holding old type, if any. */
-	break;
-    case OP_ENTEREVAL:
-	o->op_targ = 0;	/* Was holding hints. */
+    case OP_NULL:	/* Was holding old type, if any. */
+    case OP_ENTEREVAL:	/* Was holding hints. */
+#ifdef USE_THREADS
+    case OP_THREADSV:	/* Was holding index into thr->threadsv AV. */
+#endif
+	o->op_targ = 0;
 	break;
 #ifdef USE_THREADS
     case OP_ENTERITER:
 	if (!(o->op_flags & OPf_SPECIAL))
 	    break;
 	/* FALL THROUGH */
-    case OP_THREADSV:
-	o->op_targ = 0;	/* Was holding index into thr->threadsv AV. */
-	break;
 #endif /* USE_THREADS */
     default:
 	if (!(o->op_flags & OPf_REF)
@@ -684,13 +705,11 @@ Perl_op_free(pTHX_ OP *o)
     case OP_GV:
     case OP_AELEMFAST:
 	SvREFCNT_dec(cGVOPo->op_gv);
-	break;
-    case OP_NEXTSTATE:
-    case OP_DBSTATE:
-	cop_free((COP*)o);
+	cGVOPo->op_gv = Nullgv;
 	break;
     case OP_CONST:
 	SvREFCNT_dec(cSVOPo->op_sv);
+	cSVOPo->op_sv = Nullsv;
 	break;
     case OP_GOTO:
     case OP_NEXT:
@@ -700,31 +719,29 @@ Perl_op_free(pTHX_ OP *o)
 	    break;
 	/* FALL THROUGH */
     case OP_TRANS:
-	if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
+	if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
 	    SvREFCNT_dec(cSVOPo->op_sv);
-	else
+	    cSVOPo->op_sv = Nullsv;
+	}
+	else {
 	    Safefree(cPVOPo->op_pv);
+	    cPVOPo->op_pv = Nullch;
+	}
 	break;
     case OP_SUBST:
 	op_free(cPMOPo->op_pmreplroot);
+	cPMOPo->op_pmreplroot = Nullop;
 	/* FALL THROUGH */
     case OP_PUSHRE:
     case OP_MATCH:
     case OP_QR:
 	ReREFCNT_dec(cPMOPo->op_pmregexp);
+	cPMOPo->op_pmregexp = (REGEXP*)NULL;
 	break;
     }
 
     if (o->op_targ > 0)
 	pad_free(o->op_targ);
-
-#ifdef PL_OP_SLAB_ALLOC
-    if ((char *) o == PL_OpPtr)
-     {
-     }
-#else
-    Safefree(o);
-#endif
 }
 
 STATIC void
@@ -739,8 +756,9 @@ S_cop_free(pTHX_ COP* cop)
 STATIC void
 S_null(pTHX_ OP *o)
 {
-    if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
-	pad_free(o->op_targ);
+    if (o->op_type == OP_NULL)
+	return;
+    op_clear(o);
     o->op_targ = o->op_type;
     o->op_type = OP_NULL;
     o->op_ppaddr = PL_ppaddr[OP_NULL];
@@ -881,9 +899,12 @@ Perl_scalarvoid(pTHX_ OP *o)
     SV* sv;
     U8 want;
 
-    if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE ||
-	(o->op_type == OP_NULL &&
-	 (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)))
+    if (o->op_type == OP_NEXTSTATE
+	|| o->op_type == OP_SETSTATE
+	|| o->op_type == OP_DBSTATE
+	|| (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE
+				      || o->op_targ == OP_SETSTATE
+				      || o->op_targ == OP_DBSTATE)))
     {
 	dTHR;
 	PL_curcop = (COP*)o;		/* for warning below */
@@ -1013,8 +1034,7 @@ Perl_scalarvoid(pTHX_ OP *o)
 		}
 	    }
 	}
-	null(o);		/* don't execute a constant */
-	SvREFCNT_dec(sv);	/* don't even remember it */
+	null(o);		/* don't execute or even remember it */
 	break;
 
     case OP_POSTINC:
@@ -1685,8 +1705,8 @@ Perl_scope(pTHX_ OP *o)
 		o->op_ppaddr = PL_ppaddr[OP_SCOPE];
 		kid = ((LISTOP*)o)->op_first;
 		if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
-		    cop_free((COP*)kid);
-		    null(kid);
+		    kid->op_type = OP_SETSTATE;
+		    kid->op_ppaddr = PL_ppaddr[OP_SETSTATE];
 		}
 	    }
 	    else
@@ -3882,7 +3902,7 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
     for (; o; o = o->op_next) {
 	OPCODE type = o->op_type;
 
-	if(sv && o->op_next == o) 
+	if (sv && o->op_next == o) 
 	    return sv;
 	if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
 	    continue;
@@ -4707,6 +4727,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
 	    kid->op_type = OP_GV;
 	    SvREFCNT_dec(kid->op_sv);
 	    kid->op_sv = SvREFCNT_inc(gv);
+	    kid->op_ppaddr = PL_ppaddr[OP_GV];
 	}
     }
     return o;
@@ -5451,9 +5472,11 @@ Perl_ck_subr(pTHX_ OP *o)
 	o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
 	null(cvop);		/* disable rv2cv */
 	tmpop = (SVOP*)((UNOP*)cvop)->op_first;
-	if (tmpop->op_type == OP_GV) {
+	if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) {
 	    cv = GvCVu(tmpop->op_sv);
-	    if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
+	    if (!cv)
+		tmpop->op_private |= OPpEARLY_CV;
+	    else if (SvPOK(cv)) {
 		namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
 		proto = SvPV((SV*)cv, n_a);
 	    }
@@ -5642,6 +5665,7 @@ Perl_peep(pTHX_ register OP *o)
 	    PL_op_seqmax++;
 	PL_op = o;
 	switch (o->op_type) {
+	case OP_SETSTATE:
 	case OP_NEXTSTATE:
 	case OP_DBSTATE:
 	    PL_curcop = ((COP*)o);		/* for warnings */
@@ -5690,8 +5714,12 @@ Perl_peep(pTHX_ register OP *o)
 	    }
 	    goto nothin;
 	case OP_NULL:
-	    if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
+	    if (o->op_targ == OP_NEXTSTATE
+		|| o->op_targ == OP_DBSTATE
+		|| o->op_targ == OP_SETSTATE)
+	    {
 		PL_curcop = ((COP*)o);
+	    }
 	    goto nothin;
 	case OP_SCALAR:
 	case OP_LINESEQ:
@@ -5726,7 +5754,6 @@ Perl_peep(pTHX_ register OP *o)
 				<= 255 &&
 		    i >= 0)
 		{
-		    SvREFCNT_dec(((SVOP*)pop)->op_sv);
 		    null(o->op_next);
 		    null(pop->op_next);
 		    null(pop);
@@ -5738,6 +5765,18 @@ Perl_peep(pTHX_ register OP *o)
 		    GvAVn(((GVOP*)o)->op_gv);
 		}
 	    }
+	    else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) {
+		GV *gv = cGVOPo->op_gv;
+		if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) {
+		    /* XXX could check prototype here instead of just carping */
+		    SV *sv = sv_newmortal();
+		    gv_efullname3(sv, gv, Nullch);
+		    Perl_warner(aTHX_ WARN_UNSAFE,
+				"%s() called too early to check prototype",
+				SvPV_nolen(sv));
+		}
+	    }
+
 	    o->op_seq = PL_op_seqmax++;
 	    break;
 
diff --git a/op.h b/op.h
index 4de46478d3..dd6307c479 100644
--- a/op.h
+++ b/op.h
@@ -127,6 +127,8 @@ typedef U32 PADOFFSET;
   /* OP_RV2CV only */
 #define OPpENTERSUB_AMPER	8	/* Used & form to call. */
 #define OPpENTERSUB_NOPAREN	128	/* bare sub call (without parens) */
+  /* OP_GV only */
+#define OPpEARLY_CV		32	/* foo() called before sub foo was parsed */
   /* OP_?ELEM only */
 #define OPpLVAL_DEFER		16	/* Defer creation of array/hash elem */
   /* for OP_RV2?V, lower bits carry hints */
diff --git a/opcode.h b/opcode.h
index ab279becb2..da4a8fe39e 100644
--- a/opcode.h
+++ b/opcode.h
@@ -357,10 +357,11 @@ typedef enum {
 	OP_SYSCALL,	/* 345 */
 	OP_LOCK,	/* 346 */
 	OP_THREADSV,	/* 347 */
+	OP_SETSTATE,	/* 348 */
 	OP_max		
 } opcode;
 
-#define MAXO 348
+#define MAXO 349
 
 
 START_EXTERN_C
@@ -717,6 +718,7 @@ EXT char *PL_op_name[] = {
 	"syscall",
 	"lock",
 	"threadsv",
+	"setstate",
 };
 #endif
 
@@ -1072,6 +1074,7 @@ EXT char *PL_op_desc[] = {
 	"syscall",
 	"lock",
 	"per-thread variable",
+	"set statement info",
 };
 #endif
 
@@ -1432,6 +1435,7 @@ EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = {
 	Perl_pp_syscall,
 	Perl_pp_lock,
 	Perl_pp_threadsv,
+	Perl_pp_setstate,
 };
 #endif
 
@@ -1787,6 +1791,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
 	Perl_ck_fun,	/* syscall */
 	Perl_ck_rfun,	/* lock */
 	Perl_ck_null,	/* threadsv */
+	Perl_ck_null,	/* setstate */
 };
 #endif
 
@@ -1923,7 +1928,7 @@ EXT U32 PL_opargs[] = {
 	0x00026e04,	/* aelemfast */
 	0x00026404,	/* aelem */
 	0x00046801,	/* aslice */
-	0x00009608,	/* each */
+	0x00009600,	/* each */
 	0x00009608,	/* values */
 	0x00009608,	/* keys */
 	0x00003600,	/* delete */
@@ -2142,6 +2147,7 @@ EXT U32 PL_opargs[] = {
 	0x0004281d,	/* syscall */
 	0x00003604,	/* lock */
 	0x00000044,	/* threadsv */
+	0x00000000,	/* setstate */
 };
 #endif
 
diff --git a/opcode.pl b/opcode.pl
index 56d8342a16..4804554c7e 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -301,6 +301,8 @@ sub tab {
 
 __END__
 
+# New ops always go at the very end
+
 # Nothing.
 
 null		null operation		ck_null		0	
@@ -481,7 +483,7 @@ aslice		array slice		ck_null		m@	A L
 
 # Hashes.
 
-each		each			ck_fun		t%	H
+each		each			ck_fun		%	H
 values		values			ck_fun		t%	H
 keys		keys			ck_fun		t%	H
 delete		delete			ck_delete	%	S
@@ -559,6 +561,7 @@ redo		redo			ck_null		ds}
 dump		dump			ck_null		ds}	
 goto		goto			ck_null		ds}	
 exit		exit			ck_fun		ds%	S?
+# continued below
 
 #nswitch		numeric switch		ck_null		d	
 #cswitch		character switch	ck_null		d	
@@ -775,3 +778,6 @@ syscall		syscall			ck_fun		imst@	S L
 # For multi-threading
 lock		lock			ck_rfun		s%	S
 threadsv	per-thread variable	ck_null		ds0
+
+# Control (contd.)
+setstate	set statement info	ck_null		0
diff --git a/perlapi.c b/perlapi.c
index fb078f3ce9..a7934fb8a0 100755
--- a/perlapi.c
+++ b/perlapi.c
@@ -6981,6 +6981,13 @@ Perl_pp_setpriority(pTHXo)
     return ((CPerlObj*)pPerl)->Perl_pp_setpriority();
 }
 
+#undef  Perl_pp_setstate
+OP *
+Perl_pp_setstate(pTHXo)
+{
+    return ((CPerlObj*)pPerl)->Perl_pp_setstate();
+}
+
 #undef  Perl_pp_sge
 OP *
 Perl_pp_sge(pTHXo)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index f5717c5a7b..b3265ffb74 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -74,6 +74,16 @@ C<'>-delimited regular expression.
 by parentheses turns into a function, with all the list operators arguments
 found inside the parentheses.  See L<perlop/Terms and List Operators (Leftward)>.
 
+=item %s() called too early to check prototype
+
+(W) You've called a function that has a prototype before the parser saw a
+definition or declaration for it, and Perl could not check that the call
+conforms to the prototype.  You need to either add an early prototype
+declaration for the subroutine in question, or move the subroutine
+definition ahead of the call to get proper prototype checking.  Alternatively,
+if you are certain that you're calling the function correctly, you may put
+an ampersand before the name to avoid the warning.  See L<perlsub>.
+
 =item %s argument is not a HASH element
 
 (F) The argument to exists() must be a hash element, such as
diff --git a/pp.c b/pp.c
index 3bd26f4cc9..c7fd585d54 100644
--- a/pp.c
+++ b/pp.c
@@ -2631,7 +2631,7 @@ PP(pp_aslice)
 
 PP(pp_each)
 {
-    djSP; dTARGET;
+    djSP;
     HV *hash = (HV*)POPs;
     HE *entry;
     I32 gimme = GIMME_V;
@@ -2646,12 +2646,13 @@ PP(pp_each)
     if (entry) {
 	PUSHs(hv_iterkeysv(entry));	/* won't clobber stack_sp */
 	if (gimme == G_ARRAY) {
+	    SV *val;
 	    PUTBACK;
 	    /* might clobber stack_sp */
-	    sv_setsv(TARG, realhv ?
-		     hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
+	    val = realhv ?
+		  hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
 	    SPAGAIN;
-	    PUSHs(TARG);
+	    PUSHs(val);
 	}
     }
     else if (gimme == G_SCALAR)
diff --git a/pp.sym b/pp.sym
index a67838898d..00e4b4e6d2 100644
--- a/pp.sym
+++ b/pp.sym
@@ -382,3 +382,4 @@ Perl_pp_getlogin
 Perl_pp_syscall
 Perl_pp_lock
 Perl_pp_threadsv
+Perl_pp_setstate
diff --git a/pp_hot.c b/pp_hot.c
index 81a4f5699f..30b44064ef 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -69,6 +69,12 @@ PP(pp_null)
     return NORMAL;
 }
 
+PP(pp_setstate)
+{
+    PL_curcop = (COP*)PL_op;
+    return NORMAL;
+}
+
 PP(pp_pushmark)
 {
     PUSHMARK(PL_stack_sp);
diff --git a/pp_proto.h b/pp_proto.h
index efac700dd8..300637c129 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -383,3 +383,4 @@ PERL_PPDEF(Perl_pp_getlogin)
 PERL_PPDEF(Perl_pp_syscall)
 PERL_PPDEF(Perl_pp_lock)
 PERL_PPDEF(Perl_pp_threadsv)
+PERL_PPDEF(Perl_pp_setstate)
diff --git a/proto.h b/proto.h
index ed2fdb14f5..291989d0f0 100644
--- a/proto.h
+++ b/proto.h
@@ -773,6 +773,7 @@ STATIC OP*	S_no_fh_allowed(pTHX_ OP *o);
 STATIC OP*	S_scalarboolean(pTHX_ OP *o);
 STATIC OP*	S_too_few_arguments(pTHX_ OP *o, char* name);
 STATIC OP*	S_too_many_arguments(pTHX_ OP *o, char* name);
+STATIC void	S_op_clear(pTHX_ OP* o);
 STATIC void	S_null(pTHX_ OP* o);
 STATIC PADOFFSET	S_pad_findlex(pTHX_ char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags);
 STATIC OP*	S_newDEFSVOP(pTHX);
diff --git a/regcomp.c b/regcomp.c
index c6fb7feeb7..2d81da18d4 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -3224,6 +3224,7 @@ void
 Perl_pregfree(pTHX_ struct regexp *r)
 {
     dTHR;
+    DEBUG_r(if (!PL_colorset) reginitcolors());
     DEBUG_r(PerlIO_printf(Perl_debug_log,
 		      "%sFreeing REx:%s `%s%.60s%s%s'\n",
 		      PL_colors[4],PL_colors[5],PL_colors[0],
diff --git a/regexec.c b/regexec.c
index e40d1c7ea7..e69c4ffd4e 100644
--- a/regexec.c
+++ b/regexec.c
@@ -321,6 +321,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 		 && (sv && (strpos + SvCUR(sv) != strend)) )
 		goto fail;
 
+	    PL_regeol = strend;			/* Used in HOP() */
 	    s = (char*)HOP((U8*)strpos, prog->check_offset_min);
 	    if (SvTAIL(prog->check_substr)) {
 		slen = SvCUR(prog->check_substr);	/* >= 1 */
diff --git a/t/harness b/t/harness
index c46a87090c..b89b35ac85 100644
--- a/t/harness
+++ b/t/harness
@@ -57,7 +57,7 @@ EOT
 @tests = grep (!$infinite{$_}, @tests);
 @tests = map {
          my $new = $_;
-	 if ($datahandle{$_} && !( -f $new.t) ) {
+	 if ($datahandle{$_} && !( -f "$new.t") ) {
              $new .= '.t';
              local(*F, *T);
              open(F,"<$_") or die "Can't open $_: $!";
diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t
index 8547024df3..3d5145ec5e 100755
--- a/t/lib/io_udp.t
+++ b/t/lib/io_udp.t
@@ -31,6 +31,7 @@ BEGIN {
 }
 
 sub compare_addr {
+    no utf8;
     my $a = shift;
     my $b = shift;
     if (length($a) != length $b) {
diff --git a/t/op/each.t b/t/op/each.t
index 9063c2c3ed..879c0d0fd3 100755
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -1,8 +1,6 @@
 #!./perl
 
-# $RCSfile: each.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:47 $
-
-print "1..16\n";
+print "1..19\n";
 
 $h{'abc'} = 'ABC';
 $h{'def'} = 'DEF';
@@ -120,3 +118,16 @@ while (($key, $value) = each(h)) {
 	}
 }
 if ($i == 5) { print "ok 16\n" } else { print "not ok\n" }
+
+{
+    package Obj;
+    sub DESTROY { print "ok 18\n"; }
+    {
+	my $h = { A => bless [], __PACKAGE__ };
+        while (my($k,$v) = each %$h) {
+	    print "ok 17\n" if $k eq 'A' and ref($v) eq 'Obj';
+	}
+    }
+    print "ok 19\n";
+}
+
diff --git a/t/op/misc.t b/t/op/misc.t
index 8281bf0e77..926c7f38d0 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -497,3 +497,11 @@ END { print $foo }
 ';
 EXPECT
 ZZZ
+########
+-w
+if (@ARGV) { print "" }
+else {
+  if ($x == 0) { print "" } else { print $x }
+}
+EXPECT
+Use of uninitialized value at - line 4.
diff --git a/t/op/re_tests b/t/op/re_tests
index cbcb7251b1..34b6e29414 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -714,3 +714,4 @@ a(?{$a=2;$b=3;($b)=$a})b	yabz	y	$b	2
 round\(((?>[^()]+))\)	_I(round(xs * sz),1)	y	$1	xs * sz
 '((?x:.) )'	x 	y	$1-	x -
 '((?-x:.) )'x	x 	y	$1-	x-
+foo.bart	foo.bart	y	-	-
diff --git a/t/pragma/locale.t b/t/pragma/locale.t
index f6b0f2d189..4999617d51 100755
--- a/t/pragma/locale.t
+++ b/t/pragma/locale.t
@@ -11,6 +11,7 @@ BEGIN {
 }
 
 use strict;
+no utf8;
 
 my $debug = 1;
 
diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
index 60490bcd6a..f586b2540c 100644
--- a/t/pragma/warn/pp_hot
+++ b/t/pragma/warn/pp_hot
@@ -54,6 +54,12 @@ print getc(FOO);
 read(FOO,$_,1);
 no warning 'io' ;
 print STDIN "anc";
+###############################################################
+#                            N O T E                          #
+# This test is known to fail on Linux systems with glibc.     #
+# The glibc development team is aware of the problem, and has #
+# determined a fix for the next release of that library.      #
+###############################################################
 EXPECT
 Filehandle main::STDIN opened only for input at - line 3.
 Filehandle main::STDOUT opened only for output at - line 4.