This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
op.c: croak on "my $_" when "use utf8" is in effect
authorTomasz Konojacki <me@xenu.pl>
Wed, 30 Dec 2020 13:03:02 +0000 (14:03 +0100)
committerKarl Williamson <khw@cpan.org>
Wed, 30 Dec 2020 14:29:22 +0000 (07:29 -0700)
Fixes #18449

op.c
t/op/mydef.t

diff --git a/op.c b/op.c
index b2e12dd..dce844d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -730,6 +730,7 @@ PADOFFSET
 Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 {
     PADOFFSET off;
+    bool is_idfirst, is_default;
     const bool is_our = (PL_parser->in_my == KEY_our);
 
     PERL_ARGS_ASSERT_ALLOCMY;
@@ -738,14 +739,15 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
        Perl_croak(aTHX_ "panic: allocmy illegal flag bits 0x%" UVxf,
                   (UV)flags);
 
+    is_idfirst = flags & SVf_UTF8
+        ? isIDFIRST_utf8_safe((U8*)name + 1, name + len)
+        : isIDFIRST_A(name[1]);
+
+    /* $_, @_, etc. */
+    is_default = len == 2 && name[1] == '_';
+
     /* complain about "my $<special_var>" etc etc */
-    if (   len
-        && !(  is_our
-            || isALPHA(name[1])
-            || (   (flags & SVf_UTF8)
-                && isIDFIRST_utf8_safe((U8 *)name+1, name + len))
-            || (name[1] == '_' && len > 2)))
-    {
+    if (!is_our && (!is_idfirst || is_default)) {
         const char * const type =
               PL_parser->in_my == KEY_sigvar ? "subroutine signature" :
               PL_parser->in_my == KEY_state  ? "\"state\""     : "\"my\"";
index 42a81d9..225ce98 100644 (file)
@@ -6,10 +6,17 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan tests => 1;
-
 use strict;
 
 eval 'my $_';
 like $@, qr/^Can't use global \$_ in "my" at /;
 
+{
+    # using utf8 allows $_ to be declared with 'my'
+    # GH #18449
+    use utf8;
+    eval 'my $_;';
+    like $@, qr/^Can't use global \$_ in "my" at /;
+}
+
+done_testing;