This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
And silence some silly examples.
authorMax Maischein <corion@corion.net>
Fri, 25 Oct 2019 18:20:56 +0000 (20:20 +0200)
committerMax Maischein <github@corion.net>
Sun, 3 Nov 2019 19:39:47 +0000 (20:39 +0100)
From RT88754

Adapted to the current Perl by Max Maischein

Created from https://github.com/Perl/perl5/issues/11259

gv.c
pod/perldiag.pod
t/lib/warnings/gv

diff --git a/gv.c b/gv.c
index 3cb182e..1a49d5e 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -713,6 +713,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
     CV* cand_cv = NULL;
     GV* topgv = NULL;
     const char *hvname;
+    STRLEN hvnamelen;
     I32 create = (level >= 0) ? HV_FETCH_LVALUE : 0;
     I32 items;
     U32 topgen_cmp;
@@ -728,6 +729,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
     assert(stash);
 
     hvname = HvNAME_get(stash);
+    hvnamelen = HvNAMELEN_get(stash);
     if (!hvname)
       Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
 
@@ -797,10 +799,30 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len,
         cstash = gv_stashsv(linear_sv, 0);
 
         if (!cstash) {
-           Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
-                           "Can't locate package %" SVf " for @%" HEKf "::ISA",
-                          SVfARG(linear_sv),
-                           HEKfARG(HvNAME_HEK(stash)));
+            if ( ckWARN(WARN_SYNTAX)) {
+                if(     /* these are loaded from Perl_Gv_AMupdate() one way or another */
+                           ( len    && name[0] == '(' )  /* overload.pm related, in particular "()" */
+                        || ( memEQs( name, len, "DESTROY") )
+                ) {
+                     Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                            "Can't locate package %" SVf " for @%" HEKf "::ISA",
+                            SVfARG(linear_sv),
+                            HEKfARG(HvNAME_HEK(stash)));
+
+                } else if( memEQs( name, len, "AUTOLOAD") ) {
+                    /* gobble this warning */
+                } else {
+                    Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
+                        "While trying to resolve method call %.*s->%.*s()"
+                        " can not locate package \"%"SVf"\" yet it is mentioned in @%.*s::ISA"
+                         " (perhaps you forgot to load \"%"SVf"\"?)",
+                         hvnamelen, hvname,
+                         len, name,
+                        SVfARG(linear_sv),
+                         hvnamelen, hvname,
+                         SVfARG(linear_sv));
+                }
+            }
             continue;
         }
 
index 820c5d9..bfcc61e 100644 (file)
@@ -7729,6 +7729,18 @@ can be determined from the template alone.  This is not possible if
 it contains any of the codes @, /, U, u, w or a *-length.  Redesign
 the template.
 
+=item While trying to resolve method call %s->%s() can not locate package "%s" yet it is mentioned in @%s::ISA (perhaps you forgot to load "%s"?)
+
+(W syntax) It is possible that the @ISA contains a misspelled or never loaded
+package name, which can result in perl choosing an unexpected parent
+classes method to resolve the method call. If this is deliberate you
+can do something like
+
+  @Missing::Package::ISA = ();
+
+to silence the warnings, otherwise you should correct the package name, or
+ensure that the package is loaded prior to the method call.
+
 =item %s() with negative argument
 
 (S misc) Certain operations make no sense with negative arguments.
index 2a2dcf4..2caf2d3 100644 (file)
@@ -16,7 +16,6 @@ __END__
 use warnings 'syntax' ;
 @ISA = qw(Fred); joe()
 EXPECT
-Can't locate package Fred for @main::ISA at - line 3.
 Undefined subroutine &main::joe called at - line 3.
 ########
 # gv.c
@@ -26,6 +25,86 @@ EXPECT
 Undefined subroutine &main::joe called at - line 3.
 ########
 # gv.c
+use warnings 'syntax' ;
+@ISA = qw(Fred); __PACKAGE__->joe()
+EXPECT
+While trying to resolve method call main->joe() can not locate package "Fred" yet it is mentioned in @main::ISA (perhaps you forgot to load "Fred"?) at - line 3.
+Can't locate object method "joe" via package "main" at - line 3.
+########
+# gv.c
+no warnings 'syntax' ;
+@ISA = qw(Fred); __PACKAGE__->joe()
+EXPECT
+Can't locate object method "joe" via package "main" at - line 3.
+########
+# gv.c
+use warnings 'syntax' ;
+{
+    package AA;    # this is a deliberate error
+#   package A;     # should be this
+    sub foo {
+       print STDERR "I'm in A's foo\n";
+    }
+}
+{
+   package B;
+   sub foo {
+       print STDERR "I'm in B's foo\n";
+   }
+}
+@C::ISA = qw(A B);
+$a = bless [], 'C';
+$a->foo();
+__END__
+EXPECT
+While trying to resolve method call C->foo() can not locate package "A" yet it is mentioned in @C::ISA (perhaps you forgot to load "A"?) at - line 18.
+I'm in B's foo
+########
+# gv.c
+no warnings 'syntax' ;
+{
+    package AA;    # this is a deliberate error
+#   package A;     # should be this
+    sub foo {
+       print STDERR "I'm in A's foo\n";
+    }
+}
+{
+   package B;
+   sub foo {
+       print STDERR "I'm in B's foo\n";
+   }
+}
+@C::ISA = qw(A B);
+$a = bless [], 'C';
+$a->foo();
+__END__
+EXPECT
+I'm in B's foo
+########
+# gv.c
+use warnings 'syntax' ;
+{
+#   package AA;    # this would be an error
+    package A;     # the right thing
+    sub foo {
+       print STDERR "I'm in A's foo\n";
+    }
+}
+{
+   package B;
+   sub foo {
+       print STDERR "I'm in B's foo\n";
+   }
+}
+@C::ISA = qw(A B);
+$a = bless [], 'C';
+$a->foo();
+__END__
+EXPECT
+I'm in A's foo
+########
+# gv.c
 $a = ${^ENCODING};
 $a = ${^E_NCODING};
 ${^E_NCODING} = 1; # We pretend this variable never existed.
@@ -38,7 +117,6 @@ use open qw( :utf8 :std );
 package Y;
 @ISA = qw(Fred); joe()
 EXPECT
-Can't locate package Fred for @Y::ISA at - line 6.
 Undefined subroutine &Y::joe called at - line 6.
 ########
 # gv.c