X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=edbcb19b36e6fd682630873e8195f19d5db61afa;hb=842c41230043ce99d4bf7b2c79aed85ce2908e89;hp=18e58758fb7cf574a7027f8512ce1a2ed5662ec2;hpb=5ca68648d92617d8e0deebbc877c24f91be5ce4d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perly.y b/perly.y index 18e5875..edbcb19 100644 --- a/perly.y +++ b/perly.y @@ -92,7 +92,7 @@ %type decl format subrout mysubrout package use peg -%type block mblock lineseq line loop cond else +%type block package_block mblock lineseq line loop cond else %type expr term subscripted scalar ary hsh arylen star amper sideff %type argexpr nexpr texpr iexpr mexpr mnexpr miexpr %type listexpr listexprcom indirob listop method @@ -242,6 +242,11 @@ line : label cond } }) } + | package_block + { $$ = newSTATEOP(0, NULL, + newWHILEOP(0, 1, (LOOP*)(OP*)NULL, + NOLINE, (OP*)NULL, $1, + (OP*)NULL, 0)); } | label PLUGSTMT { $$ = newSTATEOP(0, PVAL($1), $2); } ; @@ -511,7 +516,9 @@ peg : PEG ; format : FORMAT startformsub formname block - { SvREFCNT_inc_simple_void(PL_compcv); + { + CV *fmtcv = PL_compcv; + SvREFCNT_inc_simple_void(PL_compcv); #ifdef MAD $$ = newFORM($2, $3, $4); prepend_madprops($1->tk_mad, $$, 'F'); @@ -521,6 +528,10 @@ format : FORMAT startformsub formname block newFORM($2, $3, $4); $$ = (OP*)NULL; #endif + if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) { + SvREFCNT_inc_simple_void(fmtcv); + pad_add_anon((SV*)fmtcv, OP_NULL); + } } ; @@ -653,6 +664,31 @@ package : PACKAGE WORD WORD ';' } ; +package_block: PACKAGE WORD WORD '{' remember + { + int save_3_latefree = $3->op_latefree; + $3->op_latefree = 1; + package($3); + $3->op_latefree = save_3_latefree; + if ($2) { + int save_2_latefree = $2->op_latefree; + $2->op_latefree = 1; + package_version($2); + $2->op_latefree = save_2_latefree; + } + } + lineseq '}' + { if (PL_parser->copline > (line_t)IVAL($4)) + PL_parser->copline = (line_t)IVAL($4); + $$ = block_end($5, $7); + TOKEN_GETMAD($4,$$,'{'); + TOKEN_GETMAD($8,$$,'}'); + op_free($3); + if ($2) + op_free($2); + } + ; + use : USE startsub { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } WORD WORD listexpr ';'