diff options
| -rw-r--r-- | MANIFEST | 3 | ||||
| -rw-r--r-- | cop.h | 4 | ||||
| -rw-r--r-- | embed.fnc | 16 | ||||
| -rw-r--r-- | embed.h | 13 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.pm | 2 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 4 | ||||
| -rw-r--r-- | ext/XS-APItest/t/labelconst.t | 77 | ||||
| -rw-r--r-- | ext/XS-APItest/t/labelconst_utf8.aux | 13 | ||||
| -rw-r--r-- | ext/XS-APItest/t/swaplabel.t | 179 | ||||
| -rw-r--r-- | lib/_charnames.pm | 21 | ||||
| -rw-r--r-- | op.c | 144 | ||||
| -rw-r--r-- | op.h | 3 | ||||
| -rw-r--r-- | perly.act | 378 | ||||
| -rw-r--r-- | perly.c | 5 | ||||
| -rw-r--r-- | perly.h | 4 | ||||
| -rw-r--r-- | perly.tab | 44 | ||||
| -rw-r--r-- | perly.y | 6 | ||||
| -rw-r--r-- | pod/perlvar.pod | 10 | ||||
| -rw-r--r-- | pp_ctl.c | 91 | ||||
| -rw-r--r-- | proto.h | 45 | ||||
| -rw-r--r-- | sv.c | 1 | ||||
| -rw-r--r-- | t/lib/charnames/alias | 8 | ||||
| -rw-r--r-- | t/lib/warnings/op | 28 | ||||
| -rw-r--r-- | t/lib/warnings/toke | 132 | ||||
| -rw-r--r-- | t/re/reg_email.t | 2 | ||||
| -rw-r--r-- | t/uni/labels.t | 82 | ||||
| -rw-r--r-- | t/uni/opcroak.t | 44 | ||||
| -rw-r--r-- | t/uni/parser.t | 8 | ||||
| -rw-r--r-- | toke.c | 81 |
29 files changed, 1072 insertions, 376 deletions
@@ -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,10 +5493,12 @@ 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 t/uni/method.t See if Unicode methods work +t/uni/opcroak.t See if Unicode croaks from op.c work t/uni/overload.t See if Unicode overloading works t/uni/package.t See if Unicode in package declarations works t/uni/parser.t See if Unicode in the parser works in edge cases. @@ -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) @@ -1741,17 +1741,20 @@ sR |OP* |newDEFSVOP sR |OP* |search_const |NN OP *o sR |OP* |new_logop |I32 type|I32 flags|NN OP **firstp|NN OP **otherp s |void |simplify_sort |NN OP *o -s |const char* |gv_ename |NN GV *gv +s |SV* |gv_ename |NN GV *gv sRn |bool |scalar_mod_type|NULLOK const OP *o|I32 type s |OP * |my_kid |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp s |OP * |dup_attrlist |NN OP *o s |void |apply_attrs |NN HV *stash|NN SV *target|NULLOK OP *attrs|bool for_my s |void |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp -s |void |bad_type |I32 n|NN const char *t|NN const char *name|NN const OP *kid +s |void |bad_type_pv |I32 n|NN const char *t|NN const char *name|U32 flags|NN const OP *kid +s |void |bad_type_sv |I32 n|NN const char *t|NN SV *namesv|U32 flags|NN const OP *kid s |void |no_bareword_allowed|NN OP *o sR |OP* |no_fh_allowed|NN OP *o -sR |OP* |too_few_arguments|NN OP *o|NN const char* name -s |OP* |too_many_arguments|NN OP *o|NN const char* name +sR |OP* |too_few_arguments_sv|NN OP *o|NN SV* namesv|U32 flags +sR |OP* |too_few_arguments_pv|NN OP *o|NN const char* name|U32 flags +s |OP* |too_many_arguments_pv|NN OP *o|NN const char* name|U32 flags +sR |OP* |too_many_arguments_sv|NN OP *o|NN SV* namesv|U32 flags s |bool |looks_like_bool|NN const OP* o s |OP* |newGIVWHENOP |NULLOK OP* cond|NN OP *block \ |I32 enter_opcode|I32 leave_opcode \ @@ -1838,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 @@ -1387,7 +1387,8 @@ #define aassign_common_vars(a) S_aassign_common_vars(aTHX_ a) #define apply_attrs(a,b,c,d) S_apply_attrs(aTHX_ a,b,c,d) #define apply_attrs_my(a,b,c,d) S_apply_attrs_my(aTHX_ a,b,c,d) -#define bad_type(a,b,c,d) S_bad_type(aTHX_ a,b,c,d) +#define bad_type_pv(a,b,c,d,e) S_bad_type_pv(aTHX_ a,b,c,d,e) +#define bad_type_sv(a,b,c,d,e) S_bad_type_sv(aTHX_ a,b,c,d,e) #define cop_free(a) S_cop_free(aTHX_ a) #define dup_attrlist(a) S_dup_attrlist(aTHX_ a) #define finalize_op(a) S_finalize_op(aTHX_ a) @@ -1421,8 +1422,10 @@ #define scalarseq(a) S_scalarseq(aTHX_ a) #define search_const(a) S_search_const(aTHX_ a) #define simplify_sort(a) S_simplify_sort(aTHX_ a) -#define too_few_arguments(a,b) S_too_few_arguments(aTHX_ a,b) -#define too_many_arguments(a,b) S_too_many_arguments(aTHX_ a,b) +#define too_few_arguments_pv(a,b,c) S_too_few_arguments_pv(aTHX_ a,b,c) +#define too_few_arguments_sv(a,b,c) S_too_few_arguments_sv(aTHX_ a,b,c) +#define too_many_arguments_pv(a,b,c) S_too_many_arguments_pv(aTHX_ a,b,c) +#define too_many_arguments_sv(a,b,c) S_too_many_arguments_sv(aTHX_ a,b,c) # endif # if defined(PERL_IN_OP_C) || defined(PERL_IN_SV_C) #define report_redefined_cv(a,b,c) Perl_report_redefined_cv(aTHX_ a,b,c) @@ -1465,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) diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 78d77f1f87..6c3c3230ec 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.37'; +our $VERSION = '0.38'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 51059608b2..34fbfdeb1a 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -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) diff --git a/ext/XS-APItest/t/labelconst.t b/ext/XS-APItest/t/labelconst.t index 79fe9d2212..f3a7d9c9cd 100644 --- a/ext/XS-APItest/t/labelconst.t +++ b/ext/XS-APItest/t/labelconst.t @@ -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; diff --git a/ext/XS-APItest/t/labelconst_utf8.aux b/ext/XS-APItest/t/labelconst_utf8.aux new file mode 100644 index 0000000000..c1a2cc8a92 --- /dev/null +++ b/ext/XS-APItest/t/labelconst_utf8.aux @@ -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; diff --git a/ext/XS-APItest/t/swaplabel.t b/ext/XS-APItest/t/swaplabel.t index a57368243b..f2678d03fc 100644 --- a/ext/XS-APItest/t/swaplabel.t +++ b/ext/XS-APItest/t/swaplabel.t @@ -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; diff --git a/lib/_charnames.pm b/lib/_charnames.pm index d29af30f8e..62ee39560d 100644 --- a/lib/_charnames.pm +++ b/lib/_charnames.pm @@ -7,7 +7,7 @@ package _charnames; use strict; use warnings; use File::Spec; -our $VERSION = '1.30'; +our $VERSION = '1.31'; use unicore::Name; # mktables-generated algorithmically-defined names use bytes (); # for $bytes::hint_bits @@ -742,20 +742,21 @@ sub viacode { && (! defined $H_ref || ! exists $H_ref->{charnames_stringified_inverse_ords}); - my %code_point_aliases = split ',', + my %code_point_aliases; + if (defined $H_ref->{charnames_stringified_inverse_ords}) { + %code_point_aliases = split ',', $H_ref->{charnames_stringified_inverse_ords}; - if (! exists $code_point_aliases{$hex}) { + return $code_point_aliases{$hex} if exists $code_point_aliases{$hex}; + } - # If there is an official alias, and no user-defined one, return that - return $return if defined $return; + # Here there is no user-defined alias, return any official one. + return $return if defined $return; - if (CORE::hex($hex) > 0x10FFFF) { - carp "Unicode characters only allocated up to U+10FFFF (you asked for U+$hex)"; - } - return; + if (CORE::hex($hex) > 0x10FFFF) { + carp "Unicode characters only allocated up to U+10FFFF (you asked for U+$hex)"; } + return; - return $code_point_aliases{$hex}; } # _viacode 1; @@ -317,7 +317,7 @@ Perl_Slab_Free(pTHX_ void *op) o->op_ppaddr = PL_ppaddr[type]; \ } STMT_END -STATIC const char* +STATIC SV* S_gv_ename(pTHX_ GV *gv) { SV* const tmpsv = sv_newmortal(); @@ -325,7 +325,7 @@ S_gv_ename(pTHX_ GV *gv) PERL_ARGS_ASSERT_GV_ENAME; gv_efullname3(tmpsv, gv, NULL); - return SvPV_nolen_const(tmpsv); + return tmpsv; } STATIC OP * @@ -339,30 +339,57 @@ S_no_fh_allowed(pTHX_ OP *o) } STATIC OP * -S_too_few_arguments(pTHX_ OP *o, const char *name) +S_too_few_arguments_sv(pTHX_ OP *o, SV *namesv, U32 flags) { - PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS; + PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS_SV; + yyerror_pv(Perl_form(aTHX_ "Not enough arguments for %"SVf, namesv), + SvUTF8(namesv) | flags); + return o; +} + +STATIC OP * +S_too_few_arguments_pv(pTHX_ OP *o, const char* name, U32 flags) +{ + PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS_PV; + yyerror_pv(Perl_form(aTHX_ "Not enough arguments for %s", name), flags); + return o; +} + +STATIC OP * +S_too_many_arguments_pv(pTHX_ OP *o, const char *name, U32 flags) +{ + PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_PV; - yyerror(Perl_form(aTHX_ "Not enough arguments for %s", name)); + yyerror_pv(Perl_form(aTHX_ "Too many arguments for %s", name), flags); return o; } STATIC OP * -S_too_many_arguments(pTHX_ OP *o, const char *name) +S_too_many_arguments_sv(pTHX_ OP *o, SV *namesv, U32 flags) { - PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS; + PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_SV; - yyerror(Perl_form(aTHX_ "Too many arguments for %s", name)); + yyerror_pv(Perl_form(aTHX_ "Too many arguments for %"SVf, SVfARG(namesv)), + SvUTF8(namesv) | flags); return o; } STATIC void -S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid) +S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP *kid) { - PERL_ARGS_ASSERT_BAD_TYPE; + PERL_ARGS_ASSERT_BAD_TYPE_PV; - yyerror(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)", - (int)n, name, t, OP_DESC(kid))); + yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)", + (int)n, name, t, OP_DESC(kid)), flags); +} + +STATIC void +S_bad_type_sv(pTHX_ I32 n, const char *t, SV *namesv, U32 flags, const OP *kid) +{ + PERL_ARGS_ASSERT_BAD_TYPE_SV; + + yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %"SVf" must be %s (not %s)", + (int)n, SVfARG(namesv), t, OP_DESC(kid)), SvUTF8(namesv) | flags); } STATIC void @@ -410,8 +437,8 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) name[0], toCTRL(name[1]), (int)(len - 2), name + 2, PL_parser->in_my == KEY_state ? "state" : "my")); } else { - yyerror(Perl_form(aTHX_ "Can't use global %.*s in \"%s\"", (int) len, name, - PL_parser->in_my == KEY_state ? "state" : "my")); + yyerror_pv(Perl_form(aTHX_ "Can't use global %.*s in \"%s\"", (int) len, name, + PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8); } } @@ -1625,9 +1652,10 @@ S_finalize_op(pTHX_ OP* o) key = SvPV_const(*svp, keylen); if (!hv_fetch(GvHV(*fields), key, SvUTF8(*svp) ? -(I32)keylen : (I32)keylen, FALSE)) { - Perl_croak(aTHX_ "No such class field \"%s\" " - "in variable %s of type %s", - key, SvPV_nolen_const(lexname), HvNAME_get(SvSTASH(lexname))); + Perl_croak(aTHX_ "No such class field \"%"SVf"\" " + "in variable %"SVf" of type %"HEKf, + SVfARG(*svp), SVfARG(lexname), + HEKfARG(HvNAME_HEK(SvSTASH(lexname)))); } break; } @@ -1680,9 +1708,10 @@ S_finalize_op(pTHX_ OP* o) key = SvPV_const(*svp, keylen); if (!hv_fetch(GvHV(*fields), key, SvUTF8(*svp) ? -(I32)keylen : (I32)keylen, FALSE)) { - Perl_croak(aTHX_ "No such class field \"%s\" " - "in variable %s of type %s", - key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname))); + Perl_croak(aTHX_ "No such class field \"%"SVf"\" " + "in variable %"SVf" of type %"HEKf, + SVfARG(*svp), SVfARG(lexname), + HEKfARG(HvNAME_HEK(SvSTASH(lexname)))); } } break; @@ -4483,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); @@ -4495,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) @@ -5191,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; @@ -5214,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 @@ -6024,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'); @@ -7833,7 +7873,7 @@ Perl_ck_fun(pTHX_ OP *o) if (numargs == 1 && !(oa >> 4) && kid->op_type == OP_LIST && type != OP_SCALAR) { - return too_many_arguments(o,PL_op_desc[type]); + return too_many_arguments_pv(o,PL_op_desc[type], 0); } scalar(kid); break; @@ -7873,7 +7913,7 @@ Perl_ck_fun(pTHX_ OP *o) && ( !SvROK(cSVOPx_sv(kid)) || SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV ) ) - bad_type(numargs, "array", PL_op_desc[type], kid); + bad_type_pv(numargs, "array", PL_op_desc[type], 0, kid); /* Defer checks to run-time if we have a scalar arg */ if (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV) op_lvalue(kid, type); @@ -7898,7 +7938,7 @@ Perl_ck_fun(pTHX_ OP *o) *tokid = kid; } else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV) - bad_type(numargs, "hash", PL_op_desc[type], kid); + bad_type_pv(numargs, "hash", PL_op_desc[type], 0, kid); op_lvalue(kid, type); break; case OA_CVREF: @@ -7931,7 +7971,7 @@ Perl_ck_fun(pTHX_ OP *o) } else if (kid->op_type == OP_READLINE) { /* neophyte patrol: open(<FH>), close(<FH>) etc. */ - bad_type(numargs, "HANDLE", OP_DESC(o), kid); + bad_type_pv(numargs, "HANDLE", OP_DESC(o), 0, kid); } else { I32 flags = OPf_SPECIAL; @@ -8045,13 +8085,13 @@ Perl_ck_fun(pTHX_ OP *o) } #ifdef PERL_MAD if (kid && kid->op_type != OP_STUB) - return too_many_arguments(o,OP_DESC(o)); + return too_many_arguments_pv(o,OP_DESC(o), 0); o->op_private |= numargs; #else /* FIXME - should the numargs move as for the PERL_MAD case? */ o->op_private |= numargs; if (kid) - return too_many_arguments(o,OP_DESC(o)); + return too_many_arguments_pv(o,OP_DESC(o), 0); #endif listkids(o); } @@ -8071,7 +8111,7 @@ Perl_ck_fun(pTHX_ OP *o) while (oa & OA_OPTIONAL) oa >>= 4; if (oa && oa != OA_LIST) - return too_few_arguments(o,OP_DESC(o)); + return too_few_arguments_pv(o,OP_DESC(o), 0); } return o; } @@ -8202,7 +8242,7 @@ Perl_ck_grep(pTHX_ OP *o) kid = cLISTOPo->op_first->op_sibling; if (!kid || !kid->op_sibling) - return too_few_arguments(o,OP_DESC(o)); + return too_few_arguments_pv(o,OP_DESC(o), 0); for (kid = kid->op_sibling; kid; kid = kid->op_sibling) op_lvalue(kid, OP_GREPSTART); @@ -8929,7 +8969,7 @@ Perl_ck_split(pTHX_ OP *o) scalar(kid); if (kid->op_sibling) - return too_many_arguments(o,OP_DESC(o)); + return too_many_arguments_pv(o,OP_DESC(o), 0); return o; } @@ -8944,11 +8984,13 @@ Perl_ck_join(pTHX_ OP *o) if (kid && kid->op_type == OP_MATCH) { if (ckWARN(WARN_SYNTAX)) { const REGEXP *re = PM_GETRE(kPMOP); - const char *pmstr = re ? RX_PRECOMP_const(re) : "STRING"; - const STRLEN len = re ? RX_PRELEN(re) : 6; + const SV *msg = re + ? newSVpvn_flags( RX_PRECOMP_const(re), RX_PRELEN(re), + SVs_TEMP | ( RX_UTF8(re) ? SVf_UTF8 : 0 ) ) + : newSVpvs_flags( "STRING", SVs_TEMP ); Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "/%.*s/ should probably be written as \"%.*s\"", - (int)len, pmstr, (int)len, pmstr); + "/%"SVf"/ should probably be written as \"%"SVf"\"", + SVfARG(msg), SVfARG(msg)); } } return ck_fun(o); @@ -9135,7 +9177,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) o3 = aop; if (proto >= proto_end) - return too_many_arguments(entersubop, gv_ename(namegv)); + return too_many_arguments_sv(entersubop, gv_ename(namegv), 0); switch (*proto) { case ';': @@ -9160,9 +9202,9 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) proto++; arg++; if (o3->op_type != OP_REFGEN && o3->op_type != OP_UNDEF) - bad_type(arg, + bad_type_sv(arg, arg == 1 ? "block or sub {}" : "sub {}", - gv_ename(namegv), o3); + gv_ename(namegv), 0, o3); break; case '*': /* '*' allows any scalar type, including bareword */ @@ -9247,9 +9289,9 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) OP_READ, /* not entersub */ OP_LVALUE_NO_CROAK )) goto wrapref; - bad_type(arg, Perl_form(aTHX_ "one of %.*s", + bad_type_sv(arg, Perl_form(aTHX_ "one of %.*s", (int)(end - p), p), - gv_ename(namegv), o3); + gv_ename(namegv), 0, o3); } else goto oops; break; @@ -9257,13 +9299,13 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) if (o3->op_type == OP_RV2GV) goto wrapref; if (!contextclass) - bad_type(arg, "symbol", gv_ename(namegv), o3); + bad_type_sv(arg, "symbol", gv_ename(namegv), 0, o3); break; case '&': if (o3->op_type == OP_ENTERSUB) goto wrapref; if (!contextclass) - bad_type(arg, "subroutine entry", gv_ename(namegv), + bad_type_sv(arg, "subroutine entry", gv_ename(namegv), 0, o3); break; case '$': @@ -9279,7 +9321,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) OP_READ, /* not entersub */ OP_LVALUE_NO_CROAK )) goto wrapref; - bad_type(arg, "scalar", gv_ename(namegv), o3); + bad_type_sv(arg, "scalar", gv_ename(namegv), 0, o3); } break; case '@': @@ -9287,14 +9329,14 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) o3->op_type == OP_PADAV) goto wrapref; if (!contextclass) - bad_type(arg, "array", gv_ename(namegv), o3); + bad_type_sv(arg, "array", gv_ename(namegv), 0, o3); break; case '%': if (o3->op_type == OP_RV2HV || o3->op_type == OP_PADHV) goto wrapref; if (!contextclass) - bad_type(arg, "hash", gv_ename(namegv), o3); + bad_type_sv(arg, "hash", gv_ename(namegv), 0, o3); break; wrapref: { @@ -9339,7 +9381,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv) } if (!optional && proto_end > proto && (*proto != '@' && *proto != '%' && *proto != ';' && *proto != '_')) - return too_few_arguments(entersubop, gv_ename(namegv)); + return too_few_arguments_sv(entersubop, gv_ename(namegv), 0); return entersubop; } @@ -9399,7 +9441,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) aop = aop->op_sibling; } if (aop != cvop) - (void)too_many_arguments(entersubop, GvNAME(namegv)); + (void)too_many_arguments_pv(entersubop, GvNAME(namegv), 0); op_free(entersubop); switch(GvNAME(namegv)[2]) { @@ -9460,7 +9502,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) #ifdef PERL_MAD if (!PL_madskills || seenarg) #endif - (void)too_many_arguments(aop, GvNAME(namegv)); + (void)too_many_arguments_pv(aop, GvNAME(namegv), 0); op_free(aop); } return opnum == OP_RUNCV @@ -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 }; @@ -171,27 +171,29 @@ case 2: case 23: #line 262 "perly.y" { - (yyval.opval) = newSTATEOP(0, PVAL((ps[(1) - (2)].val.p_tkval)), (ps[(2) - (2)].val.opval)); + (yyval.opval) = newSTATEOP(SvUTF8(((SVOP*)(ps[(1) - (2)].val.p_tkval))->op_sv), + savepv(SvPVX(((SVOP*)(ps[(1) - (2)].val.p_tkval))->op_sv)), (ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.p_tkval), (ps[(2) - (2)].val.opval) ? cLISTOPx((yyval.opval))->op_first : (yyval.opval), 'L'); ;} break; case 24: -#line 268 "perly.y" +#line 269 "perly.y" { - (yyval.opval) = newSTATEOP(0, PVAL((ps[(1) - (2)].val.p_tkval)), (ps[(2) - (2)].val.opval)); + (yyval.opval) = newSTATEOP(SvUTF8(((SVOP*)(ps[(1) - (2)].val.p_tkval))->op_sv), + savepv(SvPVX(((SVOP*)(ps[(1) - (2)].val.p_tkval))->op_sv)), (ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.p_tkval), cLISTOPx((yyval.opval))->op_first, 'L'); ;} break; case 25: -#line 276 "perly.y" +#line 278 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 26: -#line 278 "perly.y" +#line 280 "perly.y" { (yyval.opval) = newOP(OP_NULL,0); TOKEN_GETMAD((ps[(1) - (1)].val.i_tkval),(yyval.opval),'p'); @@ -199,7 +201,7 @@ case 2: break; case 27: -#line 283 "perly.y" +#line 285 "perly.y" { CV *fmtcv = PL_compcv; SvREFCNT_inc_simple_void(PL_compcv); @@ -220,7 +222,7 @@ case 2: break; case 28: -#line 301 "perly.y" +#line 303 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); #ifdef MAD @@ -244,7 +246,7 @@ case 2: break; case 29: -#line 322 "perly.y" +#line 324 "perly.y" { /* Unimplemented "my sub foo { }" */ SvREFCNT_inc_simple_void(PL_compcv); @@ -259,7 +261,7 @@ case 2: break; case 30: -#line 334 "perly.y" +#line 336 "perly.y" { #ifdef MAD (yyval.opval) = package((ps[(3) - (4)].val.opval)); @@ -277,12 +279,12 @@ case 2: break; case 31: -#line 349 "perly.y" +#line 351 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ ;} break; case 32: -#line 351 "perly.y" +#line 353 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); #ifdef MAD @@ -300,7 +302,7 @@ case 2: break; case 33: -#line 366 "perly.y" +#line 368 "perly.y" { (yyval.opval) = block_end((ps[(3) - (7)].val.ival), newCONDOP(0, (ps[(4) - (7)].val.opval), op_scope((ps[(6) - (7)].val.opval)), (ps[(7) - (7)].val.opval))); @@ -312,7 +314,7 @@ case 2: break; case 34: -#line 375 "perly.y" +#line 377 "perly.y" { (yyval.opval) = block_end((ps[(3) - (7)].val.ival), newCONDOP(0, (ps[(4) - (7)].val.opval), op_scope((ps[(6) - (7)].val.opval)), (ps[(7) - (7)].val.opval))); @@ -324,7 +326,7 @@ case 2: break; case 35: -#line 384 "perly.y" +#line 386 "perly.y" { (yyval.opval) = block_end((ps[(3) - (7)].val.ival), newGIVENOP((ps[(5) - (7)].val.opval), op_scope((ps[(7) - (7)].val.opval)), (PADOFFSET)(ps[(4) - (7)].val.ival))); @@ -333,17 +335,17 @@ case 2: break; case 36: -#line 390 "perly.y" +#line 392 "perly.y" { (yyval.opval) = block_end((ps[(3) - (6)].val.ival), newWHENOP((ps[(4) - (6)].val.opval), op_scope((ps[(6) - (6)].val.opval)))); ;} break; case 37: -#line 392 "perly.y" +#line 394 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[(2) - (2)].val.opval))); ;} break; case 38: -#line 394 "perly.y" +#line 396 "perly.y" { (yyval.opval) = block_end((ps[(3) - (8)].val.ival), newWHILEOP(0, 1, (LOOP*)(OP*)NULL, @@ -356,7 +358,7 @@ case 2: break; case 39: -#line 404 "perly.y" +#line 406 "perly.y" { (yyval.opval) = block_end((ps[(3) - (8)].val.ival), newWHILEOP(0, 1, (LOOP*)(OP*)NULL, @@ -369,7 +371,7 @@ case 2: break; case 40: -#line 415 "perly.y" +#line 417 "perly.y" { OP *initop = IF_MAD((ps[(4) - (11)].val.opval) ? (ps[(4) - (11)].val.opval) : newOP(OP_NULL, 0), (ps[(4) - (11)].val.opval)); OP *forop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, @@ -392,7 +394,7 @@ case 2: break; case 41: -#line 435 "perly.y" +#line 437 "perly.y" { (yyval.opval) = block_end((ps[(3) - (9)].val.ival), newFOROP(0, (ps[(4) - (9)].val.opval), (ps[(6) - (9)].val.opval), (ps[(8) - (9)].val.opval), (ps[(9) - (9)].val.opval))); TOKEN_GETMAD((ps[(1) - (9)].val.i_tkval),(yyval.opval),'W'); @@ -404,7 +406,7 @@ case 2: break; case 42: -#line 444 "perly.y" +#line 446 "perly.y" { (yyval.opval) = block_end((ps[(4) - (8)].val.ival), newFOROP(0, op_lvalue((ps[(2) - (8)].val.opval), OP_ENTERLOOP), (ps[(5) - (8)].val.opval), (ps[(7) - (8)].val.opval), (ps[(8) - (8)].val.opval))); @@ -416,7 +418,7 @@ case 2: break; case 43: -#line 453 "perly.y" +#line 455 "perly.y" { (yyval.opval) = block_end((ps[(3) - (7)].val.ival), newFOROP(0, (OP*)NULL, (ps[(4) - (7)].val.opval), (ps[(6) - (7)].val.opval), (ps[(7) - (7)].val.opval))); @@ -428,7 +430,7 @@ case 2: break; case 44: -#line 462 "perly.y" +#line 464 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, @@ -437,7 +439,7 @@ case 2: break; case 45: -#line 468 "perly.y" +#line 470 "perly.y" { int save_3_latefree = (ps[(3) - (5)].val.opval)->op_latefree; (ps[(3) - (5)].val.opval)->op_latefree = 1; @@ -453,7 +455,7 @@ case 2: break; case 46: -#line 481 "perly.y" +#line 483 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, (LOOP*)(OP*)NULL, @@ -469,7 +471,7 @@ case 2: break; case 47: -#line 494 "perly.y" +#line 496 "perly.y" { PL_parser->expect = XSTATE; (yyval.opval) = (ps[(1) - (2)].val.opval); @@ -478,7 +480,7 @@ case 2: break; case 48: -#line 500 "perly.y" +#line 502 "perly.y" { PL_parser->expect = XSTATE; (yyval.opval) = IF_MAD(newOP(OP_NULL, 0), (OP*)NULL); @@ -488,45 +490,45 @@ case 2: break; case 49: -#line 510 "perly.y" +#line 512 "perly.y" { (yyval.opval) = (OP*)NULL; ;} break; case 50: -#line 512 "perly.y" +#line 514 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 51: -#line 514 "perly.y" +#line 516 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'i'); ;} break; case 52: -#line 518 "perly.y" +#line 520 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'i'); ;} break; case 53: -#line 522 "perly.y" +#line 524 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[(3) - (3)].val.opval)), (ps[(1) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'w'); ;} break; case 54: -#line 526 "perly.y" +#line 528 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'w'); ;} break; case 55: -#line 530 "perly.y" +#line 532 "perly.y" { (yyval.opval) = newFOROP(0, (OP*)NULL, (ps[(3) - (3)].val.opval), (ps[(1) - (3)].val.opval), (OP*)NULL); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'w'); PL_parser->copline = (line_t)IVAL((ps[(2) - (3)].val.i_tkval)); @@ -534,17 +536,17 @@ case 2: break; case 56: -#line 535 "perly.y" +#line 537 "perly.y" { (yyval.opval) = newWHENOP((ps[(3) - (3)].val.opval), op_scope((ps[(1) - (3)].val.opval))); ;} break; case 57: -#line 540 "perly.y" +#line 542 "perly.y" { (yyval.opval) = (OP*)NULL; ;} break; case 58: -#line 542 "perly.y" +#line 544 "perly.y" { ((ps[(2) - (2)].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[(2) - (2)].val.opval)); @@ -553,7 +555,7 @@ case 2: break; case 59: -#line 548 "perly.y" +#line 550 "perly.y" { PL_parser->copline = (line_t)IVAL((ps[(1) - (6)].val.i_tkval)); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[(3) - (6)].val.opval)), @@ -566,12 +568,12 @@ case 2: break; case 60: -#line 561 "perly.y" +#line 563 "perly.y" { (yyval.opval) = (OP*)NULL; ;} break; case 61: -#line 563 "perly.y" +#line 565 "perly.y" { (yyval.opval) = op_scope((ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); @@ -579,74 +581,74 @@ case 2: break; case 62: -#line 571 "perly.y" +#line 573 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); ;} break; case 63: -#line 577 "perly.y" +#line 579 "perly.y" { (yyval.opval) = (OP*)NULL; ;} break; case 65: -#line 583 "perly.y" +#line 585 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; ;} break; case 67: -#line 591 "perly.y" +#line 593 "perly.y" { (yyval.opval) = invert(scalar((ps[(1) - (1)].val.opval))); ;} break; case 68: -#line 596 "perly.y" +#line 598 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); intro_my(); ;} break; case 69: -#line 600 "perly.y" +#line 602 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); intro_my(); ;} break; case 70: -#line 604 "perly.y" +#line 606 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); intro_my(); ;} break; case 71: -#line 607 "perly.y" +#line 609 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 72: -#line 608 "perly.y" +#line 610 "perly.y" { (yyval.opval) = (OP*)NULL; ;} break; case 73: -#line 612 "perly.y" +#line 614 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); ;} break; case 74: -#line 618 "perly.y" +#line 620 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); ;} break; case 75: -#line 623 "perly.y" +#line 625 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); ;} break; case 76: -#line 628 "perly.y" +#line 630 "perly.y" { const char *const name = SvPV_nolen_const(((SVOP*)(ps[(1) - (1)].val.opval))->op_sv); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT") || strEQ(name, "CHECK") @@ -656,24 +658,24 @@ case 2: break; case 77: -#line 638 "perly.y" +#line 640 "perly.y" { (yyval.opval) = (OP*)NULL; ;} break; case 79: -#line 644 "perly.y" +#line 646 "perly.y" { (yyval.opval) = (OP*)NULL; ;} break; case 80: -#line 646 "perly.y" +#line 648 "perly.y" { (yyval.opval) = (ps[(2) - (2)].val.opval); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),':'); ;} break; case 81: -#line 650 "perly.y" +#line 652 "perly.y" { (yyval.opval) = IF_MAD( newOP(OP_NULL, 0), (OP*)NULL @@ -683,14 +685,14 @@ case 2: break; case 82: -#line 660 "perly.y" +#line 662 "perly.y" { (yyval.opval) = (ps[(2) - (2)].val.opval); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),':'); ;} break; case 83: -#line 664 "perly.y" +#line 666 "perly.y" { (yyval.opval) = IF_MAD( newOP(OP_NULL, 0), (OP*)NULL @@ -700,12 +702,12 @@ case 2: break; case 84: -#line 673 "perly.y" +#line 675 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 85: -#line 674 "perly.y" +#line 676 "perly.y" { (yyval.opval) = IF_MAD( newOP(OP_NULL,0), (OP*)NULL @@ -716,28 +718,28 @@ case 2: break; case 86: -#line 685 "perly.y" +#line 687 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 87: -#line 689 "perly.y" +#line 691 "perly.y" { (yyval.opval) = newLOGOP(IVAL((ps[(2) - (3)].val.i_tkval)), 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 88: -#line 693 "perly.y" +#line 695 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 90: -#line 701 "perly.y" +#line 703 "perly.y" { #ifdef MAD OP* op = newNULLLIST(); @@ -750,7 +752,7 @@ case 2: break; case 91: -#line 711 "perly.y" +#line 713 "perly.y" { OP* term = (ps[(3) - (3)].val.opval); DO_MAD( @@ -762,7 +764,7 @@ case 2: break; case 93: -#line 724 "perly.y" +#line 726 "perly.y" { (yyval.opval) = convert(IVAL((ps[(1) - (3)].val.i_tkval)), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF(IVAL((ps[(1) - (3)].val.i_tkval)),(ps[(2) - (3)].val.opval)), (ps[(3) - (3)].val.opval)) ); TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'o'); @@ -770,7 +772,7 @@ case 2: break; case 94: -#line 729 "perly.y" +#line 731 "perly.y" { (yyval.opval) = convert(IVAL((ps[(1) - (5)].val.i_tkval)), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF(IVAL((ps[(1) - (5)].val.i_tkval)),(ps[(3) - (5)].val.opval)), (ps[(4) - (5)].val.opval)) ); TOKEN_GETMAD((ps[(1) - (5)].val.i_tkval),(yyval.opval),'o'); @@ -780,7 +782,7 @@ case 2: break; case 95: -#line 736 "perly.y" +#line 738 "perly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[(1) - (6)].val.opval)), (ps[(5) - (6)].val.opval)), @@ -792,7 +794,7 @@ case 2: break; case 96: -#line 745 "perly.y" +#line 747 "perly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[(1) - (3)].val.opval)), newUNOP(OP_METHOD, 0, (ps[(3) - (3)].val.opval)))); @@ -801,7 +803,7 @@ case 2: break; case 97: -#line 751 "perly.y" +#line 753 "perly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[(2) - (3)].val.opval), (ps[(3) - (3)].val.opval)), @@ -810,7 +812,7 @@ case 2: break; case 98: -#line 757 "perly.y" +#line 759 "perly.y" { (yyval.opval) = convert(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[(2) - (5)].val.opval), (ps[(4) - (5)].val.opval)), @@ -821,14 +823,14 @@ case 2: break; case 99: -#line 765 "perly.y" +#line 767 "perly.y" { (yyval.opval) = convert(IVAL((ps[(1) - (2)].val.i_tkval)), 0, (ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 100: -#line 769 "perly.y" +#line 771 "perly.y" { (yyval.opval) = convert(IVAL((ps[(1) - (4)].val.i_tkval)), 0, (ps[(3) - (4)].val.opval)); TOKEN_GETMAD((ps[(1) - (4)].val.i_tkval),(yyval.opval),'o'); TOKEN_GETMAD((ps[(2) - (4)].val.i_tkval),(yyval.opval),'('); @@ -837,13 +839,13 @@ case 2: break; case 101: -#line 775 "perly.y" +#line 777 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[(2) - (3)].val.ival), 0, (OP*)NULL, (ps[(3) - (3)].val.opval)); ;} break; case 102: -#line 778 "perly.y" +#line 780 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[(4) - (5)].val.opval), (ps[(5) - (5)].val.opval)), (ps[(1) - (5)].val.opval))); @@ -851,7 +853,7 @@ case 2: break; case 105: -#line 793 "perly.y" +#line 795 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[(1) - (5)].val.opval), scalar((ps[(3) - (5)].val.opval))); PL_parser->expect = XOPERATOR; TOKEN_GETMAD((ps[(2) - (5)].val.i_tkval),(yyval.opval),'{'); @@ -861,7 +863,7 @@ case 2: break; case 106: -#line 800 "perly.y" +#line 802 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[(1) - (4)].val.opval)), scalar((ps[(3) - (4)].val.opval))); TOKEN_GETMAD((ps[(2) - (4)].val.i_tkval),(yyval.opval),'['); TOKEN_GETMAD((ps[(4) - (4)].val.i_tkval),(yyval.opval),']'); @@ -869,7 +871,7 @@ case 2: break; case 107: -#line 805 "perly.y" +#line 807 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[(1) - (5)].val.opval)),OP_RV2AV), scalar((ps[(4) - (5)].val.opval))); @@ -880,7 +882,7 @@ case 2: break; case 108: -#line 813 "perly.y" +#line 815 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[(1) - (4)].val.opval)),OP_RV2AV), scalar((ps[(3) - (4)].val.opval))); @@ -890,7 +892,7 @@ case 2: break; case 109: -#line 820 "perly.y" +#line 822 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[(1) - (5)].val.opval)), jmaybe((ps[(3) - (5)].val.opval))); PL_parser->expect = XOPERATOR; TOKEN_GETMAD((ps[(2) - (5)].val.i_tkval),(yyval.opval),'{'); @@ -900,7 +902,7 @@ case 2: break; case 110: -#line 827 "perly.y" +#line 829 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[(1) - (6)].val.opval)),OP_RV2HV), jmaybe((ps[(4) - (6)].val.opval))); @@ -913,7 +915,7 @@ case 2: break; case 111: -#line 837 "perly.y" +#line 839 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[(1) - (5)].val.opval)),OP_RV2HV), jmaybe((ps[(3) - (5)].val.opval))); @@ -925,7 +927,7 @@ case 2: break; case 112: -#line 846 "perly.y" +#line 848 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[(1) - (4)].val.opval)))); TOKEN_GETMAD((ps[(2) - (4)].val.i_tkval),(yyval.opval),'a'); @@ -935,7 +937,7 @@ case 2: break; case 113: -#line 853 "perly.y" +#line 855 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[(4) - (5)].val.opval), newCVREF(0, scalar((ps[(1) - (5)].val.opval))))); @@ -946,7 +948,7 @@ case 2: break; case 114: -#line 862 "perly.y" +#line 864 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[(3) - (4)].val.opval), newCVREF(0, scalar((ps[(1) - (4)].val.opval))))); @@ -956,7 +958,7 @@ case 2: break; case 115: -#line 869 "perly.y" +#line 871 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[(1) - (3)].val.opval)))); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'('); @@ -965,7 +967,7 @@ case 2: break; case 116: -#line 875 "perly.y" +#line 877 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[(5) - (6)].val.opval), (ps[(2) - (6)].val.opval)); TOKEN_GETMAD((ps[(1) - (6)].val.i_tkval),(yyval.opval),'('); TOKEN_GETMAD((ps[(3) - (6)].val.i_tkval),(yyval.opval),')'); @@ -975,7 +977,7 @@ case 2: break; case 117: -#line 882 "perly.y" +#line 884 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[(3) - (4)].val.opval), (ps[(1) - (4)].val.opval)); TOKEN_GETMAD((ps[(2) - (4)].val.i_tkval),(yyval.opval),'['); TOKEN_GETMAD((ps[(4) - (4)].val.i_tkval),(yyval.opval),']'); @@ -983,7 +985,7 @@ case 2: break; case 118: -#line 887 "perly.y" +#line 889 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[(4) - (5)].val.opval), (OP*)NULL); TOKEN_GETMAD((ps[(1) - (5)].val.i_tkval),(yyval.opval),'('); TOKEN_GETMAD((ps[(2) - (5)].val.i_tkval),(yyval.opval),')'); @@ -993,21 +995,21 @@ case 2: break; case 119: -#line 897 "perly.y" +#line 899 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[(1) - (3)].val.opval), IVAL((ps[(2) - (3)].val.i_tkval)), (ps[(3) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 120: -#line 901 "perly.y" +#line 903 "perly.y" { (yyval.opval) = newBINOP(IVAL((ps[(2) - (3)].val.i_tkval)), 0, scalar((ps[(1) - (3)].val.opval)), scalar((ps[(3) - (3)].val.opval))); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 121: -#line 905 "perly.y" +#line 907 "perly.y" { if (IVAL((ps[(2) - (3)].val.i_tkval)) != OP_REPEAT) scalar((ps[(1) - (3)].val.opval)); (yyval.opval) = newBINOP(IVAL((ps[(2) - (3)].val.i_tkval)), 0, (ps[(1) - (3)].val.opval), scalar((ps[(3) - (3)].val.opval))); @@ -1016,49 +1018,49 @@ case 2: break; case 122: -#line 911 "perly.y" +#line 913 "perly.y" { (yyval.opval) = newBINOP(IVAL((ps[(2) - (3)].val.i_tkval)), 0, scalar((ps[(1) - (3)].val.opval)), scalar((ps[(3) - (3)].val.opval))); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 123: -#line 915 "perly.y" +#line 917 "perly.y" { (yyval.opval) = newBINOP(IVAL((ps[(2) - (3)].val.i_tkval)), 0, scalar((ps[(1) - (3)].val.opval)), scalar((ps[(3) - (3)].val.opval))); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 124: -#line 919 "perly.y" +#line 921 "perly.y" { (yyval.opval) = newBINOP(IVAL((ps[(2) - (3)].val.i_tkval)), 0, scalar((ps[(1) - (3)].val.opval)), scalar((ps[(3) - (3)].val.opval))); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 125: -#line 923 "perly.y" +#line 925 "perly.y" { (yyval.opval) = newBINOP(IVAL((ps[(2) - (3)].val.i_tkval)), 0, scalar((ps[(1) - (3)].val.opval)), scalar((ps[(3) - (3)].val.opval))); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 126: -#line 927 "perly.y" +#line 929 "perly.y" { (yyval.opval) = newBINOP(IVAL((ps[(2) - (3)].val.i_tkval)), 0, scalar((ps[(1) - (3)].val.opval)), scalar((ps[(3) - (3)].val.opval))); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 127: -#line 931 "perly.y" +#line 933 "perly.y" { (yyval.opval) = newBINOP(IVAL((ps[(2) - (3)].val.i_tkval)), 0, scalar((ps[(1) - (3)].val.opval)), scalar((ps[(3) - (3)].val.opval))); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 128: -#line 935 "perly.y" +#line 937 "perly.y" { (yyval.opval) = newRANGE(IVAL((ps[(2) - (3)].val.i_tkval)), scalar((ps[(1) - (3)].val.opval)), scalar((ps[(3) - (3)].val.opval))); DO_MAD({ @@ -1073,28 +1075,28 @@ case 2: break; case 129: -#line 947 "perly.y" +#line 949 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 130: -#line 951 "perly.y" +#line 953 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 131: -#line 955 "perly.y" +#line 957 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'o'); ;} break; case 132: -#line 959 "perly.y" +#line 961 "perly.y" { (yyval.opval) = bind_match(IVAL((ps[(2) - (3)].val.i_tkval)), (ps[(1) - (3)].val.opval), (ps[(3) - (3)].val.opval)); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval), ((yyval.opval)->op_type == OP_NOT @@ -1104,14 +1106,14 @@ case 2: break; case 133: -#line 969 "perly.y" +#line 971 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[(2) - (2)].val.opval))); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 134: -#line 973 "perly.y" +#line 975 "perly.y" { (yyval.opval) = IF_MAD( newUNOP(OP_NULL, 0, (ps[(2) - (2)].val.opval)), (ps[(2) - (2)].val.opval) @@ -1121,21 +1123,21 @@ case 2: break; case 135: -#line 980 "perly.y" +#line 982 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[(2) - (2)].val.opval))); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 136: -#line 984 "perly.y" +#line 986 "perly.y" { (yyval.opval) = newUNOP(OP_COMPLEMENT, 0, scalar((ps[(2) - (2)].val.opval))); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 137: -#line 988 "perly.y" +#line 990 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[(1) - (2)].val.opval)), OP_POSTINC)); TOKEN_GETMAD((ps[(2) - (2)].val.i_tkval),(yyval.opval),'o'); @@ -1143,7 +1145,7 @@ case 2: break; case 138: -#line 993 "perly.y" +#line 995 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[(1) - (2)].val.opval)), OP_POSTDEC)); TOKEN_GETMAD((ps[(2) - (2)].val.i_tkval),(yyval.opval),'o'); @@ -1151,7 +1153,7 @@ case 2: break; case 139: -#line 998 "perly.y" +#line 1000 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[(2) - (2)].val.opval)), OP_PREINC)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); @@ -1159,7 +1161,7 @@ case 2: break; case 140: -#line 1003 "perly.y" +#line 1005 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[(2) - (2)].val.opval)), OP_PREDEC)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); @@ -1167,7 +1169,7 @@ case 2: break; case 141: -#line 1012 "perly.y" +#line 1014 "perly.y" { (yyval.opval) = newANONLIST((ps[(2) - (3)].val.opval)); TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'['); TOKEN_GETMAD((ps[(3) - (3)].val.i_tkval),(yyval.opval),']'); @@ -1175,7 +1177,7 @@ case 2: break; case 142: -#line 1017 "perly.y" +#line 1019 "perly.y" { (yyval.opval) = newANONLIST((OP*)NULL); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'['); TOKEN_GETMAD((ps[(2) - (2)].val.i_tkval),(yyval.opval),']'); @@ -1183,7 +1185,7 @@ case 2: break; case 143: -#line 1022 "perly.y" +#line 1024 "perly.y" { (yyval.opval) = newANONHASH((ps[(2) - (4)].val.opval)); TOKEN_GETMAD((ps[(1) - (4)].val.i_tkval),(yyval.opval),'{'); TOKEN_GETMAD((ps[(3) - (4)].val.i_tkval),(yyval.opval),';'); @@ -1192,7 +1194,7 @@ case 2: break; case 144: -#line 1028 "perly.y" +#line 1030 "perly.y" { (yyval.opval) = newANONHASH((OP*)NULL); TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'{'); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),';'); @@ -1201,7 +1203,7 @@ case 2: break; case 145: -#line 1034 "perly.y" +#line 1036 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[(2) - (5)].val.ival), (ps[(3) - (5)].val.opval), (ps[(4) - (5)].val.opval), (ps[(5) - (5)].val.opval)); TOKEN_GETMAD((ps[(1) - (5)].val.i_tkval),(yyval.opval),'o'); @@ -1211,21 +1213,21 @@ case 2: break; case 146: -#line 1045 "perly.y" +#line 1047 "perly.y" { (yyval.opval) = dofile((ps[(2) - (2)].val.opval), IVAL((ps[(1) - (2)].val.i_tkval))); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 147: -#line 1049 "perly.y" +#line 1051 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[(2) - (2)].val.opval))); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'D'); ;} break; case 148: -#line 1053 "perly.y" +#line 1055 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, op_prepend_elem(OP_LIST, @@ -1240,7 +1242,7 @@ case 2: break; case 149: -#line 1065 "perly.y" +#line 1067 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, op_append_elem(OP_LIST, @@ -1256,7 +1258,7 @@ case 2: break; case 150: -#line 1078 "perly.y" +#line 1080 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, op_prepend_elem(OP_LIST, scalar(newCVREF(0,scalar((ps[(2) - (4)].val.opval)))), (OP*)NULL)); dep(); @@ -1267,7 +1269,7 @@ case 2: break; case 151: -#line 1086 "perly.y" +#line 1088 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, op_prepend_elem(OP_LIST, (ps[(4) - (5)].val.opval), @@ -1279,7 +1281,7 @@ case 2: break; case 156: -#line 1102 "perly.y" +#line 1104 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[(1) - (5)].val.opval), (ps[(3) - (5)].val.opval), (ps[(5) - (5)].val.opval)); TOKEN_GETMAD((ps[(2) - (5)].val.i_tkval),(yyval.opval),'?'); TOKEN_GETMAD((ps[(4) - (5)].val.i_tkval),(yyval.opval),':'); @@ -1287,26 +1289,26 @@ case 2: break; case 157: -#line 1107 "perly.y" +#line 1109 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, op_lvalue((ps[(2) - (2)].val.opval),OP_REFGEN)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 158: -#line 1111 "perly.y" +#line 1113 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 159: -#line 1113 "perly.y" +#line 1115 "perly.y" { (yyval.opval) = localize((ps[(2) - (2)].val.opval),IVAL((ps[(1) - (2)].val.i_tkval))); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'k'); ;} break; case 160: -#line 1117 "perly.y" +#line 1119 "perly.y" { (yyval.opval) = sawparens(IF_MAD(newUNOP(OP_NULL,0,(ps[(2) - (3)].val.opval)), (ps[(2) - (3)].val.opval))); TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'('); TOKEN_GETMAD((ps[(3) - (3)].val.i_tkval),(yyval.opval),')'); @@ -1314,12 +1316,12 @@ case 2: break; case 161: -#line 1122 "perly.y" +#line 1124 "perly.y" { (yyval.opval) = IF_MAD(newUNOP(OP_NULL,0,(ps[(1) - (1)].val.opval)), (ps[(1) - (1)].val.opval)); ;} break; case 162: -#line 1124 "perly.y" +#line 1126 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'('); TOKEN_GETMAD((ps[(2) - (2)].val.i_tkval),(yyval.opval),')'); @@ -1327,37 +1329,37 @@ case 2: break; case 163: -#line 1129 "perly.y" +#line 1131 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 164: -#line 1131 "perly.y" +#line 1133 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 165: -#line 1133 "perly.y" +#line 1135 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 166: -#line 1135 "perly.y" +#line 1137 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 167: -#line 1137 "perly.y" +#line 1139 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[(1) - (1)].val.opval), OP_AV2ARYLEN));;} break; case 168: -#line 1139 "perly.y" +#line 1141 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 169: -#line 1141 "perly.y" +#line 1143 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1369,7 +1371,7 @@ case 2: break; case 170: -#line 1150 "perly.y" +#line 1152 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1383,17 +1385,17 @@ case 2: break; case 171: -#line 1161 "perly.y" +#line 1163 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 172: -#line 1163 "perly.y" +#line 1165 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[(1) - (1)].val.opval))); ;} break; case 173: -#line 1165 "perly.y" +#line 1167 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[(1) - (3)].val.opval))); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'('); TOKEN_GETMAD((ps[(3) - (3)].val.i_tkval),(yyval.opval),')'); @@ -1401,7 +1403,7 @@ case 2: break; case 174: -#line 1170 "perly.y" +#line 1172 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[(3) - (4)].val.opval), scalar((ps[(1) - (4)].val.opval)))); @@ -1417,7 +1419,7 @@ case 2: break; case 175: -#line 1183 "perly.y" +#line 1185 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[(3) - (3)].val.opval), scalar((ps[(2) - (3)].val.opval)))); TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'o'); @@ -1425,7 +1427,7 @@ case 2: break; case 176: -#line 1188 "perly.y" +#line 1190 "perly.y" { (yyval.opval) = newOP(IVAL((ps[(1) - (1)].val.i_tkval)), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; TOKEN_GETMAD((ps[(1) - (1)].val.i_tkval),(yyval.opval),'o'); @@ -1433,74 +1435,74 @@ case 2: break; case 177: -#line 1193 "perly.y" +#line 1195 "perly.y" { (yyval.opval) = newLOOPEX(IVAL((ps[(1) - (2)].val.i_tkval)),(ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 178: -#line 1197 "perly.y" +#line 1199 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[(2) - (2)].val.opval))); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 179: -#line 1201 "perly.y" +#line 1203 "perly.y" { (yyval.opval) = newOP(IVAL((ps[(1) - (1)].val.i_tkval)), 0); TOKEN_GETMAD((ps[(1) - (1)].val.i_tkval),(yyval.opval),'o'); ;} break; case 180: -#line 1205 "perly.y" +#line 1207 "perly.y" { (yyval.opval) = newUNOP(IVAL((ps[(1) - (2)].val.i_tkval)), 0, (ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 181: -#line 1209 "perly.y" +#line 1211 "perly.y" { (yyval.opval) = newUNOP(IVAL((ps[(1) - (2)].val.i_tkval)), 0, (ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 182: -#line 1213 "perly.y" +#line 1215 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[(1) - (1)].val.i_tkval) ? OPf_SPECIAL : 0); TOKEN_GETMAD((ps[(1) - (1)].val.i_tkval),(yyval.opval),'o'); ;} break; case 183: -#line 1217 "perly.y" +#line 1219 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[(1) - (2)].val.i_tkval) ? OPf_SPECIAL : 0, (ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'o'); ;} break; case 184: -#line 1221 "perly.y" +#line 1223 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[(1) - (1)].val.opval))); ;} break; case 185: -#line 1223 "perly.y" +#line 1225 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[(2) - (2)].val.opval), scalar((ps[(1) - (2)].val.opval)))); ;} break; case 186: -#line 1226 "perly.y" +#line 1228 "perly.y" { (yyval.opval) = newOP(IVAL((ps[(1) - (1)].val.i_tkval)), 0); TOKEN_GETMAD((ps[(1) - (1)].val.i_tkval),(yyval.opval),'o'); ;} break; case 187: -#line 1230 "perly.y" +#line 1232 "perly.y" { (yyval.opval) = newOP(IVAL((ps[(1) - (3)].val.i_tkval)), 0); TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'o'); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'('); @@ -1509,12 +1511,12 @@ case 2: break; case 188: -#line 1236 "perly.y" +#line 1238 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 189: -#line 1238 "perly.y" +#line 1240 "perly.y" { (yyval.opval) = (ps[(1) - (3)].val.opval); TOKEN_GETMAD((ps[(2) - (3)].val.i_tkval),(yyval.opval),'('); TOKEN_GETMAD((ps[(3) - (3)].val.i_tkval),(yyval.opval),')'); @@ -1522,13 +1524,13 @@ case 2: break; case 190: -#line 1243 "perly.y" +#line 1245 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[(1) - (1)].val.opval))); ;} break; case 191: -#line 1246 "perly.y" +#line 1248 "perly.y" { (yyval.opval) = (IVAL((ps[(1) - (3)].val.i_tkval)) == OP_NOT) ? newUNOP(IVAL((ps[(1) - (3)].val.i_tkval)), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP(IVAL((ps[(1) - (3)].val.i_tkval)), OPf_SPECIAL); @@ -1540,7 +1542,7 @@ case 2: break; case 192: -#line 1255 "perly.y" +#line 1257 "perly.y" { (yyval.opval) = newUNOP(IVAL((ps[(1) - (4)].val.i_tkval)), 0, (ps[(3) - (4)].val.opval)); TOKEN_GETMAD((ps[(1) - (4)].val.i_tkval),(yyval.opval),'o'); TOKEN_GETMAD((ps[(2) - (4)].val.i_tkval),(yyval.opval),'('); @@ -1549,7 +1551,7 @@ case 2: break; case 193: -#line 1261 "perly.y" +#line 1263 "perly.y" { (yyval.opval) = pmruntime((ps[(1) - (4)].val.opval), (ps[(3) - (4)].val.opval), 1); TOKEN_GETMAD((ps[(2) - (4)].val.i_tkval),(yyval.opval),'('); TOKEN_GETMAD((ps[(4) - (4)].val.i_tkval),(yyval.opval),')'); @@ -1557,7 +1559,7 @@ case 2: break; case 196: -#line 1268 "perly.y" +#line 1270 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -1566,7 +1568,7 @@ case 2: break; case 198: -#line 1278 "perly.y" +#line 1280 "perly.y" { (yyval.opval) = my_attrs((ps[(2) - (3)].val.opval),(ps[(3) - (3)].val.opval)); DO_MAD( token_getmad((ps[(1) - (3)].val.i_tkval),(yyval.opval),'d'); @@ -1577,14 +1579,14 @@ case 2: break; case 199: -#line 1286 "perly.y" +#line 1288 "perly.y" { (yyval.opval) = localize((ps[(2) - (2)].val.opval),IVAL((ps[(1) - (2)].val.i_tkval))); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'d'); ;} break; case 200: -#line 1293 "perly.y" +#line 1295 "perly.y" { (yyval.opval) = sawparens((ps[(2) - (3)].val.opval)); TOKEN_GETMAD((ps[(1) - (3)].val.i_tkval),(yyval.opval),'('); TOKEN_GETMAD((ps[(3) - (3)].val.i_tkval),(yyval.opval),')'); @@ -1592,7 +1594,7 @@ case 2: break; case 201: -#line 1298 "perly.y" +#line 1300 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'('); TOKEN_GETMAD((ps[(2) - (2)].val.i_tkval),(yyval.opval),')'); @@ -1600,119 +1602,119 @@ case 2: break; case 202: -#line 1303 "perly.y" +#line 1305 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 203: -#line 1305 "perly.y" +#line 1307 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 204: -#line 1307 "perly.y" +#line 1309 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 205: -#line 1312 "perly.y" +#line 1314 "perly.y" { (yyval.opval) = (OP*)NULL; ;} break; case 206: -#line 1314 "perly.y" +#line 1316 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 207: -#line 1318 "perly.y" +#line 1320 "perly.y" { (yyval.opval) = (OP*)NULL; ;} break; case 208: -#line 1320 "perly.y" +#line 1322 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; case 209: -#line 1324 "perly.y" +#line 1326 "perly.y" { (yyval.i_tkval) = (ps[(1) - (1)].val.i_tkval); ;} break; case 210: -#line 1326 "perly.y" +#line 1328 "perly.y" { munge_qwlist_to_paren_list((ps[(1) - (1)].val.opval)); ;} break; case 211: -#line 1328 "perly.y" +#line 1330 "perly.y" { (yyval.i_tkval) = (ps[(3) - (3)].val.i_tkval); ;} break; case 212: -#line 1334 "perly.y" +#line 1336 "perly.y" { PL_parser->in_my = 0; (yyval.opval) = my((ps[(1) - (1)].val.opval)); ;} break; case 213: -#line 1338 "perly.y" +#line 1340 "perly.y" { (yyval.opval) = newCVREF(IVAL((ps[(1) - (2)].val.i_tkval)),(ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'&'); ;} break; case 214: -#line 1344 "perly.y" +#line 1346 "perly.y" { (yyval.opval) = newSVREF((ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'$'); ;} break; case 215: -#line 1350 "perly.y" +#line 1352 "perly.y" { (yyval.opval) = newAVREF((ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'@'); ;} break; case 216: -#line 1356 "perly.y" +#line 1358 "perly.y" { (yyval.opval) = newHVREF((ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'%'); ;} break; case 217: -#line 1362 "perly.y" +#line 1364 "perly.y" { (yyval.opval) = newAVREF((ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'l'); ;} break; case 218: -#line 1368 "perly.y" +#line 1370 "perly.y" { (yyval.opval) = newGVREF(0,(ps[(2) - (2)].val.opval)); TOKEN_GETMAD((ps[(1) - (2)].val.i_tkval),(yyval.opval),'*'); ;} break; case 219: -#line 1375 "perly.y" +#line 1377 "perly.y" { (yyval.opval) = scalar((ps[(1) - (1)].val.opval)); ;} break; case 220: -#line 1377 "perly.y" +#line 1379 "perly.y" { (yyval.opval) = scalar((ps[(1) - (1)].val.opval)); ;} break; case 221: -#line 1379 "perly.y" +#line 1381 "perly.y" { (yyval.opval) = op_scope((ps[(1) - (1)].val.opval)); ;} break; case 222: -#line 1382 "perly.y" +#line 1384 "perly.y" { (yyval.opval) = (ps[(1) - (1)].val.opval); ;} break; @@ -1723,6 +1725,6 @@ case 2: /* Generated from: - * 653e5740260a91fc0511942c124de9498176ffc3862f4d9d4523d3bafbace9c6 perly.y + * 047d7d5048e78a17bc586b7bb9a0f0e9dedd5cd43b30e486482b1ff8f955ddcb perly.y * 53f57d7143a42b3c008841a14d158bcf9cab64b2904b07ef5e95051fe9a8a875 regen_perly.pl * ex: set ro: */ @@ -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: @@ -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: */ @@ -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: */ @@ -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'); } ; diff --git a/pod/perlvar.pod b/pod/perlvar.pod index ea1f601a80..c09aea5202 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -1341,12 +1341,10 @@ with every read. If a record is larger than the record size you've set, you'll get the record back in pieces. Trying to set the record size to zero or less will cause reading in the (rest of the) whole file. -On VMS, record reads are done with the equivalent of C<sysread>, -so it's best not to mix record and non-record reads on the same -file. (This is unlikely to be a problem, because any file you'd -want to read in record mode is probably unusable in line mode.) -Non-VMS systems do normal I/O, so it's safe to mix record and -non-record reads of a file. +On VMS only, record reads bypass PerlIO layers and any associated +buffering,so you must not mix record and non-record reads on the +same filehandle. Record mode mixes with line mode only when the +same buffering layer is in use for both modes. If you perform a record read on a FILE with an encoding layer such as C<:encoding(latin1)> or C<:utf8>, you may get an invalid string as a @@ -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 @@ -5726,13 +5726,20 @@ STATIC void S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp #define PERL_ARGS_ASSERT_APPLY_ATTRS_MY \ assert(stash); assert(target); assert(imopsp) -STATIC void S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid) +STATIC void S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP *kid) __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3) - __attribute__nonnull__(pTHX_4); -#define PERL_ARGS_ASSERT_BAD_TYPE \ + __attribute__nonnull__(pTHX_5); +#define PERL_ARGS_ASSERT_BAD_TYPE_PV \ assert(t); assert(name); assert(kid) +STATIC void S_bad_type_sv(pTHX_ I32 n, const char *t, SV *namesv, U32 flags, const OP *kid) + __attribute__nonnull__(pTHX_2) + __attribute__nonnull__(pTHX_3) + __attribute__nonnull__(pTHX_5); +#define PERL_ARGS_ASSERT_BAD_TYPE_SV \ + assert(t); assert(namesv); assert(kid) + STATIC void S_cop_free(pTHX_ COP *cop) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_COP_FREE \ @@ -5760,7 +5767,7 @@ STATIC OP* S_fold_constants(pTHX_ OP *o) STATIC OP* S_force_list(pTHX_ OP* arg); STATIC OP* S_gen_constant_list(pTHX_ OP* o); -STATIC const char* S_gv_ename(pTHX_ GV *gv) +STATIC SV* S_gv_ename(pTHX_ GV *gv) __attribute__nonnull__(pTHX_1); #define PERL_ARGS_ASSERT_GV_ENAME \ assert(gv) @@ -5869,19 +5876,33 @@ STATIC void S_simplify_sort(pTHX_ OP *o) #define PERL_ARGS_ASSERT_SIMPLIFY_SORT \ assert(o) -STATIC OP* S_too_few_arguments(pTHX_ OP *o, const char* name) +STATIC OP* S_too_few_arguments_pv(pTHX_ OP *o, const char* name, U32 flags) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); -#define PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS \ +#define PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS_PV \ assert(o); assert(name) -STATIC OP* S_too_many_arguments(pTHX_ OP *o, const char* name) +STATIC OP* S_too_few_arguments_sv(pTHX_ OP *o, SV* namesv, U32 flags) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS_SV \ + assert(o); assert(namesv) + +STATIC OP* S_too_many_arguments_pv(pTHX_ OP *o, const char* name, U32 flags) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); -#define PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS \ +#define PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_PV \ assert(o); assert(name) +STATIC OP* S_too_many_arguments_sv(pTHX_ OP *o, SV* namesv, U32 flags) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); +#define PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_SV \ + assert(o); assert(namesv) + # if defined(USE_ITHREADS) STATIC void S_forget_pmop(pTHX_ PMOP *const o, U32 flags) __attribute__nonnull__(pTHX_1); @@ -6022,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) @@ -6042,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 \ @@ -6056,6 +6056,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv) sv_unmagic(sv, PERL_MAGIC_backref); mg_free(sv); } + SvMAGICAL_off(sv); if (type == SVt_PVMG && SvPAD_TYPED(sv)) SvREFCNT_dec(SvSTASH(sv)); } diff --git a/t/lib/charnames/alias b/t/lib/charnames/alias index fb1a914fda..75280be7b3 100644 --- a/t/lib/charnames/alias +++ b/t/lib/charnames/alias @@ -338,3 +338,11 @@ charnames::viacode(0x41); EXPECT OPTIONS regex $ +######## +# NAME no extraneous warning [perl #11560] +use warnings; +use charnames (); +print charnames::viacode(0x80), "\n"; +EXPECT +OPTIONS regex +PADDING CHARACTER diff --git a/t/lib/warnings/op b/t/lib/warnings/op index 8f579201eb..de74d2e360 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -857,7 +857,7 @@ use open qw( :utf8 :std ); use warnings; eval "sub fòò (\$\0) {}"; EXPECT -Illegal character in prototype for main::fòò : $\x{0} at (eval 1) line 1. +Illegal character in prototype for main::fòò : $\0 at (eval 1) line 1. ######## # op.c use utf8; @@ -865,7 +865,7 @@ use open qw( :utf8 :std ); use warnings; eval "sub foo (\0) {}"; EXPECT -Illegal character in prototype for main::foo : \x{0} at (eval 1) line 1. +Illegal character in prototype for main::foo : \0 at (eval 1) line 1. ######## # op.c use utf8; @@ -882,7 +882,21 @@ use open qw( :utf8 :std ); use warnings; BEGIN { eval "sub foo (\0) {}"; } EXPECT -Illegal character in prototype for main::foo : \x{0} at (eval 1) line 1. +Illegal character in prototype for main::foo : \0 at (eval 1) line 1. +######## +# op.c +use warnings; +eval "sub foo (\xAB) {}"; +EXPECT +Illegal character in prototype for main::foo : \x{ab} at (eval 1) line 1. +######## +# op.c +use utf8; +use open qw( :utf8 :std ); +use warnings; +BEGIN { eval "sub foo (\x{30cb}) {}"; } +EXPECT +Illegal character in prototype for main::foo : \x{30cb} at (eval 1) line 1. ######## # op.c use utf8; @@ -991,6 +1005,14 @@ join /---/, 'x', 'y', 'z'; EXPECT /---/ should probably be written as "---" at - line 3. ######## +# op.c +use utf8; +use open qw( :utf8 :std ); +use warnings 'syntax' ; +join /～～～/, 'x', 'y', 'z'; +EXPECT +/～～～/ should probably be written as "～～～" at - line 5. +######## # op.c [Perl_peep] use warnings 'prototype' ; fred() ; diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index a6841d2d09..dd8dc3d517 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -616,6 +616,30 @@ EXPECT Bareword "FRED::" refers to nonexistent package at bar line 25. ######## # toke.c +use utf8; +use open qw( :utf8 :std ); +use warnings 'bareword' ; +#line 25 "bar" +$a = FRÈD:: ; +no warnings 'bareword' ; +#line 25 "bar" +$a = FRÈD:: ; +EXPECT +Bareword "FRÈD::" refers to nonexistent package at bar line 25. +######## +# toke.c +use utf8; +use open qw( :utf8 :std ); +use warnings 'bareword' ; +#line 25 "bar" +$a = ϞϞϞ:: ; +no warnings 'bareword' ; +#line 25 "bar" +$a = ϞϞϞ:: ; +EXPECT +Bareword "ϞϞϞ::" refers to nonexistent package at bar line 25. +######## +# toke.c use warnings 'ambiguous' ; sub time {} my $a = time() ; @@ -692,11 +716,77 @@ Ambiguous use of -fred resolved as -&fred() at - line 9. Ambiguous use of -fred resolved as -&fred() at - line 11. ######## # toke.c +use utf8; +use open qw( :utf8 :std ); +sub frèd {}; +-frèd ; +EXPECT +Ambiguous use of -frèd resolved as -&frèd() at - line 5. +######## +# toke.c +$^W = 0 ; +use utf8; +use open qw( :utf8 :std ); +sub frèd {} ; +-frèd ; +{ + no warnings 'ambiguous' ; + -frèd ; + use warnings 'ambiguous' ; + -frèd ; +} +-frèd ; +EXPECT +Ambiguous use of -frèd resolved as -&frèd() at - line 6. +Ambiguous use of -frèd resolved as -&frèd() at - line 11. +Ambiguous use of -frèd resolved as -&frèd() at - line 13. +######## +# toke.c +use utf8; +use open qw( :utf8 :std ); +sub ᒍᒘᒊ {}; +-ᒍᒘᒊ ; +EXPECT +Ambiguous use of -ᒍᒘᒊ resolved as -&ᒍᒘᒊ() at - line 5. +######## +# toke.c +$^W = 0 ; +use utf8; +use open qw( :utf8 :std ); +sub ᒍᒘᒊ {} ; +-ᒍᒘᒊ ; +{ + no warnings 'ambiguous' ; + -ᒍᒘᒊ ; + use warnings 'ambiguous' ; + -ᒍᒘᒊ ; +} +-ᒍᒘᒊ ; +EXPECT +Ambiguous use of -ᒍᒘᒊ resolved as -&ᒍᒘᒊ() at - line 6. +Ambiguous use of -ᒍᒘᒊ resolved as -&ᒍᒘᒊ() at - line 11. +Ambiguous use of -ᒍᒘᒊ resolved as -&ᒍᒘᒊ() at - line 13. +######## +# toke.c open FOO || time; open local *FOO; # should be ok EXPECT Precedence problem: open FOO should be open(FOO) at - line 2. ######## +# toke.c +use utf8; +use open qw( :utf8 :std ); +open FÒÒ || time; +EXPECT +Precedence problem: open FÒÒ should be open(FÒÒ) at - line 4. +######## +# toke.c +use utf8; +use open qw( :utf8 :std ); +open ᒍOO || time; +EXPECT +Precedence problem: open ᒍOO should be open(ᒍOO) at - line 4. +######## # toke.c (and [perl #16184]) open FOO => "<&0"; close FOO; EXPECT @@ -719,6 +809,40 @@ Precedence problem: open FOO should be open(FOO) at - line 10. ######## # toke.c $^W = 0 ; +use utf8; +use open qw( :utf8 :std ); +open FÒÒ || time; +{ + no warnings 'precedence' ; + open FÒÒ || time; + use warnings 'precedence' ; + open FÒÒ || time; +} +open FÒÒ || time; +EXPECT +Precedence problem: open FÒÒ should be open(FÒÒ) at - line 5. +Precedence problem: open FÒÒ should be open(FÒÒ) at - line 10. +Precedence problem: open FÒÒ should be open(FÒÒ) at - line 12. +######## +# toke.c +use utf8; +use open qw( :utf8 :std ); +$^W = 0 ; +open ᒍÒÒ || time; +{ + no warnings 'precedence' ; + open ᒍÒÒ || time; + use warnings 'precedence' ; + open ᒍÒÒ || time; +} +open ᒍÒÒ || time; +EXPECT +Precedence problem: open ᒍÒÒ should be open(ᒍÒÒ) at - line 5. +Precedence problem: open ᒍÒÒ should be open(ᒍÒÒ) at - line 10. +Precedence problem: open ᒍÒÒ should be open(ᒍÒÒ) at - line 12. +######## +# toke.c +$^W = 0 ; *foo *foo ; { no warnings 'ambiguous' ; @@ -1118,3 +1242,11 @@ no warnings 'ambiguous' ; $a = ${f렏} ; EXPECT Ambiguous use of ${f렏} resolved to $f렏 at - line 6. +######## +# toke.c +use utf8; +use open qw( :utf8 :std ); +use warnings; +CORE::렏; +EXPECT +CORE::렏 is not a keyword at - line 5. diff --git a/t/re/reg_email.t b/t/re/reg_email.t index 27f1f35591..a498585794 100644 --- a/t/re/reg_email.t +++ b/t/re/reg_email.t @@ -30,7 +30,7 @@ my $email = qr { (?<dcontent> (?&dtext) | (?"ed_pair)) (?<dtext> (?&NO_WS_CTL) | [\x21-\x5a\x5e-\x7e]) - (?<atext> (?&ALPHA) | (?&DIGIT) | [!#\$%&'*+-/=?^_`{|}~]) + (?<atext> (?&ALPHA) | (?&DIGIT) | [-!#\$%&'*+/=?^_`{|}~]) (?<atom> (?&CFWS)? (?&atext)+ (?&CFWS)?) (?<dot_atom> (?&CFWS)? (?&dot_atom_text) (?&CFWS)?) (?<dot_atom_text> (?&atext)+ (?: \. (?&atext)+)*) diff --git a/t/uni/labels.t b/t/uni/labels.t new file mode 100644 index 0000000000..e3ff938174 --- /dev/null +++ b/t/uni/labels.t @@ -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 qw 'unicode_strings evalbytes'; + +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); + evalbytes $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."); + } + } +} diff --git a/t/uni/opcroak.t b/t/uni/opcroak.t new file mode 100644 index 0000000000..29909d7cd6 --- /dev/null +++ b/t/uni/opcroak.t @@ -0,0 +1,44 @@ +#!./perl + +# +# tests for op.c generated croaks +# + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require './test.pl'; +} + +use utf8; +use open qw( :utf8 :std ); +use warnings; + +plan( tests => 5 ); + +eval qq!sub \x{30cb} (\$) {} \x{30cb}()!; +like $@, qr/Not enough arguments for main::\x{30cb}/u, "Not enough arguments croak is UTF-8 clean"; + +eval qq!sub \x{30cc} (\$) {} \x{30cc}(1, 2)!; +like $@, qr/Too many arguments for main::\x{30cc}/u, "Too many arguments croak is UTF-8 clean"; + +eval qq!sub \x{30cd} (\Q\%\E) { 1 } \x{30cd}(1);!; +like $@, qr/Type of arg 1 to main::\x{30cd} must be/u, "bad type croak is UTF-8 clean"; + + eval <<'END_FIELDS'; + { + package ＦŌŌ { + use fields qw( a b ); + sub new { bless {}, shift } + } + } +END_FIELDS + +for ( + [ element => 'my ＦŌŌ $bàr = ＦŌŌ->new; $bàr->{クラス};' ], + [ slice => 'my ＦŌŌ $bàr = ＦŌŌ->new; @{$bàr}{ qw( a クラス ) };' ] + ) { + eval $_->[1]; + + like $@, qr/No such class field "クラス" in variable \$bàr of type ＦŌŌ/, "$_->[0]: no such field error is UTF-8 clean"; +} diff --git a/t/uni/parser.t b/t/uni/parser.t index 256864cb80..63c2deba68 100644 --- a/t/uni/parser.t +++ b/t/uni/parser.t @@ -7,7 +7,7 @@ BEGIN { require './test.pl'; } -plan (tests => 45); +plan (tests => 47); use utf8; use open qw( :utf8 :std ); @@ -138,3 +138,9 @@ is ${"main::\345\225\217"}, undef, "..and using the encoded form doesn't"; eval qq!print \x{30cb}, "comma""!; like $@, qr/No comma allowed after filehandle/, "No comma allowed after filehandle triggers correctly for UTF-8 filehandles."; } + +# tests for "Bad name" +eval q{ Ｆｏｏ::$bar }; +like( $@, qr/Bad name after Ｆｏｏ::/, 'Bad name after Ｆｏｏ::' ); +eval q{ Ｆｏｏ''bar }; +like( $@, qr/Bad name after Ｆｏｏ'/, 'Bad name after Ｆｏｏ\'' ); @@ -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); } @@ -6659,7 +6658,9 @@ Perl_yylex(pTHX) s = scan_word(s, PL_tokenbuf + len, sizeof PL_tokenbuf - len, TRUE, &morelen); if (!morelen) - Perl_croak(aTHX_ "Bad name after %s%s", PL_tokenbuf, + Perl_croak(aTHX_ "Bad name after %"SVf"%s", + SVfARG(newSVpvn_flags(PL_tokenbuf, len, + (UTF ? SVf_UTF8 : 0) | SVs_TEMP )), *s == '\'' ? "'" : "::"); len += morelen; pkgname = 1; @@ -6685,8 +6686,9 @@ Perl_yylex(pTHX) if (ckWARN(WARN_BAREWORD) && ! gv_fetchpvn_flags(PL_tokenbuf, len, UTF ? SVf_UTF8 : 0, SVt_PVHV)) Perl_warner(aTHX_ packWARN(WARN_BAREWORD), - "Bareword \"%s\" refers to nonexistent package", - PL_tokenbuf); + "Bareword \"%"SVf"\" refers to nonexistent package", + SVfARG(newSVpvn_flags(PL_tokenbuf, len, + (UTF ? SVf_UTF8 : 0) | SVs_TEMP))); len -= 2; PL_tokenbuf[len] = '\0'; gv = NULL; @@ -6867,10 +6869,12 @@ Perl_yylex(pTHX) /* Not a method, so call it a subroutine (if defined) */ if (cv) { - if (lastchar == '-') - Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), - "Ambiguous use of -%s resolved as -&%s()", - PL_tokenbuf, PL_tokenbuf); + if (lastchar == '-') { + const SV *tmpsv = newSVpvn_flags( PL_tokenbuf, len ? len : strlen(PL_tokenbuf), (UTF ? SVf_UTF8 : 0) | SVs_TEMP ); + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Ambiguous use of -%"SVf" resolved as -&%"SVf"()", + SVfARG(tmpsv), SVfARG(tmpsv)); + } /* Check for a constant sub */ if ((sv = cv_const_sv(cv))) { its_constant: @@ -7196,7 +7200,9 @@ Perl_yylex(pTHX) d = s; s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); if (!(tmp = keyword(PL_tokenbuf, len, 1))) - Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf); + Perl_croak(aTHX_ "CORE::%"SVf" is not a keyword", + SVfARG(newSVpvn_flags(PL_tokenbuf, len, + (UTF ? SVf_UTF8 : 0) | SVs_TEMP))); if (tmp < 0) tmp = -tmp; else if (tmp == KEY_require || tmp == KEY_do @@ -7715,8 +7721,14 @@ Perl_yylex(pTHX) s = SKIPSPACE1(s); if (isIDFIRST_lazy_if(s,UTF)) { const char *t; - for (d = s; isALNUM_lazy_if(d,UTF);) - d++; + for (d = s; isALNUM_lazy_if(d,UTF);) { + d += UTF ? UTF8SKIP(d) : 1; + if (UTF) { + while (UTF8_IS_CONTINUED(*d) && is_utf8_mark((U8*)d)) { + d += UTF ? UTF8SKIP(d) : 1; + } + } + } for (t=d; isSPACE(*t);) t++; if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE) @@ -7725,10 +7737,11 @@ Perl_yylex(pTHX) && !(t[0] == ':' && t[1] == ':') && !keyword(s, d-s, 0) ) { - int parms_len = (int)(d-s); + SV *tmpsv = newSVpvn_flags(s, (STRLEN)(d-s), + SVs_TEMP | (UTF ? SVf_UTF8 : 0)); Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE), - "Precedence problem: open %.*s should be open(%.*s)", - parms_len, s, parms_len, s); + "Precedence problem: open %"SVf" should be open(%"SVf")", + SVfARG(tmpsv), SVfARG(tmpsv)); } } LOP(OP_OPEN,XTERM); @@ -8217,9 +8230,13 @@ Perl_yylex(pTHX) "Illegal character %sin prototype for %"SVf" : %s", seen_underscore ? "after '_' " : "", SVfARG(PL_subname), - sv_uni_display(dsv, - newSVpvn_flags(d, tmp, SVs_TEMP | SvUTF8(PL_lex_stuff)), - tmp, UNI_DISPLAY_ISPRINT)); + SvUTF8(PL_lex_stuff) + ? sv_uni_display(dsv, + newSVpvn_flags(d, tmp, SVs_TEMP | SVf_UTF8), + tmp, + UNI_DISPLAY_ISPRINT) + : pv_pretty(dsv, d, tmp, 60, NULL, NULL, + PERL_PV_ESCAPE_NONASCII)); } SvCUR_set(PL_lex_stuff, tmp); have_proto = TRUE; @@ -8779,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++ = ':'; @@ -11491,15 +11508,10 @@ 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); SV *lsv; PL_parser->yychar = YYEMPTY; lsv = newSV_type(SVt_PV); - SvPV_set(lsv, lpv); - SvCUR_set(lsv, llen); - SvLEN_set(lsv, llen+1); - SvPOK_on(lsv); + sv_copypv(lsv, cSVOPx(pl_yylval.opval)->op_sv); return lsv; } else { yyunlex(); @@ -11507,17 +11519,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); @@ -11529,7 +11536,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: |