This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
emit require module name err hint only when valid
authorDavid Mitchell <davem@iabyn.com>
Sun, 16 Apr 2017 08:50:04 +0000 (09:50 +0100)
committerDavid Mitchell <davem@iabyn.com>
Tue, 18 Apr 2017 11:58:32 +0000 (12:58 +0100)
RT #131098

The helpful "you may need to install" hint which 'require' sometimes
includes in its error message these days (split across multiple lines for
clarity):

    $ perl -e'require Foo::Bar'
    Can't locate Foo/Bar.pm in @INC
        (you may need to install the Foo::Bar module)
        (@INC contains: ... ) at ...

is a bit over-enthusiastic when the pathname hasn't actually been derived
from a module name:

    $ perl -e'require "Foo.+/%#Bar.pm"'
    Can't locate Foo.+%#Bar.pm in @INC
        (you may need to install the Foo.+::%#Bar module)
        (@INC contains: ... ) at ...

This commit changes things so that the hint message is only emitted if the
reverse-mapped module name is legal as a bareword:

    $ perl -e'require "Foo.+/%#Bar.pm"'
    Can't locate Foo.+%#Bar.pm in @INC
        (@INC contains: ... ) at ...

pp_ctl.c
t/op/require_errors.t

index 69280e2..e75e151 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4101,22 +4101,52 @@ S_require_file(pTHX_ SV *sv)
                    SSize_t i;
                    SV *const msg = newSVpvs_flags("", SVs_TEMP);
                    SV *const inc = newSVpvs_flags("", SVs_TEMP);
+                    const char *e = name + len - 3; /* possible .pm */
                    for (i = 0; i <= AvFILL(ar); i++) {
                        sv_catpvs(inc, " ");
                        sv_catsv(inc, *av_fetch(ar, i, TRUE));
                    }
-                   if (len >= 4 && memEQ(name + len - 3, ".pm", 4)) {
-                       const char *c, *e = name + len - 3;
-                       sv_catpv(msg, " (you may need to install the ");
-                       for (c = name; c < e; c++) {
-                           if (*c == '/') {
-                               sv_catpvs(msg, "::");
-                           }
-                           else {
-                               sv_catpvn(msg, c, 1);
-                           }
-                       }
-                       sv_catpv(msg, " module)");
+                   if (e > name && _memEQs(e, ".pm")) {
+                       const char *c;
+                        bool utf8 = cBOOL(SvUTF8(sv));
+
+                        /* if the filename, when converted from "Foo/Bar.pm"
+                         * form back to Foo::Bar form, makes a valid
+                         * package name (i.e. parseable by C<require
+                         * Foo::Bar>), then emit a hint.
+                         *
+                         * this loop is modelled after the one in
+                         S_parse_ident */
+                       c = name;
+                        while (c < e) {
+                            if (utf8 && isIDFIRST_utf8_safe(c, e)) {
+                                c += UTF8SKIP(c);
+                                while (c < e && isIDCONT_utf8_safe(
+                                            (const U8*) c, (const U8*) e))
+                                    c += UTF8SKIP(c);
+                            }
+                            else if (isWORDCHAR_A(*c)) {
+                                while (c < e && isWORDCHAR_A(*c))
+                                    c++;
+                            }
+                           else if (*c == '/')
+                                c++;
+                            else
+                                break;
+                        }
+
+                        if (c == e && isIDFIRST_lazy_if_safe(name, e, utf8)) {
+                            sv_catpv(msg, " (you may need to install the ");
+                            for (c = name; c < e; c++) {
+                                if (*c == '/') {
+                                    sv_catpvs(msg, "::");
+                                }
+                                else {
+                                    sv_catpvn(msg, c, 1);
+                                }
+                            }
+                            sv_catpv(msg, " module)");
+                        }
                    }
                    else if (len >= 2 && memEQ(name + len - 2, ".h", 3)) {
                        sv_catpv(msg, " (change .h to .ph maybe?) (did you run h2ph?)");
index 14d93e2..2226c97 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use warnings;
 
-plan(tests => 28);
+plan(tests => 54);
 
 my $nonfile = tempfile();
 
@@ -25,10 +25,104 @@ for my $file ($nonfile, ' ') {
        "correct error message for require '$file'";
 }
 
-eval "require $nonfile";
+# Check that the "(you may need to install..) hint is included in the
+# error message where (and only where) appropriate.
+#
+# Basically the hint should be issued for any filename where converting
+# back from Foo/Bar.pm to Foo::Bar gives you a legal bare word which could
+# follow "require" in source code.
+
+{
+
+    # may be any letter of an identifier
+    my $I = "\x{393}";  # "\N{GREEK CAPITAL LETTER GAMMA}"
+    # Continuation char: may only be 2nd+ letter of an identifier
+    my $C = "\x{387}";  # "\N{GREEK ANO TELEIA}"
+
+    for my $test_data (
+        # thing to require        pathname in err mesg     err includes hint?
+        [ "No::Such::Module1",          "No/Such/Module1.pm",       1 ],
+        [ "'No/Such/Module1.pm'",       "No/Such/Module1.pm",       1 ],
+        [ "_No::Such::Module1",         "_No/Such/Module1.pm",      1 ],
+        [ "'_No/Such/Module1.pm'",      "_No/Such/Module1.pm",      1 ],
+        [ "'No/Such./Module.pm'",       "No/Such./Module.pm",       0 ],
+        [ "No::1Such::Module",          "No/1Such/Module.pm",       1 ],
+        [ "'No/1Such/Module.pm'",       "No/1Such/Module.pm",       1 ],
+        [ "1No::Such::Module",           undef,                     0 ],
+        [ "'1No/Such/Module.pm'",       "1No/Such/Module.pm",       0 ],
+
+        # utf8 variants
+        [ "No::Such${I}::Module1",      "No/Such${I}/Module1.pm",   1 ],
+        [ "'No/Such${I}/Module1.pm'",   "No/Such${I}/Module1.pm",   1 ],
+        [ "_No::Such${I}::Module1",     "_No/Such${I}/Module1.pm",  1 ],
+        [ "'_No/Such${I}/Module1.pm'",  "_No/Such${I}/Module1.pm",  1 ],
+        [ "'No/Such${I}./Module.pm'",   "No/Such${I}./Module.pm",   0 ],
+        [ "No::1Such${I}::Module",      "No/1Such${I}/Module.pm",   1 ],
+        [ "'No/1Such${I}/Module.pm'",   "No/1Such${I}/Module.pm",   1 ],
+        [ "1No::Such${I}::Module",       undef,                     0 ],
+        [ "'1No/Such${I}/Module.pm'",   "1No/Such${I}/Module.pm",   0 ],
+
+        # utf8 with continuation char in 1st position
+        [ "No::${C}Such::Module1",      undef,                      0 ],
+        [ "'No/${C}Such/Module1.pm'",   "No/${C}Such/Module1.pm",   0 ],
+        [ "_No::${C}Such::Module1",     undef,                      0 ],
+        [ "'_No/${C}Such/Module1.pm'",  "_No/${C}Such/Module1.pm",  0 ],
+        [ "'No/${C}Such./Module.pm'",   "No/${C}Such./Module.pm",   0 ],
+        [ "No::${C}1Such::Module",      undef,                      0 ],
+        [ "'No/${C}1Such/Module.pm'",   "No/${C}1Such/Module.pm",   0 ],
+        [ "1No::${C}Such::Module",      undef,                      0 ],
+        [ "'1No/${C}Such/Module.pm'",   "1No/${C}Such/Module.pm",   0 ],
+
+    ) {
+        my ($require_arg, $err_path, $has_hint) = @$test_data;
+
+        my $exp;
+        if (defined $err_path) {
+            $exp = "Can't locate $err_path in \@INC";
+            if ($has_hint) {
+                my $hint = $err_path;
+                $hint =~ s{/}{::}g;
+                $hint =~ s/\.pm$//;
+                $exp .= " (you may need to install the $hint module)";
+            }
+            $exp .= " (\@INC contains: @INC) at";
+        }
+        else {
+            # undef implies a require which doesn't compile,
+            # rather than one which triggers a run-time error.
+            # We'll set exp to a suitable value later;
+            $exp = "";
+        }
+
+        my $err;
+        {
+            no warnings qw(syntax utf8);
+            if ($require_arg =~ /[^\x00-\xff]/) {
+                eval "require $require_arg";
+                $err = $@;
+                utf8::decode($err);
+            }
+            else {
+                eval "require $require_arg";
+                $err = $@;
+            }
+        }
+
+        for ($err, $exp, $require_arg) {
+            s/([^\x00-\xff])/sprintf"\\x{%x}",ord($1)/ge;
+        }
+        if (length $exp) {
+            $exp = qr/^\Q$exp\E/;
+        }
+        else {
+            $exp = qr/syntax error at|Unrecognized character/;
+        }
+        like $err, $exp,
+                "err for require $require_arg";
+    }
+}
+
 
-like $@, qr/^Can't locate $nonfile\.pm in \@INC \(you may need to install the $nonfile module\) \(\@INC contains: @INC\) at/,
-        "correct error message for require $nonfile";
 
 eval "require ::$nonfile";