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

5 files changed, 14 insertions, 12 deletions

diff --git a/op.c b/op.c
index 73c85844db..d7a6fe4e16 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 < 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 9ae4211943..7117566c20 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); subline = -subline; }
+			      CvUNIQUE_on(compcv);
 			  yyval.opval = yyvsp[0].opval; }
 break;
 case 57:
diff --git a/perly.y b/perly.y
index fa0e0f5f59..481a2ccad6 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); subline = -subline; }
+			      CvUNIQUE_on(compcv);
 			  $$ = $1; }
 	;
 
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index aa1e82eac8..887f827381 100644
--- 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 e3c100b45d..7514f16803 100644
--- 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: