- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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 <a b c>
+begin <a>
+init <b>
+end <c>
+argv <>

diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index 1344fae..e3c100b 100644 (file)
--- 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: