[perl #105922] Allow any string before ->meth

The rules for filtering out what do not look like package names are
not logical and disallow valid things like "::main", while allowing
q"_#@*$!@*^(".

This commit simply lets any non-empty string be used as a package
name.  If it is a typo, you’ll get an error anyway.  This allows
autobox-style calls like "3foo"->CORE::uc, or even "3foo"->uc if you
set up @isa first.

I made an exception for the empty string because it messes up caches
somehow and causes subsequent method calls all to be called on the
main package.  I haven’t looked into that yet.  I don’t know whether
it’s worth it.

The changes to the tests in cpan/Test-Simple have been submit-
ted upstream.

Author: Father Chrysostomos

cpan/Test-Simple/t/fail-more.t

@@ -248,22 +248,22 @@ ERR
 
 #line 248
 isa_ok(42,    "Wibble", "My Wibble");
-out_ok( <<OUT, <<ERR );
+out_like( <<OUT, <<ERR );
 not ok - My Wibble isa Wibble
 OUT
 #   Failed test 'My Wibble isa Wibble'
 #   at $0 line 248.
-#     My Wibble isn't a class or reference
+#     My Wibble isn't a .*
 ERR
 
 #line 248
 isa_ok(42,    "Wibble");
-out_ok( <<OUT, <<ERR );
-not ok - The thing isa Wibble
+out_like( <<OUT, <<ERR );
+not ok - The (thing|class) isa Wibble
 OUT
-#   Failed test 'The thing isa Wibble'
+#   Failed test 'The (thing|class) isa Wibble'
 #   at $0 line 248.
-#     The thing isn't a class or reference
+#     The (thing|class) isn't a .*
 ERR
 
 #line 258

pp_hot.c

@@ -2956,12 +2956,14 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
     PERL_ARGS_ASSERT_METHOD_COMMON;
 
     if (!sv)
+       undefined:
 	Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on an undefined value",
 		   SVfARG(meth));
 
     SvGETMAGIC(sv);
     if (SvROK(sv))
 	ob = MUTABLE_SV(SvRV(sv));
+    else if (!SvOK(sv)) goto undefined;
     else {
 	GV* iogv;
         STRLEN packlen;
@@ -2990,17 +2992,11 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	    !(ob=MUTABLE_SV(GvIO(iogv))))
 	{
 	    /* this isn't the name of a filehandle either */
-	    if (!packname ||
-		((UTF8_IS_START(*packname) && DO_UTF8(sv))
-		    ? !isIDFIRST_utf8((U8*)packname)
-		    : !isIDFIRST_L1((U8)*packname)
-		))
+	    if (!packname || !packlen)
 	    {
-		/* diag_listed_as: Can't call method "%s" without a package or object reference */
-		Perl_croak(aTHX_ "Can't call method \"%"SVf"\" %s",
-			   SVfARG(meth),
-			   SvOK(sv) ? "without a package or object reference"
-				    : "on an undefined value");
+		Perl_croak(aTHX_ "Can't call method \"%"SVf"\" "
+				 "without a package or object reference",
+				  SVfARG(meth));
 	    }
 	    /* assume it's a package name */
 	    stash = gv_stashpvn(packname, packlen, packname_is_utf8 ? SVf_UTF8 : 0);

t/op/method.t

@@ -13,7 +13,7 @@ BEGIN {
 use strict;
 no warnings 'once';
 
-plan(tests => 111);
+plan(tests => 116);
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -477,3 +477,15 @@ package egakacp {
 @SUPER::ISA = "SUPPER";
 sub SUPPER::foo { "supper" }
 is "SUPER"->foo, 'supper', 'SUPER->method';
+
+sub flomp { "flimp" }
+sub main::::flomp { "flump" }
+is "::"->flomp, 'flump', 'method call on ::';
+is "::main"->flomp, 'flimp', 'method call on ::main';
+eval { ""->flomp };
+like $@,
+     qr/^Can't call method "flomp" without a package or object reference/,
+    'method call on empty string';
+is "3foo"->CORE::uc, '3FOO', '"3foo"->CORE::uc';
+{ no strict; @{"3foo::ISA"} = "CORE"; }
+is "3foo"->uc, '3FOO', '"3foo"->uc (autobox style!)';

t/run/fresh_perl.t

@@ -81,7 +81,7 @@ $array[128]=1
 ########
 $x=0x0eabcd; print $x->ref;
 EXPECT
-Can't call method "ref" without a package or object reference at - line 1.
+Can't locate object method "ref" via package "961485" (perhaps you forgot to load "961485"?) at - line 1.
 ########
 chop ($str .= <DATA>);
 ########