This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Now that proxy subroutines can be unproxied in 2 places without
authorNicholas Clark <nick@ccl4.org>
Fri, 23 Dec 2005 11:36:43 +0000 (11:36 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 23 Dec 2005 11:36:43 +0000 (11:36 +0000)
becoming the same newCONSTSUB, need an explicit check to avoid a
warning about subroutines being redefined, as there has never been
a warning when you assing the same subroutine to a glob's GvCV()

p4raw-id: //depot/perl@26470

sv.c
t/op/gv.t

diff --git a/sv.c b/sv.c
index 00261cd..1ad6636 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3144,7 +3144,18 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                            {
                                /* Redefining a sub - warning is mandatory if
                                   it was a const and its value changed. */
-                               if (ckWARN(WARN_REDEFINE)
+                               if (CvCONST(cv) && CvCONST((CV*)sref)
+                                   && cv_const_sv(cv)
+                                   == cv_const_sv((CV*)sref)) {
+                                   /* 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)
                                    || (CvCONST(cv)
                                        && (!CvCONST((CV*)sref)
                                            || sv_cmp(cv_const_sv(cv),
index aa9383f..cf4108a 100755 (executable)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -371,8 +371,7 @@ my $gr = eval '\*plunk' or die;
   my $w = '';
   local $SIG{__WARN__} = sub { $w = $_[0] };
   $result = *{$gr} = \&{"oonk"};
-  like($w, qr/^Constant subroutine main::plunk redefined/,
-       "Redefining a constant sub should warn");
+  is($w, '', "Redefining a constant sub to another constant sub with the same underlying value should not warn (It's just re-exporting, and that was always legal)");
 }
 
 is (ref $::{oonk}, 'SCALAR', "Export doesn't affect original");