From: Gurusamy Sarathy Date: Sat, 22 Nov 1997 09:48:02 +0000 (+0000) Subject: - shift() inside BEGIN|END|INIT now shifts @ARGV instead of @_ X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0da4822f11e97ce202166899552c06d720eb835a;p=p5sagit%2Fp5-mst-13.2.git - shift() inside BEGIN|END|INIT now shifts @ARGV instead of @_ - added a test for the above - fixed up perly.c.diff and vms/perl_c.vms for above and added the ansification hunks p4raw-id: //depot/win32/perl@277 --- diff --git a/op.c b/op.c index dd4c5ac..73c8584 100644 --- a/op.c +++ b/op.c @@ -3438,9 +3438,9 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) CV *cv; HV *hv; - sv_setpvf(sv, "%_:%ld-%ld", - GvSV(curcop->cop_filegv), - (long)subline, (long)curcop->cop_line); + sv_setpvf(sv, "%_:%ld-%ld", GvSV(curcop->cop_filegv), + (long)(subline < 0 ? -subline : subline), + (long)curcop->cop_line); gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); if (!db_postponed) { @@ -4412,7 +4412,7 @@ ck_shift(OP *o) op_free(o); #ifdef USE_THREADS - if (subline) { + if (subline > 0) { argop = newOP(OP_PADAV, OPf_REF); argop->op_targ = 0; /* curpad[0] is @_ */ } @@ -4423,7 +4423,7 @@ ck_shift(OP *o) } #else argop = newUNOP(OP_RV2AV, 0, - scalar(newGVOP(OP_GV, 0, subline ? + scalar(newGVOP(OP_GV, 0, subline > 0 ? defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV)))); #endif /* USE_THREADS */ return newUNOP(type, 0, scalar(argop)); diff --git a/perly.c b/perly.c index 7117566..9ae4211 100644 --- a/perly.c +++ b/perly.c @@ -1767,7 +1767,7 @@ case 56: { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, na); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) - CvUNIQUE_on(compcv); + { CvUNIQUE_on(compcv); subline = -subline; } yyval.opval = yyvsp[0].opval; } break; case 57: diff --git a/perly.c.diff b/perly.c.diff index b4aec9d..e13b04b 100644 --- a/perly.c.diff +++ b/perly.c.diff @@ -88,12 +88,24 @@ Index: perly.c - short yyss[YYSTACKSIZE]; - YYSTYPE yyvs[YYSTACKSIZE]; - #define yystacksize YYSTACKSIZE - #line 631 "perly.y" + #line 632 "perly.y" /* PROGRAM */ --- 1283,1288 ---- *************** *** 1361,1372 **** ---- 1291,1347 ---- + #define YYACCEPT goto yyaccept + #define YYERROR goto yyerrlab + int +! yyparse() + { + register int yym, yyn, yystate; + #if YYDEBUG + register char *yys; + extern char *getenv(); + + if (yys = getenv("YYDEBUG")) + { +--- 1291,1348 ---- #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab + @@ -109,8 +121,7 @@ Index: perly.c + }; + + void -+ yydestruct(ptr) -+ void* ptr; ++ yydestruct(void *ptr) + { + struct ysv* ysave = (struct ysv*)ptr; + if (ysave->yyss) Safefree(ysave->yyss); @@ -125,7 +136,7 @@ Index: perly.c + } + int - yyparse() +! yyparse(void) { register int yym, yyn, yystate; + register short *yyssp; @@ -136,8 +147,10 @@ Index: perly.c + int retval = 0; #if YYDEBUG register char *yys; ++ #ifndef __cplusplus extern char *getenv(); + #endif ++ #endif + + struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv)); + SAVEDESTRUCTOR(yydestruct, ysave); @@ -153,7 +166,7 @@ Index: perly.c { *************** *** 1381,1384 **** ---- 1356,1367 ---- +--- 1357,1368 ---- yychar = (-1); + /* @@ -173,7 +186,7 @@ Index: perly.c ! printf("yydebug: state %d, reading %d (%s)\n", yystate, yychar, yys); } ---- 1379,1383 ---- +--- 1380,1384 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", yystate, @@ -191,7 +204,7 @@ Index: perly.c ! goto yyoverflow; } *++yyssp = yystate = yytable[yyn]; ---- 1389,1412 ---- +--- 1390,1413 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, "yydebug: state %d, shifting to state %d\n", @@ -228,7 +241,7 @@ Index: perly.c ! goto yyoverflow; } *++yyssp = yystate = yytable[yyn]; ---- 1444,1468 ---- +--- 1445,1469 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -262,7 +275,7 @@ Index: perly.c ! *yyssp); #endif if (yyssp <= yyss) goto yyabort; ---- 1474,1480 ---- +--- 1475,1481 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -278,7 +291,7 @@ Index: perly.c ! yystate, yychar, yys); } #endif ---- 1493,1499 ---- +--- 1494,1500 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! fprintf(stderr, @@ -293,21 +306,21 @@ Index: perly.c ! printf("yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif ---- 1504,1508 ---- +--- 1505,1509 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, "yydebug: state %d, reducing by rule %d (%s)\n", yystate, yyn, yyrule[yyn]); #endif *************** -*** 2278,2283 **** +*** 2279,2284 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state 0 to\ ! state %d\n", YYFINAL); #endif yystate = YYFINAL; ---- 2292,2298 ---- +--- 2294,2300 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -316,20 +329,20 @@ Index: perly.c #endif yystate = YYFINAL; *************** -*** 2293,2297 **** +*** 2294,2298 **** if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! printf("yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } ---- 2308,2312 ---- +--- 2310,2314 ---- if (yychar <= YYMAXTOKEN) yys = yyname[yychar]; if (!yys) yys = "illegal-symbol"; ! fprintf(stderr, "yydebug: state %d, reading %d (%s)\n", YYFINAL, yychar, yys); } *************** -*** 2308,2317 **** +*** 2309,2318 **** #if YYDEBUG if (yydebug) ! printf("yydebug: after reduction, shifting from state %d \ @@ -340,7 +353,7 @@ Index: perly.c ! goto yyoverflow; } *++yyssp = yystate; ---- 2323,2347 ---- +--- 2325,2349 ---- #if YYDEBUG if (yydebug) ! fprintf(stderr, @@ -367,7 +380,7 @@ Index: perly.c } *++yyssp = yystate; *************** -*** 2319,2326 **** +*** 2320,2327 **** goto yyloop; yyoverflow: ! yyerror("yacc stack overflow"); @@ -376,7 +389,7 @@ Index: perly.c yyaccept: ! return (0); } ---- 2349,2356 ---- +--- 2351,2358 ---- goto yyloop; yyoverflow: ! yyerror("Out of memory for yacc stack"); diff --git a/perly.y b/perly.y index 481a2cc..fa0e0f5 100644 --- a/perly.y +++ b/perly.y @@ -291,7 +291,7 @@ startformsub: /* NULL */ /* start a format subroutine scope */ subname : WORD { char *name = SvPV(((SVOP*)$1)->op_sv, na); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) - CvUNIQUE_on(compcv); + { CvUNIQUE_on(compcv); subline = -subline; } $$ = $1; } ; diff --git a/t/op/misc.t b/t/op/misc.t index c529830..326273a 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -345,3 +345,14 @@ EXPECT Unmatched right bracket at (re_eval 1) line 1, at end of line syntax error at (re_eval 1) line 1, near ""{"}" Compilation failed in regexp at - line 1. +######## +BEGIN { @ARGV = qw(a b c) } +BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" } +END { print "end <",shift,">\nargv <@ARGV>\n" } +INIT { print "init <",shift,">\n" } +EXPECT +argv +begin +init +end +argv <> diff --git a/vms/perly_c.vms b/vms/perly_c.vms index 1344fae..e3c100b 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -8,7 +8,7 @@ static char yysccsid[] = "@(#)yaccpar 1.8 (Berkeley) 01/20/91"; #include "perl.h" static void -dep() +dep(void) { deprecate("\"do\" to call subroutines"); } @@ -1304,8 +1304,7 @@ struct ysv { }; void -yydestruct(ptr) -void* ptr; +yydestruct(void *ptr) { struct ysv* ysave = (struct ysv*)ptr; if (ysave->yyss) Safefree(ysave->yyss); @@ -1320,7 +1319,7 @@ void* ptr; } int -yyparse() +yyparse(void) { register int yym, yyn, yystate; register short *yyssp; @@ -1331,10 +1330,12 @@ yyparse() int retval = 0; #if YYDEBUG register char *yys; +#ifndef __cplusplus # ifndef getenv extern char *getenv(); # endif #endif +#endif struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv)); SAVEDESTRUCTOR(yydestruct, ysave); @@ -1769,7 +1770,7 @@ case 56: { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, na); if (strEQ(name, "BEGIN") || strEQ(name, "END") || strEQ(name, "INIT")) - CvUNIQUE_on(compcv); + { CvUNIQUE_on(compcv); subline = -subline; } yyval.opval = yyvsp[0].opval; } break; case 57: