[win32] merge change#1015 from maintbranch (must revisit 1014 later, is

incomplete)

p4raw-link: @1015 on //depot/maint-5.004/perl: 64d1d4c7d00380b54e18db9c0a16ddef0f41b0a2

p4raw-id: //depot/win32/perl@1029

6 files changed, 36 insertions, 15 deletions

diff --git a/embed.h b/embed.h
index f26f1dd0c5..83e8638118 100644
--- a/embed.h
+++ b/embed.h
@@ -437,6 +437,7 @@
 #define oopsAV			Perl_oopsAV
 #define oopsCV			Perl_oopsCV
 #define oopsHV			Perl_oopsHV
+#define op_const_sv		Perl_op_const_sv
 #define op_desc			Perl_op_desc
 #define op_free			Perl_op_free
 #define op_name			Perl_op_name
diff --git a/global.sym b/global.sym
index ca97714ee9..a04b35045c 100644
--- a/global.sym
+++ b/global.sym
@@ -72,6 +72,7 @@ nomem
 nomethod_amg
 not_amg
 numer_amg
+op_const_sv
 op_desc
 op_name
 opargs
diff --git a/op.c b/op.c
index d08f2ff91b..1fbafc768f 100644
--- a/op.c
+++ b/op.c
@@ -3314,16 +3314,27 @@ cv_ckproto(CV *cv, GV *gv, char *p)
 SV *
 cv_const_sv(CV *cv)
 {
-    OP *o;
-    SV *sv;
-
     if (!cv || !SvPOK(cv) || SvCUR(cv))
 	return Nullsv;
+    return op_const_sv(CvSTART(cv), cv);
+}
+
+SV *
+op_const_sv(OP *o, CV *cv)
+{
+    SV *sv = Nullsv;
+
+    if(!o)
+	return Nullsv;
+ 
+    if(o->op_type == OP_LINESEQ && cLISTOPo->op_first) 
+	o = cLISTOPo->op_first->op_sibling;
 
-    sv = Nullsv;
-    for (o = CvSTART(cv); o; o = o->op_next) {
+    for (; o; o = o->op_next) {
 	OPCODE type = o->op_type;
-	
+
+	if(sv && o->op_next == o) 
+	    return sv;
 	if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
 	    continue;
 	if (type == OP_LEAVESUB || type == OP_RETURN)
@@ -3332,7 +3343,7 @@ cv_const_sv(CV *cv)
 	    return Nullsv;
 	if (type == OP_CONST)
 	    sv = cSVOPo->op_sv;
-	else if (type == OP_PADSV) {
+	else if (type == OP_PADSV && cv) {
 	    AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
 	    sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
 	    if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
@@ -3386,6 +3397,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 	/* already defined (or promised)? */
 	if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
 	    SV* const_sv;
+	    bool const_changed = TRUE;
 	    if (!block) {
 		/* just a "sub foo;" when &foo is already defined */
 		SAVEFREESV(compcv);
@@ -3394,8 +3406,9 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 	    /* ahem, death to those who redefine active sort subs */
 	    if (curstackinfo->si_type == SI_SORT && sortcop == CvSTART(cv))
 		croak("Can't redefine active sort subroutine %s", name);
-	    const_sv = cv_const_sv(cv);
-	    if (const_sv || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
+	    if(const_sv = cv_const_sv(cv))
+		const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
+	    if ((const_sv && const_changed) || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
 					&& HvNAME(GvSTASH(CvGV(cv)))
 					&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
 						 "autouse"))) {
diff --git a/pp.c b/pp.c
index bd5fd38e7e..4619b29748 100644
--- a/pp.c
+++ b/pp.c
@@ -773,7 +773,7 @@ PP(pp_undef)
 	hv_undef((HV*)sv);
 	break;
     case SVt_PVCV:
-	if (cv_const_sv((CV*)sv))
+	if (dowarn && cv_const_sv((CV*)sv))
 	    warn("Constant subroutine %s undefined",
 		 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
 	/* FALL THROUGH */
diff --git a/proto.h b/proto.h
index a689fe0987..526f8cb689 100644
--- a/proto.h
+++ b/proto.h
@@ -65,6 +65,7 @@ void	croak _((const char* pat,...)) __attribute__((noreturn));
 void	cv_ckproto _((CV* cv, GV* gv, char* p));
 CV*	cv_clone _((CV* proto));
 SV*	cv_const_sv _((CV* cv));
+SV*	op_const_sv _((OP* o, CV* cv));
 void	cv_undef _((CV* cv));
 #ifdef DEBUGGING
 void	cx_dump _((PERL_CONTEXT* cs));
diff --git a/sv.c b/sv.c
index 68ebd54ca6..71ad3d85ae 100644
--- a/sv.c
+++ b/sv.c
@@ -2071,6 +2071,12 @@ sv_setsv(SV *dstr, register SV *sstr)
 			    if (!GvCVGEN((GV*)dstr) &&
 				(CvROOT(cv) || CvXSUB(cv)))
 			    {
+				SV *const_sv = cv_const_sv(cv);
+				bool const_changed = TRUE; 
+				if(const_sv)
+				    const_changed = sv_cmp(const_sv, 
+					   op_const_sv(CvSTART((CV*)sref), 
+						       Nullcv));
 				/* ahem, death to those who redefine
 				 * active sort subs */
 				if (curstackinfo->si_type == SI_SORT &&
@@ -2078,15 +2084,14 @@ sv_setsv(SV *dstr, register SV *sstr)
 				    croak(
 				    "Can't redefine active sort subroutine %s",
 					  GvENAME((GV*)dstr));
-				if (cv_const_sv(cv))
-				    warn("Constant subroutine %s redefined",
-					 GvENAME((GV*)dstr));
-				else if (dowarn) {
+				if (dowarn || (const_changed && const_sv)) {
 				    if (!(CvGV(cv) && GvSTASH(CvGV(cv))
 					  && HvNAME(GvSTASH(CvGV(cv)))
 					  && strEQ(HvNAME(GvSTASH(CvGV(cv))),
 						   "autouse")))
-					warn("Subroutine %s redefined",
+					warn(const_sv ? 
+					     "Constant subroutine %s redefined"
+					     : "Subroutine %s redefined", 
 					     GvENAME((GV*)dstr));
 				}
 			    }