From: Doug MacEachern <dougm@covalent.net>
Date: Sun, 25 Jun 2000 12:11:28 +0000 (-0700)
Subject: Re: [PATCH] "Constant subroutine redefined" mandatory warning
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e74b230db7213736da92dc99ebd55d8f6500095f;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH] "Constant subroutine redefined" mandatory warning
Message-ID: <Pine.LNX.4.10.10006251209191.461-100000@mojo.covalent.net>
(one part of the patch had been applied earlier)

p4raw-id: //depot/cfgperl@6257
---

diff --git a/op.c b/op.c
index fb060d3..3f71cfa 100644
--- a/op.c
+++ b/op.c
@@ -2574,6 +2574,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     complement	= o->op_private & OPpTRANS_COMPLEMENT;
     del		= o->op_private & OPpTRANS_DELETE;
     squash	= o->op_private & OPpTRANS_SQUASH;
+    
+    if (SvUTF8(tstr))
+        o->op_private |= OPpTRANS_FROM_UTF;
+    
+    if (SvUTF8(rstr)) 
+        o->op_private |= OPpTRANS_TO_UTF;
 
     if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
 	SV* listsv = newSVpvn("# comment\n",10);
@@ -2645,16 +2651,9 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	    r = t; rlen = tlen; rend = tend;
 	}
 	if (!squash) {
-	    if (to_utf && from_utf) {	/* only counting characters */
 		if (t == r ||
 		    (tlen == rlen && memEQ((char *)t, (char *)r, tlen)))
 		    o->op_private |= OPpTRANS_IDENTICAL;
-	    }
-	    else {	/* straight latin-1 translation */
-		if (tlen == 4 && memEQ((char *)t, "\0\377\303\277", 4) &&
-		    rlen == 4 && memEQ((char *)r, "\0\377\303\277", 4))
-		    o->op_private |= OPpTRANS_IDENTICAL;
-	    }
 	}
 
 	while (t < tend || tfirst <= tlast) {
diff --git a/sv.c b/sv.c
index a9303d0..69607e6 100644
--- a/sv.c
+++ b/sv.c
@@ -2670,7 +2670,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 				if(const_sv)
 				    const_changed = sv_cmp(const_sv, 
 					   op_const_sv(CvSTART((CV*)sref), 
-						       Nullcv));
+						       (CV*)sref));
 				/* ahem, death to those who redefine
 				 * active sort subs */
 				if (PL_curstackinfo->si_type == PERLSI_SORT &&
@@ -2678,7 +2678,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 				    Perl_croak(aTHX_ 
 				    "Can't redefine active sort subroutine %s",
 					  GvENAME((GV*)dstr));
-				if ((const_changed || const_sv) && ckWARN(WARN_REDEFINE))
+				if ((const_changed && const_sv) || ckWARN(WARN_REDEFINE))
 				    Perl_warner(aTHX_ WARN_REDEFINE, const_sv ? 
 					     "Constant subroutine %s redefined"
 					     : "Subroutine %s redefined", 
diff --git a/t/pragma/constant.t b/t/pragma/constant.t
index 6438332..dde64ce 100755
--- a/t/pragma/constant.t
+++ b/t/pragma/constant.t
@@ -212,8 +212,9 @@ eval q{
     use constant 'SIG' => 1 ;
 };
 
-test 59, @warnings == 14 ;
+test 59, @warnings == 15 ;
 test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/;
+shift @warnings; #Constant subroutine BEGIN redefined at
 test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/;
 test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/;
 test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/;
diff --git a/t/pragma/warn/op b/t/pragma/warn/op
index 2c9e0fd..7368275 100644
--- a/t/pragma/warn/op
+++ b/t/pragma/warn/op
@@ -716,6 +716,20 @@ EXPECT
 Constant subroutine fred redefined at - line 4.
 ########
 # op.c
+no warnings 'redefine' ;
+sub fred () { 1 }
+sub fred () { 2 }
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
+no warnings 'redefine' ;
+sub fred () { 1 }
+*fred = sub () { 2 };
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
 use warnings 'redefine' ;
 format FRED =
 .