From e74b230db7213736da92dc99ebd55d8f6500095f Mon Sep 17 00:00:00 2001 From: Doug MacEachern Date: Sun, 25 Jun 2000 05:11:28 -0700 Subject: [PATCH] Re: [PATCH] "Constant subroutine redefined" mandatory warning Message-ID: (one part of the patch had been applied earlier) p4raw-id: //depot/cfgperl@6257 --- op.c | 13 ++++++------- sv.c | 4 ++-- t/pragma/constant.t | 3 ++- t/pragma/warn/op | 14 ++++++++++++++ 4 files changed, 24 insertions(+), 10 deletions(-) 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 = . -- 2.7.4