Merge maint-5.004 branch (5.004_04) with mainline.

p4raw-id: //depot/perl@137

1 files changed, 35 insertions, 26 deletions

diff --git a/op.c b/op.c
index 8a3debc6b3..7c769d1550 100644
--- a/op.c
+++ b/op.c
@@ -119,7 +119,7 @@ char *name;
 	}
 	croak("Can't use global %s in \"my\"",name);
     }
-    if (AvFILL(comppad_name) >= 0) {
+    if (dowarn && AvFILL(comppad_name) >= 0) {
 	SV **svp = AvARRAY(comppad_name);
 	for (off = AvFILL(comppad_name); off > comppad_name_floor; off--) {
 	    if ((sv = svp[off])
@@ -2836,7 +2836,8 @@ OP *block;
     if (expr) {
 	if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
 	    return block;	/* do {} while 0 does once */
-	if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) {
+	if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
+	    || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
 	    expr = newUNOP(OP_DEFINED, 0,
 		newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
 	}
@@ -2860,10 +2861,11 @@ OP *block;
 }
 
 OP *
-newWHILEOP(flags, debuggable, loop, expr, block, cont)
+newWHILEOP(flags, debuggable, loop, whileline, expr, block, cont)
 I32 flags;
 I32 debuggable;
 LOOP *loop;
+I32 whileline;
 OP *expr;
 OP *block;
 OP *cont;
@@ -2875,7 +2877,8 @@ OP *cont;
     OP *o;
     OP *condop;
 
-    if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
+    if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
+		 || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
 	expr = newUNOP(OP_DEFINED, 0,
 	    newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
     }
@@ -2885,8 +2888,14 @@ OP *cont;
 
     if (cont)
 	next = LINKLIST(cont);
-    if (expr)
+    if (expr) {
 	cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
+	if ((line_t)whileline != NOLINE) {
+	    copline = whileline;
+	    cont = append_elem(OP_LINESEQ, cont,
+			       newSTATEOP(0, Nullch, Nullop));
+	}
+    }
 
     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
     redo = LINKLIST(listop);
@@ -2944,10 +2953,10 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
 #endif /* CAN_PROTOTYPE */
 {
     LOOP *loop;
+    OP *wop;
     int padoff = 0;
     I32 iterflags = 0;
 
-    copline = forline;
     if (sv) {
 	if (sv->op_type == OP_RV2SV) {	/* symbol table variable */
 	    sv->op_type = OP_RV2GV;
@@ -2974,8 +2983,9 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
     assert(!loop->op_next);
     Renew(loop, 1, LOOP);
     loop->op_targ = padoff;
-    return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
-	newOP(OP_ITER, 0), block, cont));
+    wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont);
+    copline = forline;
+    return newSTATEOP(0, label, wop);
 }
 
 OP*
@@ -3074,7 +3084,7 @@ CV* cv;
     SV** ppad;
     I32 ix;
 
-    PerlIO_printf(Perl_debug_log, "\tCV=0x%p (%s), OUTSIDE=0x%p (%s)\n",
+    PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n",
 		  cv,
 		  (CvANON(cv) ? "ANON"
 		   : (cv == main_cv) ? "MAIN"
@@ -3097,7 +3107,7 @@ CV* cv;
 
     for (ix = 1; ix <= AvFILL(pad_name); ix++) {
 	if (SvPOK(pname[ix]))
-	    PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (%s\"%s\" %ld-%ld)\n",
+	    PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
 			  ix, ppad[ix],
 			  SvFAKE(pname[ix]) ? "FAKE " : "",
 			  SvPVX(pname[ix]),
@@ -3901,7 +3911,7 @@ OP *o;
 	if (cLISTOPo->op_first->op_type == OP_STUB) {
 	    op_free(o);
 	    o = newUNOP(type, OPf_SPECIAL,
-		newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
+		newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV)));
 	}
 	return ck_fun(o);
     }
@@ -4074,7 +4084,7 @@ OP *o;
     else {
 	op_free(o);
 	if (type == OP_FTTTY)
-	    return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
+           return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
 				SVt_PVIO));
 	else
 	    return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
@@ -4225,25 +4235,23 @@ OP *
 ck_glob(o)
 OP *o;
 {
-    GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV);
+    GV *gv;
+
+    if ((op->op_flags & OPf_KIDS) && !cLISTOP->op_first->op_sibling)
+	append_elem(OP_GLOB, op, newSVREF(newGVOP(OP_GV, 0, defgv)));
+
+    if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
+	gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 
     if (gv && GvIMPORTED_CV(gv)) {
 	static int glob_index;
 
 	append_elem(OP_GLOB, o,
 		    newSVOP(OP_CONST, 0, newSViv(glob_index++)));
-	o->op_type = OP_LIST;
-	o->op_ppaddr = ppaddr[OP_LIST];
-	cLISTOPo->op_first->op_type = OP_PUSHMARK;
-	cLISTOPo->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
-	o = newUNOP(OP_ENTERSUB, OPf_STACKED,
-		    append_elem(OP_LIST, o, 
-				scalar(newUNOP(OP_RV2CV, 0,
-					       newGVOP(OP_GV, 0, gv)))));
-	return ck_subr(o);
-    }
-    if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
-	append_elem(OP_GLOB, o, newSVREF(newGVOP(OP_GV, 0, defgv)));
+	o = newUNOP(OP_NULL, 0, ck_subr(o));
+	o->op_targ = OP_GLOB;		/* hint at what it used to be */
+	return o;
+    }
     gv = newGVgen("main");
     gv_IOadd(gv);
     append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
@@ -4744,7 +4752,8 @@ OP *o;
 	prev = o2;
 	o2 = o2->op_sibling;
     }
-    if (proto && !optional && *proto == '$')
+    if (proto && !optional &&
+	  (*proto && *proto != '@' && *proto != '%' && *proto != ';'))
 	return too_few_arguments(o, gv_ename(namegv));
     return o;
 }