diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-11-21 21:57:21 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-11-21 21:57:58 -0800 |
commit | 156d738fbb36dec69a83032866786dd3b6a1c2e9 (patch) | |
tree | a538f4a9441b726a96c027a37101201d0758ba12 /sv.c | |
parent | 971c5244800c9017603979e4f5202b8e5e374b62 (diff) | |
download | perl-156d738fbb36dec69a83032866786dd3b6a1c2e9.tar.gz |
Put sub redef warnings in one place
The logic surrounding subroutine redefinition warnings (to warn or not
to warn?) was in three places. Over time, they drifted apart, to the
point that newXS was following completely different rules. It was
only warning for redefinition of functions in the autouse namespace.
Recent commits have brought it into conformity with the other redefi-
nition warnings.
Obviously it’s about time we put it in one function.
Diffstat (limited to 'sv.c')
-rw-r--r-- | sv.c | 54 |
1 files changed, 16 insertions, 38 deletions
@@ -3808,48 +3808,26 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr) CV* const cv = MUTABLE_CV(*location); if (cv) { if (!GvCVGEN((const GV *)dstr) && - (CvROOT(cv) || CvXSUB(cv))) + (CvROOT(cv) || CvXSUB(cv)) && + /* redundant check that avoids creating the extra SV + most of the time: */ + (CvCONST(cv) || ckWARN(WARN_REDEFINE))) { - const char *hvname; - /* Redefining a sub - warning is mandatory if - it was a const and its value changed. */ - if (CvCONST(cv) && CvCONST((const CV *)sref) - && cv_const_sv(cv) - == cv_const_sv((const CV *)sref)) { - NOOP; - /* They are 2 constant subroutines generated from - the same constant. This probably means that - they are really the "same" proxy subroutine - instantiated in 2 places. Most likely this is - when a constant is exported twice. Don't warn. - */ - } - else if ((ckWARN(WARN_REDEFINE) - && !( - CvGV(cv) && GvSTASH(CvGV(cv)) && - HvNAMELEN(GvSTASH(CvGV(cv))) == 7 && - (hvname = HvNAME(GvSTASH(CvGV(cv))), - strEQ(hvname, "autouse")) - ) - ) - || (CvCONST(cv) - && ckWARN_d(WARN_REDEFINE) - && (!CvCONST((const CV *)sref) - || sv_cmp(cv_const_sv(cv), - cv_const_sv((const CV *) - sref))))) { - Perl_warner(aTHX_ packWARN(WARN_REDEFINE), - (const char *) - (CvCONST(cv) - ? "Constant subroutine %"HEKf - "::%"HEKf" redefined" - : "Subroutine %"HEKf"::%"HEKf - " redefined"), + SV * const new_const_sv = + CvCONST((const CV *)sref) + ? cv_const_sv((const CV *)sref) + : NULL; + report_redefined_cv( + sv_2mortal(newSVpvf( + "%"HEKf"::%"HEKf, HEKfARG( HvNAME_HEK(GvSTASH((const GV *)dstr)) ), - HEKfARG(GvENAME_HEK(MUTABLE_GV(dstr)))); - } + HEKfARG(GvENAME_HEK(MUTABLE_GV(dstr))) + )), + cv, + CvCONST((const CV *)sref) ? &new_const_sv : NULL + ); } if (!intro) cv_ckproto_len_flags(cv, (const GV *)dstr, |