mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 16:39:36 +00:00
Label UTF8 cleanup
This meant changing LABEL's definition in perly.y, so most of this commit is actually from the regened files.
This commit is contained in:
Brian Fraser
Father Chrysostomos
parent
70558906b0
commit
5db1eb8d3e
2
MANIFEST
2
MANIFEST
@ -3996,6 +3996,7 @@ ext/XS-APItest/t/keyword_multiline.t test keyword plugin parsing across lines
|
||||
ext/XS-APItest/t/keyword_plugin.t test keyword plugin mechanism
|
||||
ext/XS-APItest/t/labelconst.aux auxiliary file for label test
|
||||
ext/XS-APItest/t/labelconst.t test recursive descent label parsing
|
||||
ext/XS-APItest/t/labelconst_utf8.aux auxiliary file for label test in UTF-8
|
||||
ext/XS-APItest/t/loopblock.t test recursive descent block parsing
|
||||
ext/XS-APItest/t/looprest.t test recursive descent statement-sequence parsing
|
||||
ext/XS-APItest/t/lvalue.t Test XS lvalue functions
|
||||
@ -5492,6 +5493,7 @@ t/uni/fold.t See if Unicode folding works
|
||||
t/uni/goto.t See if Unicode goto &sub works
|
||||
t/uni/greek.t See if Unicode in greek works
|
||||
t/uni/gv.t See if Unicode GVs work.
|
||||
t/uni/labels.t See if Unicode labels work
|
||||
t/uni/latin2.t See if Unicode in latin2 works
|
||||
t/uni/lex_utf8.t See if Unicode in lexer works
|
||||
t/uni/lower.t See if Unicode casing works
|
||||
|
||||
4
cop.h
4
cop.h
@ -555,6 +555,8 @@ be zero.
|
||||
cophh_2hv(CopHINTHASH_get(cop), flags)
|
||||
|
||||
#define CopLABEL(c) Perl_cop_fetch_label(aTHX_ (c), NULL, NULL)
|
||||
#define CopLABEL_len(c,len) Perl_cop_fetch_label(aTHX_ (c), len, NULL)
|
||||
#define CopLABEL_len_flags(c,len,flags) Perl_cop_fetch_label(aTHX_ (c), len, flags)
|
||||
#define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
|
||||
|
||||
#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv))
|
||||
@ -779,6 +781,8 @@ struct block_loop {
|
||||
: (SV**)NULL)
|
||||
|
||||
#define CxLABEL(c) (0 + CopLABEL((c)->blk_oldcop))
|
||||
#define CxLABEL_len(c,len) (0 + CopLABEL_len((c)->blk_oldcop, len))
|
||||
#define CxLABEL_len_flags(c,len,flags) (0 + CopLABEL_len_flags((c)->blk_oldcop, len, flags))
|
||||
#define CxHASARGS(c) (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS)
|
||||
#define CxLVAL(c) (0 + (c)->blk_u16)
|
||||
|
||||
|
||||
@ -1841,12 +1841,13 @@ snR |char * |bytes_to_uni |NN const U8 *start|STRLEN len|NN char *dest
|
||||
|
||||
#if defined(PERL_IN_PP_CTL_C)
|
||||
sR |OP* |docatch |NULLOK OP *o
|
||||
sR |OP* |dofindlabel |NN OP *o|NN const char *label|NN OP **opstack|NN OP **oplimit
|
||||
sR |OP* |dofindlabel |NN OP *o|NN const char *label|STRLEN len \
|
||||
|U32 flags|NN OP **opstack|NN OP **oplimit
|
||||
s |MAGIC *|doparseform |NN SV *sv
|
||||
snR |bool |num_overflow |NV value|I32 fldsize|I32 frcsize
|
||||
sR |I32 |dopoptoeval |I32 startingblock
|
||||
sR |I32 |dopoptogiven |I32 startingblock
|
||||
sR |I32 |dopoptolabel |NN const char *label
|
||||
sR |I32 |dopoptolabel |NN const char *label|STRLEN len|U32 flags
|
||||
sR |I32 |dopoptoloop |I32 startingblock
|
||||
sR |I32 |dopoptosub_at |NN const PERL_CONTEXT* cxstk|I32 startingblock
|
||||
sR |I32 |dopoptowhen |I32 startingblock
|
||||
|
||||
4
embed.h
4
embed.h
@ -1468,11 +1468,11 @@
|
||||
#define do_smartmatch(a,b,c) S_do_smartmatch(aTHX_ a,b,c)
|
||||
#define docatch(a) S_docatch(aTHX_ a)
|
||||
#define doeval(a,b,c,d,e) S_doeval(aTHX_ a,b,c,d,e)
|
||||
#define dofindlabel(a,b,c,d) S_dofindlabel(aTHX_ a,b,c,d)
|
||||
#define dofindlabel(a,b,c,d,e,f) S_dofindlabel(aTHX_ a,b,c,d,e,f)
|
||||
#define doparseform(a) S_doparseform(aTHX_ a)
|
||||
#define dopoptoeval(a) S_dopoptoeval(aTHX_ a)
|
||||
#define dopoptogiven(a) S_dopoptogiven(aTHX_ a)
|
||||
#define dopoptolabel(a) S_dopoptolabel(aTHX_ a)
|
||||
#define dopoptolabel(a,b,c) S_dopoptolabel(aTHX_ a,b,c)
|
||||
#define dopoptoloop(a) S_dopoptoloop(aTHX_ a)
|
||||
#define dopoptosub_at(a,b) S_dopoptosub_at(aTHX_ a,b)
|
||||
#define dopoptowhen(a) S_dopoptowhen(aTHX_ a)
|
||||
|
||||
@ -891,7 +891,9 @@ static OP *THX_parse_keyword_swaplabel(pTHX)
|
||||
OP *sop = parse_barestmt(0);
|
||||
SV *label = parse_label(PARSE_OPTIONAL);
|
||||
if (label) sv_2mortal(label);
|
||||
return newSTATEOP(0, label ? savepv(SvPVX(label)) : NULL, sop);
|
||||
return newSTATEOP(label ? SvUTF8(label) : 0,
|
||||
label ? savepv(SvPVX(label)) : NULL,
|
||||
sop);
|
||||
}
|
||||
|
||||
#define parse_keyword_labelconst() THX_parse_keyword_labelconst(aTHX)
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More tests => 18;
|
||||
use Test::More tests => 32;
|
||||
|
||||
BEGIN { $^H |= 0x20000; }
|
||||
|
||||
@ -93,4 +93,79 @@ $t = do("t/labelconst.aux");
|
||||
is $@, "";
|
||||
is $t, "FOOBARBAZQUUX";
|
||||
|
||||
{
|
||||
use utf8;
|
||||
use open qw( :utf8 :std );
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(labelconst);
|
||||
$t .= "ㅏ";
|
||||
$t .= labelconst ᛒ:;
|
||||
$t .= "ḉ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏᛒḉ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(labelconst);
|
||||
$t .= "ㅏ";
|
||||
$t .= "ᛒ" . labelconst ＦǑǑ: . "ḉ";
|
||||
$t .= "ｄ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏᛒＦǑǑḉｄ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(labelconst);
|
||||
$t .= "ㅏ";
|
||||
$t .= labelconst ＦǑǑ :;
|
||||
$t .= "ᛒ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏＦǑǑᛒ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(labelconst);
|
||||
$t .= "ㅏ";
|
||||
$t .= labelconst Ｆ_1Ḅ:;
|
||||
$t .= "ᛒ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏＦ_1Ḅᛒ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(labelconst);
|
||||
$t .= "ㅏ";
|
||||
$t .= labelconst _AḄ:;
|
||||
$t .= "ᛒ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏ_AḄᛒ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(labelconst);
|
||||
no warnings;
|
||||
$t .= "ㅏ";
|
||||
$t .= labelconst 1AḄ:;
|
||||
$t .= "ᛒ";
|
||||
};
|
||||
isnt $@, "";
|
||||
is $t, "";
|
||||
|
||||
}
|
||||
|
||||
{
|
||||
use utf8;
|
||||
$t = "";
|
||||
$t = do("t/labelconst_utf8.aux");
|
||||
is $@, "";
|
||||
is $t, "ＦǑǑBÀRᛒÀZQÙÙX";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
13
ext/XS-APItest/t/labelconst_utf8.aux
Normal file
13
ext/XS-APItest/t/labelconst_utf8.aux
Normal file
@ -0,0 +1,13 @@
|
||||
use utf8;
|
||||
use open qw( :utf8 :std );
|
||||
|
||||
use XS::APItest qw(labelconst);
|
||||
my $z = "";
|
||||
$z .= labelconst ＦǑǑ:;
|
||||
$z .= labelconst BÀR:
|
||||
;
|
||||
$z .= labelconst ᛒÀZ
|
||||
:;
|
||||
$z .= labelconst
|
||||
QÙÙX:;
|
||||
$z;
|
||||
@ -1,7 +1,7 @@
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More tests => 28;
|
||||
use Test::More tests => 56;
|
||||
|
||||
BEGIN { $^H |= 0x20000; }
|
||||
|
||||
@ -179,4 +179,181 @@ eval q{
|
||||
isnt $@, "";
|
||||
is $t, "";
|
||||
|
||||
{
|
||||
use utf8;
|
||||
use open qw( :utf8 :std );
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
$t .= "ㅏ";
|
||||
$t .= "Ḇ";
|
||||
swaplabel $t .= "ᶜ";
|
||||
swaplabel $t .= "ᛑ";
|
||||
$t .= "ᶟ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏḆᶜᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
$t .= "ㅏ";
|
||||
LḆ: $t .= "Ḇ";
|
||||
swaplabel $t .= "ᶜ"; Lᶜ:
|
||||
swaplabel $t .= "ᛑ"; Lᛑ:
|
||||
Lᶟ: $t .= "ᶟ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏḆᶜᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
$t .= "ㅏ";
|
||||
goto LḆ;
|
||||
LḆ: $t .= "Ḇ";
|
||||
swaplabel $t .= "ᶜ"; Lᶜ:
|
||||
swaplabel $t .= "ᛑ"; Lᛑ:
|
||||
Lᶟ: $t .= "ᶟ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏḆᶜᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
$t .= "ㅏ";
|
||||
goto Lᶜ;
|
||||
LḆ: $t .= "Ḇ";
|
||||
swaplabel $t .= "ᶜ"; Lᶜ:
|
||||
swaplabel $t .= "ᛑ"; Lᛑ:
|
||||
Lᶟ: $t .= "ᶟ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏᶜᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
$t .= "ㅏ";
|
||||
goto Lᛑ;
|
||||
LḆ: $t .= "Ḇ";
|
||||
swaplabel $t .= "ᶜ"; Lᶜ:
|
||||
swaplabel $t .= "ᛑ"; Lᛑ:
|
||||
Lᶟ: $t .= "ᶟ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
$t .= "ㅏ";
|
||||
goto Lᶟ;
|
||||
LḆ: $t .= "Ḇ";
|
||||
swaplabel $t .= "ᶜ"; Lᶜ:
|
||||
swaplabel $t .= "ᛑ"; Lᛑ:
|
||||
Lᶟ: $t .= "ᶟ";
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
$t .= "ㅏ";
|
||||
swaplabel $t .= "Ḇ"; y:
|
||||
$t .= "ᶜ";
|
||||
};
|
||||
isnt $@, "";
|
||||
is $t, "";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
if(1) { $t .= "ㅏ"; }
|
||||
if(1) { $t .= "Ḇ"; }
|
||||
swaplabel if(1) { $t .= "ᶜ"; }
|
||||
swaplabel if(1) { $t .= "ᛑ"; }
|
||||
if(1) { $t .= "ᶟ"; }
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏḆᶜᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
if(1) { $t .= "ㅏ"; }
|
||||
LḆ: if(1) { $t .= "Ḇ"; }
|
||||
swaplabel if(1) { $t .= "ᶜ"; } Lᶜ:
|
||||
swaplabel if(1) { $t .= "ᛑ"; } Lᛑ:
|
||||
Lᶟ: if(1) { $t .= "ᶟ"; }
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏḆᶜᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
if(1) { $t .= "ㅏ"; }
|
||||
goto LḆ;
|
||||
LḆ: if(1) { $t .= "Ḇ"; }
|
||||
swaplabel if(1) { $t .= "ᶜ"; } Lᶜ:
|
||||
swaplabel if(1) { $t .= "ᛑ"; } Lᛑ:
|
||||
Lᶟ: if(1) { $t .= "ᶟ"; }
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏḆᶜᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
if(1) { $t .= "ㅏ"; }
|
||||
goto Lᶜ;
|
||||
LḆ: if(1) { $t .= "Ḇ"; }
|
||||
swaplabel if(1) { $t .= "ᶜ"; } Lᶜ:
|
||||
swaplabel if(1) { $t .= "ᛑ"; } Lᛑ:
|
||||
Lᶟ: if(1) { $t .= "ᶟ"; }
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏᶜᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
if(1) { $t .= "ㅏ"; }
|
||||
goto Lᛑ;
|
||||
LḆ: if(1) { $t .= "Ḇ"; }
|
||||
swaplabel if(1) { $t .= "ᶜ"; } Lᶜ:
|
||||
swaplabel if(1) { $t .= "ᛑ"; } Lᛑ:
|
||||
Lᶟ: if(1) { $t .= "ᶟ"; }
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏᛑᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
if(1) { $t .= "ㅏ"; }
|
||||
goto Lᶟ;
|
||||
LḆ: if(1) { $t .= "Ḇ"; }
|
||||
swaplabel if(1) { $t .= "ᶜ"; } Lᶜ:
|
||||
swaplabel if(1) { $t .= "ᛑ"; } Lᛑ:
|
||||
Lᶟ: if(1) { $t .= "ᶟ"; }
|
||||
};
|
||||
is $@, "";
|
||||
is $t, "ㅏᶟ";
|
||||
|
||||
$t = "";
|
||||
eval q{
|
||||
use XS::APItest qw(swaplabel);
|
||||
if(1) { $t .= "ㅏ"; }
|
||||
swaplabel if(1) { $t .= "Ḇ"; } y:
|
||||
if(1) { $t .= "ᶜ"; }
|
||||
};
|
||||
isnt $@, "";
|
||||
is $t, "";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
21
op.c
21
op.c
@ -4512,8 +4512,11 @@ OP *
|
||||
Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
|
||||
{
|
||||
dVAR;
|
||||
const bool utf8 = cBOOL(flags & SVf_UTF8);
|
||||
PVOP *pvop;
|
||||
|
||||
flags &= ~SVf_UTF8;
|
||||
|
||||
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
|
||||
|| type == OP_RUNCV
|
||||
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
|
||||
@ -4524,6 +4527,7 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
|
||||
pvop->op_pv = pv;
|
||||
pvop->op_next = (OP*)pvop;
|
||||
pvop->op_flags = (U8)flags;
|
||||
pvop->op_private = utf8 ? OPpPV_IS_UTF8 : 0;
|
||||
if (PL_opargs[type] & OA_RETSCALAR)
|
||||
scalar((OP*)pvop);
|
||||
if (PL_opargs[type] & OA_TARGET)
|
||||
@ -5220,8 +5224,11 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
|
||||
{
|
||||
dVAR;
|
||||
const U32 seq = intro_my();
|
||||
const U32 utf8 = flags & SVf_UTF8;
|
||||
register COP *cop;
|
||||
|
||||
flags &= ~SVf_UTF8;
|
||||
|
||||
NewOp(1101, cop, 1, COP);
|
||||
if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) {
|
||||
cop->op_type = OP_DBSTATE;
|
||||
@ -5243,8 +5250,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
|
||||
cop->cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
|
||||
CopHINTHASH_set(cop, cophh_copy(CopHINTHASH_get(PL_curcop)));
|
||||
if (label) {
|
||||
Perl_cop_store_label(aTHX_ cop, label, strlen(label), 0);
|
||||
|
||||
Perl_cop_store_label(aTHX_ cop, label, strlen(label), utf8);
|
||||
|
||||
PL_hints |= HINT_BLOCK_SCOPE;
|
||||
/* It seems that we need to defer freeing this pointer, as other parts
|
||||
of the grammar end up wanting to copy it after this op has been
|
||||
@ -6053,9 +6060,13 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
|
||||
if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
|
||||
o = newOP(type, OPf_SPECIAL);
|
||||
else {
|
||||
o = newPVOP(type, 0, savesharedpv(label->op_type == OP_CONST
|
||||
? SvPV_nolen_const(((SVOP*)label)->op_sv)
|
||||
: ""));
|
||||
o = newPVOP(type,
|
||||
label->op_type == OP_CONST
|
||||
? SvUTF8(((SVOP*)label)->op_sv)
|
||||
: 0,
|
||||
savesharedpv(label->op_type == OP_CONST
|
||||
? SvPV_nolen_const(((SVOP*)label)->op_sv)
|
||||
: ""));
|
||||
}
|
||||
#ifdef PERL_MAD
|
||||
op_getmad(label,o,'L');
|
||||
|
||||
3
op.h
3
op.h
@ -317,6 +317,9 @@ Deprecated. Use C<GIMME_V> instead.
|
||||
#define OPpCOREARGS_SCALARMOD 64 /* \$ rather than \[$@%*] */
|
||||
#define OPpCOREARGS_PUSHMARK 128 /* Call pp_pushmark */
|
||||
|
||||
/* Private for OP_(LAST|REDO|NEXT|GOTO|DUMP) */
|
||||
#define OPpPV_IS_UTF8 128 /* label is in UTF8 */
|
||||
|
||||
struct op {
|
||||
BASEOP
|
||||
};
|
||||
|
||||
5
perly.c
5
perly.c
@ -136,11 +136,6 @@ yy_stack_print (pTHX_ const yy_parser *parser)
|
||||
);
|
||||
break;
|
||||
#ifndef PERL_IN_MADLY_C
|
||||
case toketype_p_tkval:
|
||||
PerlIO_printf(Perl_debug_log, " %8.8s",
|
||||
ps->val.pval ? ps->val.pval : "(NULL)");
|
||||
break;
|
||||
|
||||
case toketype_i_tkval:
|
||||
#endif
|
||||
case toketype_ival:
|
||||
|
||||
4
perly.h
4
perly.h
@ -231,7 +231,7 @@ typedef union YYSTYPE
|
||||
TOKEN* tkval;
|
||||
#endif
|
||||
}
|
||||
/* Line 1489 of yacc.c. */
|
||||
/* Line 1529 of yacc.c. */
|
||||
YYSTYPE;
|
||||
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
|
||||
# define YYSTYPE_IS_DECLARED 1
|
||||
@ -242,6 +242,6 @@ typedef union YYSTYPE
|
||||
|
||||
|
||||
/* Generated from:
|
||||
* 653e5740260a91fc0511942c124de9498176ffc3862f4d9d4523d3bafbace9c6 perly.y
|
||||
* 047d7d5048e78a17bc586b7bb9a0f0e9dedd5cd43b30e486482b1ff8f955ddcb perly.y
|
||||
* 53f57d7143a42b3c008841a14d158bcf9cab64b2904b07ef5e95051fe9a8a875 regen_perly.pl
|
||||
* ex: set ro: */
|
||||
|
||||
44
perly.tab
44
perly.tab
@ -180,27 +180,27 @@ static const yytype_uint16 yyrline[] =
|
||||
{
|
||||
0, 142, 142, 141, 151, 150, 160, 159, 172, 171,
|
||||
184, 183, 196, 195, 207, 217, 221, 224, 234, 239,
|
||||
240, 249, 257, 261, 267, 275, 277, 282, 300, 321,
|
||||
333, 349, 348, 365, 374, 383, 389, 391, 393, 403,
|
||||
413, 434, 443, 452, 461, 468, 467, 493, 499, 509,
|
||||
511, 513, 517, 521, 525, 529, 534, 540, 541, 547,
|
||||
561, 562, 571, 577, 578, 583, 586, 590, 595, 599,
|
||||
603, 607, 608, 612, 618, 623, 628, 638, 639, 644,
|
||||
645, 649, 659, 663, 673, 674, 684, 688, 692, 696,
|
||||
700, 710, 719, 723, 728, 735, 744, 750, 756, 764,
|
||||
768, 775, 774, 785, 786, 790, 799, 804, 812, 819,
|
||||
826, 836, 845, 852, 861, 868, 874, 881, 886, 896,
|
||||
900, 904, 910, 914, 918, 922, 926, 930, 934, 946,
|
||||
950, 954, 958, 968, 972, 979, 983, 987, 992, 997,
|
||||
1002, 1011, 1016, 1021, 1027, 1033, 1044, 1048, 1052, 1064,
|
||||
1077, 1085, 1097, 1098, 1099, 1100, 1101, 1106, 1110, 1112,
|
||||
1116, 1121, 1123, 1128, 1130, 1132, 1134, 1136, 1138, 1140,
|
||||
1149, 1160, 1162, 1164, 1169, 1182, 1187, 1192, 1196, 1200,
|
||||
1204, 1208, 1212, 1216, 1220, 1222, 1225, 1229, 1235, 1237,
|
||||
1242, 1245, 1254, 1260, 1265, 1266, 1267, 1273, 1277, 1285,
|
||||
1292, 1297, 1302, 1304, 1306, 1311, 1313, 1318, 1319, 1323,
|
||||
1326, 1325, 1333, 1337, 1343, 1349, 1355, 1361, 1367, 1374,
|
||||
1376, 1378, 1381
|
||||
240, 249, 257, 261, 268, 277, 279, 284, 302, 323,
|
||||
335, 351, 350, 367, 376, 385, 391, 393, 395, 405,
|
||||
415, 436, 445, 454, 463, 470, 469, 495, 501, 511,
|
||||
513, 515, 519, 523, 527, 531, 536, 542, 543, 549,
|
||||
563, 564, 573, 579, 580, 585, 588, 592, 597, 601,
|
||||
605, 609, 610, 614, 620, 625, 630, 640, 641, 646,
|
||||
647, 651, 661, 665, 675, 676, 686, 690, 694, 698,
|
||||
702, 712, 721, 725, 730, 737, 746, 752, 758, 766,
|
||||
770, 777, 776, 787, 788, 792, 801, 806, 814, 821,
|
||||
828, 838, 847, 854, 863, 870, 876, 883, 888, 898,
|
||||
902, 906, 912, 916, 920, 924, 928, 932, 936, 948,
|
||||
952, 956, 960, 970, 974, 981, 985, 989, 994, 999,
|
||||
1004, 1013, 1018, 1023, 1029, 1035, 1046, 1050, 1054, 1066,
|
||||
1079, 1087, 1099, 1100, 1101, 1102, 1103, 1108, 1112, 1114,
|
||||
1118, 1123, 1125, 1130, 1132, 1134, 1136, 1138, 1140, 1142,
|
||||
1151, 1162, 1164, 1166, 1171, 1184, 1189, 1194, 1198, 1202,
|
||||
1206, 1210, 1214, 1218, 1222, 1224, 1227, 1231, 1237, 1239,
|
||||
1244, 1247, 1256, 1262, 1267, 1268, 1269, 1275, 1279, 1287,
|
||||
1294, 1299, 1304, 1306, 1308, 1313, 1315, 1320, 1321, 1325,
|
||||
1328, 1327, 1335, 1339, 1345, 1351, 1357, 1363, 1369, 1376,
|
||||
1378, 1380, 1383
|
||||
};
|
||||
#endif
|
||||
|
||||
@ -1093,6 +1093,6 @@ static const toketypes yy_type_tab[] =
|
||||
};
|
||||
|
||||
/* Generated from:
|
||||
* 653e5740260a91fc0511942c124de9498176ffc3862f4d9d4523d3bafbace9c6 perly.y
|
||||
* 047d7d5048e78a17bc586b7bb9a0f0e9dedd5cd43b30e486482b1ff8f955ddcb perly.y
|
||||
* 53f57d7143a42b3c008841a14d158bcf9cab64b2904b07ef5e95051fe9a8a875 regen_perly.pl
|
||||
* ex: set ro: */
|
||||
|
||||
6
perly.y
6
perly.y
@ -260,13 +260,15 @@ fullstmt: barestmt
|
||||
|
||||
labfullstmt: LABEL barestmt
|
||||
{
|
||||
$$ = newSTATEOP(0, PVAL($1), $2);
|
||||
$$ = newSTATEOP(SvUTF8(((SVOP*)$1)->op_sv),
|
||||
savepv(SvPVX(((SVOP*)$1)->op_sv)), $2);
|
||||
TOKEN_GETMAD($1,
|
||||
$2 ? cLISTOPx($$)->op_first : $$, 'L');
|
||||
}
|
||||
| LABEL labfullstmt
|
||||
{
|
||||
$$ = newSTATEOP(0, PVAL($1), $2);
|
||||
$$ = newSTATEOP(SvUTF8(((SVOP*)$1)->op_sv),
|
||||
savepv(SvPVX(((SVOP*)$1)->op_sv)), $2);
|
||||
TOKEN_GETMAD($1, cLISTOPx($$)->op_first, 'L');
|
||||
}
|
||||
;
|
||||
|
||||
91
pp_ctl.c
91
pp_ctl.c
@ -1386,7 +1386,7 @@ static const char * const context_name[] = {
|
||||
};
|
||||
|
||||
STATIC I32
|
||||
S_dopoptolabel(pTHX_ const char *label)
|
||||
S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags)
|
||||
{
|
||||
dVAR;
|
||||
register I32 i;
|
||||
@ -1412,8 +1412,20 @@ S_dopoptolabel(pTHX_ const char *label)
|
||||
case CXt_LOOP_FOR:
|
||||
case CXt_LOOP_PLAIN:
|
||||
{
|
||||
const char *cx_label = CxLABEL(cx);
|
||||
if (!cx_label || strNE(label, cx_label) ) {
|
||||
STRLEN cx_label_len = 0;
|
||||
U32 cx_label_flags = 0;
|
||||
const char *cx_label = CxLABEL_len_flags(cx, &cx_label_len, &cx_label_flags);
|
||||
if (!cx_label || !(
|
||||
( (cx_label_flags & SVf_UTF8) != (flags & SVf_UTF8) ) ?
|
||||
(flags & SVf_UTF8)
|
||||
? (bytes_cmp_utf8(
|
||||
(const U8*)cx_label, cx_label_len,
|
||||
(const U8*)label, len) == 0)
|
||||
: (bytes_cmp_utf8(
|
||||
(const U8*)label, len,
|
||||
(const U8*)cx_label, cx_label_len) == 0)
|
||||
: ((cx_label == label)
|
||||
|| memEQ(cx_label, label, len))) ) {
|
||||
DEBUG_l(Perl_deb(aTHX_ "(poptolabel(): skipping label at cx=%ld %s)\n",
|
||||
(long)i, cx_label));
|
||||
continue;
|
||||
@ -2609,9 +2621,14 @@ PP(pp_last)
|
||||
DIE(aTHX_ "Can't \"last\" outside a loop block");
|
||||
}
|
||||
else {
|
||||
cxix = dopoptolabel(cPVOP->op_pv);
|
||||
cxix = dopoptolabel(cPVOP->op_pv, strlen(cPVOP->op_pv),
|
||||
(cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0);
|
||||
if (cxix < 0)
|
||||
DIE(aTHX_ "Label not found for \"last %s\"", cPVOP->op_pv);
|
||||
DIE(aTHX_ "Label not found for \"last %"SVf"\"",
|
||||
SVfARG(newSVpvn_flags(cPVOP->op_pv,
|
||||
strlen(cPVOP->op_pv),
|
||||
((cPVOP->op_private & OPpPV_IS_UTF8)
|
||||
? SVf_UTF8 : 0) | SVs_TEMP)));
|
||||
}
|
||||
if (cxix < cxstack_ix)
|
||||
dounwind(cxix);
|
||||
@ -2685,9 +2702,14 @@ PP(pp_next)
|
||||
DIE(aTHX_ "Can't \"next\" outside a loop block");
|
||||
}
|
||||
else {
|
||||
cxix = dopoptolabel(cPVOP->op_pv);
|
||||
if (cxix < 0)
|
||||
DIE(aTHX_ "Label not found for \"next %s\"", cPVOP->op_pv);
|
||||
cxix = dopoptolabel(cPVOP->op_pv, strlen(cPVOP->op_pv),
|
||||
(cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0);
|
||||
if (cxix < 0)
|
||||
DIE(aTHX_ "Label not found for \"next %"SVf"\"",
|
||||
SVfARG(newSVpvn_flags(cPVOP->op_pv,
|
||||
strlen(cPVOP->op_pv),
|
||||
((cPVOP->op_private & OPpPV_IS_UTF8)
|
||||
? SVf_UTF8 : 0) | SVs_TEMP)));
|
||||
}
|
||||
if (cxix < cxstack_ix)
|
||||
dounwind(cxix);
|
||||
@ -2716,9 +2738,14 @@ PP(pp_redo)
|
||||
DIE(aTHX_ "Can't \"redo\" outside a loop block");
|
||||
}
|
||||
else {
|
||||
cxix = dopoptolabel(cPVOP->op_pv);
|
||||
if (cxix < 0)
|
||||
DIE(aTHX_ "Label not found for \"redo %s\"", cPVOP->op_pv);
|
||||
cxix = dopoptolabel(cPVOP->op_pv, strlen(cPVOP->op_pv),
|
||||
(cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0);
|
||||
if (cxix < 0)
|
||||
DIE(aTHX_ "Label not found for \"redo %"SVf"\"",
|
||||
SVfARG(newSVpvn_flags(cPVOP->op_pv,
|
||||
strlen(cPVOP->op_pv),
|
||||
((cPVOP->op_private & OPpPV_IS_UTF8)
|
||||
? SVf_UTF8 : 0) | SVs_TEMP)));
|
||||
}
|
||||
if (cxix < cxstack_ix)
|
||||
dounwind(cxix);
|
||||
@ -2740,7 +2767,7 @@ PP(pp_redo)
|
||||
}
|
||||
|
||||
STATIC OP *
|
||||
S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
|
||||
S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit)
|
||||
{
|
||||
dVAR;
|
||||
OP **ops = opstack;
|
||||
@ -2766,8 +2793,21 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
|
||||
/* First try all the kids at this level, since that's likeliest. */
|
||||
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
|
||||
if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
|
||||
const char *kid_label = CopLABEL(kCOP);
|
||||
if (kid_label && strEQ(kid_label, label))
|
||||
STRLEN kid_label_len;
|
||||
U32 kid_label_flags;
|
||||
const char *kid_label = CopLABEL_len_flags(kCOP,
|
||||
&kid_label_len, &kid_label_flags);
|
||||
if (kid_label && (
|
||||
( (kid_label_flags & SVf_UTF8) != (flags & SVf_UTF8) ) ?
|
||||
(flags & SVf_UTF8)
|
||||
? (bytes_cmp_utf8(
|
||||
(const U8*)kid_label, kid_label_len,
|
||||
(const U8*)label, len) == 0)
|
||||
: (bytes_cmp_utf8(
|
||||
(const U8*)label, len,
|
||||
(const U8*)kid_label, kid_label_len) == 0)
|
||||
: ((kid_label == label)
|
||||
|| memEQ(kid_label, label, len))))
|
||||
return kid;
|
||||
}
|
||||
}
|
||||
@ -2783,7 +2823,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
|
||||
else
|
||||
*ops++ = kid;
|
||||
}
|
||||
if ((o = dofindlabel(kid, label, ops, oplimit)))
|
||||
if ((o = dofindlabel(kid, label, len, flags, ops, oplimit)))
|
||||
return o;
|
||||
}
|
||||
}
|
||||
@ -2800,6 +2840,8 @@ PP(pp_goto)
|
||||
#define GOTO_DEPTH 64
|
||||
OP *enterops[GOTO_DEPTH];
|
||||
const char *label = NULL;
|
||||
STRLEN label_len = 0;
|
||||
U32 label_flags = 0;
|
||||
const bool do_dump = (PL_op->op_type == OP_DUMP);
|
||||
static const char must_have_label[] = "goto must have label";
|
||||
|
||||
@ -3000,7 +3042,8 @@ PP(pp_goto)
|
||||
}
|
||||
}
|
||||
else {
|
||||
label = SvPV_nolen_const(sv);
|
||||
label = SvPV_const(sv, label_len);
|
||||
label_flags = SvUTF8(sv);
|
||||
if (!(do_dump || *label))
|
||||
DIE(aTHX_ must_have_label);
|
||||
}
|
||||
@ -3009,8 +3052,11 @@ PP(pp_goto)
|
||||
if (! do_dump)
|
||||
DIE(aTHX_ must_have_label);
|
||||
}
|
||||
else
|
||||
label = cPVOP->op_pv;
|
||||
else {
|
||||
label = cPVOP->op_pv;
|
||||
label_flags = (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0;
|
||||
label_len = strlen(label);
|
||||
}
|
||||
|
||||
PERL_ASYNC_CHECK();
|
||||
|
||||
@ -3071,7 +3117,7 @@ PP(pp_goto)
|
||||
break;
|
||||
}
|
||||
if (gotoprobe) {
|
||||
retop = dofindlabel(gotoprobe, label,
|
||||
retop = dofindlabel(gotoprobe, label, label_len, label_flags,
|
||||
enterops, enterops + GOTO_DEPTH);
|
||||
if (retop)
|
||||
break;
|
||||
@ -3079,7 +3125,8 @@ PP(pp_goto)
|
||||
gotoprobe->op_sibling->op_type == OP_UNSTACK &&
|
||||
gotoprobe->op_sibling->op_sibling) {
|
||||
retop = dofindlabel(gotoprobe->op_sibling->op_sibling,
|
||||
label, enterops, enterops + GOTO_DEPTH);
|
||||
label, label_len, label_flags, enterops,
|
||||
enterops + GOTO_DEPTH);
|
||||
if (retop)
|
||||
break;
|
||||
}
|
||||
@ -3087,7 +3134,9 @@ PP(pp_goto)
|
||||
PL_lastgotoprobe = gotoprobe;
|
||||
}
|
||||
if (!retop)
|
||||
DIE(aTHX_ "Can't find label %s", label);
|
||||
DIE(aTHX_ "Can't find label %"SVf,
|
||||
SVfARG(newSVpvn_flags(label, label_len,
|
||||
SVs_TEMP | label_flags)));
|
||||
|
||||
/* if we're leaving an eval, check before we pop any frames
|
||||
that we're not going to punt, otherwise the error
|
||||
|
||||
8
proto.h
8
proto.h
@ -6043,12 +6043,12 @@ STATIC OP* S_docatch(pTHX_ OP *o)
|
||||
__attribute__warn_unused_result__;
|
||||
|
||||
STATIC bool S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq, HV* hh);
|
||||
STATIC OP* S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
|
||||
STATIC OP* S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit)
|
||||
__attribute__warn_unused_result__
|
||||
__attribute__nonnull__(pTHX_1)
|
||||
__attribute__nonnull__(pTHX_2)
|
||||
__attribute__nonnull__(pTHX_3)
|
||||
__attribute__nonnull__(pTHX_4);
|
||||
__attribute__nonnull__(pTHX_5)
|
||||
__attribute__nonnull__(pTHX_6);
|
||||
#define PERL_ARGS_ASSERT_DOFINDLABEL \
|
||||
assert(o); assert(label); assert(opstack); assert(oplimit)
|
||||
|
||||
@ -6063,7 +6063,7 @@ STATIC I32 S_dopoptoeval(pTHX_ I32 startingblock)
|
||||
STATIC I32 S_dopoptogiven(pTHX_ I32 startingblock)
|
||||
__attribute__warn_unused_result__;
|
||||
|
||||
STATIC I32 S_dopoptolabel(pTHX_ const char *label)
|
||||
STATIC I32 S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags)
|
||||
__attribute__warn_unused_result__
|
||||
__attribute__nonnull__(pTHX_1);
|
||||
#define PERL_ARGS_ASSERT_DOPOPTOLABEL \
|
||||
|
||||
82
t/uni/labels.t
Normal file
82
t/uni/labels.t
Normal file
@ -0,0 +1,82 @@
|
||||
#!./perl
|
||||
|
||||
# Tests for labels in UTF-8
|
||||
|
||||
BEGIN {
|
||||
chdir 't' if -d 't';
|
||||
@INC = '../lib';
|
||||
require './test.pl';
|
||||
}
|
||||
|
||||
use utf8;
|
||||
use open qw( :utf8 :std );
|
||||
use warnings;
|
||||
use feature 'unicode_strings';
|
||||
|
||||
use charnames qw( :full );
|
||||
|
||||
plan(9);
|
||||
|
||||
ＬＡＢＥＬ: {
|
||||
pass("Sanity check, UTF-8 labels don't throw a syntax error.");
|
||||
}
|
||||
|
||||
|
||||
SKIP: {
|
||||
skip_if_miniperl("no dynamic loading, no Encode");
|
||||
no warnings 'exiting';
|
||||
require Encode;
|
||||
|
||||
my $prog = 'last ＬＯＯＰ;';
|
||||
|
||||
ＬＯＯＰ: {
|
||||
eval $prog;
|
||||
}
|
||||
is $@, '', "last with a UTF-8 label works,";
|
||||
|
||||
ＬＯＯＰ: {
|
||||
Encode::_utf8_off($prog);
|
||||
eval $prog;
|
||||
like $@, qr/^Unrecognized character/, "..but turn off the UTF-8 flag and it explodes";
|
||||
}
|
||||
}
|
||||
|
||||
{
|
||||
no warnings 'exiting';
|
||||
|
||||
eval "last Ｅ";
|
||||
like $@, qr/Label not found for "last Ｅ" at/u, "last's error is UTF-8 clean";
|
||||
|
||||
eval "redo Ｅ";
|
||||
like $@, qr/Label not found for "redo Ｅ" at/u, "redo's error is UTF-8 clean";
|
||||
|
||||
eval "next Ｅ";
|
||||
like $@, qr/Label not found for "next Ｅ" at/u, "next's error is UTF-8 clean";
|
||||
}
|
||||
|
||||
my $d = 4;
|
||||
LÁBEL: {
|
||||
my $prog = "redo L\N{LATIN CAPITAL LETTER A WITH ACUTE}BEL";
|
||||
|
||||
if ($d % 2) {
|
||||
utf8::downgrade($prog);
|
||||
}
|
||||
if ($d--) {
|
||||
no warnings 'exiting';
|
||||
eval $prog;
|
||||
}
|
||||
}
|
||||
|
||||
is $@, '', "redo to downgradeable labels works";
|
||||
is $d, -1, "Latin-1 labels reachable regardless of UTF-8ness";
|
||||
|
||||
{
|
||||
no warnings;
|
||||
goto ここ;
|
||||
|
||||
if (undef) {
|
||||
ここ: {
|
||||
pass("goto UTF-8 LABEL works.");
|
||||
}
|
||||
}
|
||||
}
|
||||
30
toke.c
30
toke.c
@ -359,7 +359,7 @@ static struct debug_tokens {
|
||||
{ GIVEN, TOKENTYPE_IVAL, "GIVEN" },
|
||||
{ HASHBRACK, TOKENTYPE_NONE, "HASHBRACK" },
|
||||
{ IF, TOKENTYPE_IVAL, "IF" },
|
||||
{ LABEL, TOKENTYPE_PVAL, "LABEL" },
|
||||
{ LABEL, TOKENTYPE_OPVAL, "LABEL" },
|
||||
{ LOCAL, TOKENTYPE_IVAL, "LOCAL" },
|
||||
{ LOOPEX, TOKENTYPE_OPNUM, "LOOPEX" },
|
||||
{ LSTOP, TOKENTYPE_OPNUM, "LSTOP" },
|
||||
@ -4231,6 +4231,7 @@ Perl_madlex(pTHX)
|
||||
case FUNC0SUB:
|
||||
case UNIOPSUB:
|
||||
case LSTOPSUB:
|
||||
case LABEL:
|
||||
if (pl_yylval.opval)
|
||||
append_madprops(PL_thismad, pl_yylval.opval, 0);
|
||||
PL_thismad = 0;
|
||||
@ -4291,10 +4292,6 @@ Perl_madlex(pTHX)
|
||||
}
|
||||
break;
|
||||
|
||||
/* pval */
|
||||
case LABEL:
|
||||
break;
|
||||
|
||||
/* ival */
|
||||
default:
|
||||
break;
|
||||
@ -6573,7 +6570,9 @@ Perl_yylex(pTHX)
|
||||
if (!anydelim && PL_expect == XSTATE
|
||||
&& d < PL_bufend && *d == ':' && *(d + 1) != ':') {
|
||||
s = d + 1;
|
||||
pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
|
||||
pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
|
||||
newSVpvn_flags(PL_tokenbuf,
|
||||
len, UTF ? SVf_UTF8 : 0));
|
||||
CLINE;
|
||||
TOKEN(LABEL);
|
||||
}
|
||||
@ -8797,7 +8796,7 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag
|
||||
for (;;) {
|
||||
if (d >= e)
|
||||
Perl_croak(aTHX_ ident_too_long);
|
||||
if (isALNUM(*s)) /* UTF handled below */
|
||||
if (isALNUM(*s) || (!UTF && isALNUMC_L1(*s))) /* UTF handled below */
|
||||
*d++ = *s++;
|
||||
else if (allow_package && (*s == '\'') && isIDFIRST_lazy_if(s+1,UTF)) {
|
||||
*d++ = ':';
|
||||
@ -11509,8 +11508,8 @@ Perl_parse_label(pTHX_ U32 flags)
|
||||
if (PL_lex_state == LEX_KNOWNEXT) {
|
||||
PL_parser->yychar = yylex();
|
||||
if (PL_parser->yychar == LABEL) {
|
||||
char *lpv = pl_yylval.pval;
|
||||
STRLEN llen = strlen(lpv);
|
||||
STRLEN llen;
|
||||
char *lpv = SvPV(cSVOPx(pl_yylval.opval)->op_sv, llen);
|
||||
SV *lsv;
|
||||
PL_parser->yychar = YYEMPTY;
|
||||
lsv = newSV_type(SVt_PV);
|
||||
@ -11518,6 +11517,8 @@ Perl_parse_label(pTHX_ U32 flags)
|
||||
SvCUR_set(lsv, llen);
|
||||
SvLEN_set(lsv, llen+1);
|
||||
SvPOK_on(lsv);
|
||||
if (SvUTF8(cSVOPx(pl_yylval.opval)->op_sv))
|
||||
SvUTF8_on(lsv);
|
||||
return lsv;
|
||||
} else {
|
||||
yyunlex();
|
||||
@ -11525,17 +11526,12 @@ Perl_parse_label(pTHX_ U32 flags)
|
||||
}
|
||||
} else {
|
||||
char *s, *t;
|
||||
U8 c;
|
||||
STRLEN wlen, bufptr_pos;
|
||||
lex_read_space(0);
|
||||
t = s = PL_bufptr;
|
||||
c = (U8)*s;
|
||||
if (!isIDFIRST_A(c))
|
||||
if (!isIDFIRST_lazy_if(s, UTF))
|
||||
goto no_label;
|
||||
do {
|
||||
c = (U8)*++t;
|
||||
} while(isWORDCHAR_A(c));
|
||||
wlen = t - s;
|
||||
t = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen);
|
||||
if (word_takes_any_delimeter(s, wlen))
|
||||
goto no_label;
|
||||
bufptr_pos = s - SvPVX(PL_linestr);
|
||||
@ -11547,7 +11543,7 @@ Perl_parse_label(pTHX_ U32 flags)
|
||||
PL_oldoldbufptr = PL_oldbufptr;
|
||||
PL_oldbufptr = s;
|
||||
PL_bufptr = t+1;
|
||||
return newSVpvn(s, wlen);
|
||||
return newSVpvn_flags(s, wlen, UTF ? SVf_UTF8 : 0);
|
||||
} else {
|
||||
PL_bufptr = s;
|
||||
no_label:
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user