|
 |
b2938d |
From 07319fdbb283f93cb655c3106b5237cbc7272038 Mon Sep 17 00:00:00 2001
|
|
|
b2938d |
From: Tomasz Konojacki <me@xenu.pl>
|
|
|
b2938d |
Date: Wed, 30 Dec 2020 14:03:02 +0100
|
|
|
b2938d |
Subject: [PATCH] op.c: croak on "my $_" when "use utf8" is in effect
|
|
|
b2938d |
MIME-Version: 1.0
|
|
|
b2938d |
Content-Type: text/plain; charset=UTF-8
|
|
|
b2938d |
Content-Transfer-Encoding: 8bit
|
|
|
b2938d |
|
|
|
b2938d |
Fixes #18449
|
|
|
b2938d |
|
|
|
b2938d |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
b2938d |
---
|
|
|
b2938d |
op.c | 16 +++++++++-------
|
|
|
b2938d |
t/op/mydef.t | 11 +++++++++--
|
|
|
b2938d |
2 files changed, 18 insertions(+), 9 deletions(-)
|
|
|
b2938d |
|
|
|
b2938d |
diff --git a/op.c b/op.c
|
|
|
b2938d |
index b2e12dd0c0..dce844d297 100644
|
|
|
b2938d |
--- a/op.c
|
|
|
b2938d |
+++ b/op.c
|
|
|
b2938d |
@@ -730,6 +730,7 @@ PADOFFSET
|
|
|
b2938d |
Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
|
|
|
b2938d |
{
|
|
|
b2938d |
PADOFFSET off;
|
|
|
b2938d |
+ bool is_idfirst, is_default;
|
|
|
b2938d |
const bool is_our = (PL_parser->in_my == KEY_our);
|
|
|
b2938d |
|
|
|
b2938d |
PERL_ARGS_ASSERT_ALLOCMY;
|
|
|
b2938d |
@@ -738,14 +739,15 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
|
|
|
b2938d |
Perl_croak(aTHX_ "panic: allocmy illegal flag bits 0x%" UVxf,
|
|
|
b2938d |
(UV)flags);
|
|
|
b2938d |
|
|
|
b2938d |
+ is_idfirst = flags & SVf_UTF8
|
|
|
b2938d |
+ ? isIDFIRST_utf8_safe((U8*)name + 1, name + len)
|
|
|
b2938d |
+ : isIDFIRST_A(name[1]);
|
|
|
b2938d |
+
|
|
|
b2938d |
+ /* $_, @_, etc. */
|
|
|
b2938d |
+ is_default = len == 2 && name[1] == '_';
|
|
|
b2938d |
+
|
|
|
b2938d |
/* complain about "my $<special_var>" etc etc */
|
|
|
b2938d |
- if ( len
|
|
|
b2938d |
- && !( is_our
|
|
|
b2938d |
- || isALPHA(name[1])
|
|
|
b2938d |
- || ( (flags & SVf_UTF8)
|
|
|
b2938d |
- && isIDFIRST_utf8_safe((U8 *)name+1, name + len))
|
|
|
b2938d |
- || (name[1] == '_' && len > 2)))
|
|
|
b2938d |
- {
|
|
|
b2938d |
+ if (!is_our && (!is_idfirst || is_default)) {
|
|
|
b2938d |
const char * const type =
|
|
|
b2938d |
PL_parser->in_my == KEY_sigvar ? "subroutine signature" :
|
|
|
b2938d |
PL_parser->in_my == KEY_state ? "\"state\"" : "\"my\"";
|
|
|
b2938d |
diff --git a/t/op/mydef.t b/t/op/mydef.t
|
|
|
b2938d |
index 42a81d9ab0..225ce98e51 100644
|
|
|
b2938d |
--- a/t/op/mydef.t
|
|
|
b2938d |
+++ b/t/op/mydef.t
|
|
|
b2938d |
@@ -6,10 +6,17 @@ BEGIN {
|
|
|
b2938d |
set_up_inc('../lib');
|
|
|
b2938d |
}
|
|
|
b2938d |
|
|
|
b2938d |
-plan tests => 1;
|
|
|
b2938d |
-
|
|
|
b2938d |
use strict;
|
|
|
b2938d |
|
|
|
b2938d |
eval 'my $_';
|
|
|
b2938d |
like $@, qr/^Can't use global \$_ in "my" at /;
|
|
|
b2938d |
|
|
|
b2938d |
+{
|
|
|
b2938d |
+ # using utf8 allows $_ to be declared with 'my'
|
|
|
b2938d |
+ # GH #18449
|
|
|
b2938d |
+ use utf8;
|
|
|
b2938d |
+ eval 'my $_;';
|
|
|
b2938d |
+ like $@, qr/^Can't use global \$_ in "my" at /;
|
|
|
b2938d |
+}
|
|
|
b2938d |
+
|
|
|
b2938d |
+done_testing;
|
|
|
b2938d |
--
|
|
|
b2938d |
2.26.2
|
|
|
b2938d |
|