Add to docs about the BEGIN { shift } feature. Make the change

yet simpler using CvUNIQUE(compcv) instead of subline (Chip's idea).

p4raw-id: //depot/win32/perl@284

diff --git a/op.c b/op.c
index 73c8584..d7a6fe4 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 < 0 ? -subline : subline),
-                   (long)curcop->cop_line);
+           sv_setpvf(sv, "%_:%ld-%ld",
+                   GvSV(curcop->cop_filegv),
+                   (long)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 > 0) {
+       if (!CvUNIQUE(compcv)) {
            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 > 0 ?
+           scalar(newGVOP(OP_GV, 0, !CvUNIQUE(compcv) ?
                           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 9ae4211..7117566 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); subline = -subline; }
+                             CvUNIQUE_on(compcv);
                          yyval.opval = yyvsp[0].opval; }
 break;
 case 57:

diff --git a/perly.y b/perly.y
index fa0e0f5..481a2cc 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); subline = -subline; }
+                             CvUNIQUE_on(compcv);
                          $$ = $1; }
        ;
 

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index aa1e82e..887f827 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2856,10 +2856,12 @@ argument.
 Shifts the first value of the array off and returns it, shortening the
 array by 1 and moving everything down.  If there are no elements in the
 array, returns the undefined value.  If ARRAY is omitted, shifts the
-@ARGV array in the main program, and the @_ array in subroutines.
-(This is determined lexically.)  See also unshift(), push(), and pop().
-Shift() and unshift() do the same thing to the left end of an array
-that pop() and push() do to the right end.
+@_ array within the lexical scope of subroutines and formats, and the
+@ARGV array at file scopes or within the lexical scopes established by
+the C<eval ''>, C<BEGIN {}>, C<END {}>, and C<INIT {}> constructs.
+See also unshift(), push(), and pop().  Shift() and unshift() do the
+same thing to the left end of an array that pop() and push() do to the
+right end.
 
 =item shmctl ID,CMD,ARG
 

diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index e3c100b..7514f16 100644 (file)
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1770,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); subline = -subline; }
+                             CvUNIQUE_on(compcv);
                          yyval.opval = yyvsp[0].opval; }
 break;
 case 57: