emit require module name err hint only when valid

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 ...

2 files changed, 140 insertions, 16 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 69280e2942..e75e151f81 100644
--- 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?)");
diff --git a/t/op/require_errors.t b/t/op/require_errors.t
index 14d93e25dd..2226c97130 100644
--- a/t/op/require_errors.t
+++ b/t/op/require_errors.t
@@ -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";