5.002 beta 1

If you're adventurous, have a look at

    ftp://ftp.sems.com/pub/outgoing/perl5.0/perl5.002beta1.tar.gz

Many thanks to Andy for doing the integration.

Obviously, if you consult the bugs database, you'll note there are
still plenty of buglets that need fixing, and several enhancements that
I've intended to put in still haven't made it in (Hi, Tim and Ilya).
But I think it'll be pretty stable.  And you can start to fiddle around
with prototypes (which are, of course, still totally undocumented).

Packrats, don't worry too much about readvertising this widely.
Nowadays we're on a T1 here, so our bandwidth is okay.

Have the appropriate amount of jollity.

Larry

1 files changed, 87 insertions, 39 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 6a34798108..68628f164e 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -67,12 +67,18 @@ PP(pp_regcomp) {
     tmpstr = POPs;
     t = SvPV(tmpstr, len);
 
-    if (pm->op_pmregexp) {
-	pregfree(pm->op_pmregexp);
-	pm->op_pmregexp = Null(REGEXP*);	/* crucial if regcomp aborts */
-    }
+    /* JMR: Check against the last compiled regexp */
+    if ( ! pm->op_pmregexp  || ! pm->op_pmregexp->precomp
+	|| strnNE(pm->op_pmregexp->precomp, t, len) 
+	|| pm->op_pmregexp->precomp[len]) {
+	if (pm->op_pmregexp) {
+	    pregfree(pm->op_pmregexp);
+	    pm->op_pmregexp = Null(REGEXP*);	/* crucial if regcomp aborts */
+	}
 
-    pm->op_pmregexp = pregcomp(t, t + len, pm);
+	pm->op_pmflags = pm->op_pmpermflags;	/* reset case sensitivity */
+	pm->op_pmregexp = pregcomp(t, t + len, pm);
+    }
 
     if (!pm->op_pmregexp->prelen && curpm)
 	pm = curpm;
@@ -114,6 +120,7 @@ PP(pp_substcont)
 	    SV *targ = cx->sb_targ;
 	    sv_catpvn(dstr, s, cx->sb_strend - s);
 
+	    (void)SvOOK_off(targ);
 	    Safefree(SvPVX(targ));
 	    SvPVX(targ) = SvPVX(dstr);
 	    SvCUR_set(targ, SvCUR(dstr));
@@ -124,6 +131,7 @@ PP(pp_substcont)
 	    (void)SvPOK_only(targ);
 	    SvSETMAGIC(targ);
 	    PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1)));
+	    LEAVE_SCOPE(cx->sb_oldsave);
 	    POPSUBST(cx);
 	    RETURNOP(pm->op_next);
 	}
@@ -698,7 +706,7 @@ PP(pp_flop)
 	register SV *sv;
 	I32 max;
 
-	if (SvNIOK(left) || !SvPOK(left) ||
+	if (SvNIOKp(left) || !SvPOKp(left) ||
 	  (looks_like_number(left) && *SvPVX(left) != '0') ) {
 	    i = SvIV(left);
 	    max = SvIV(right);
@@ -716,7 +724,7 @@ PP(pp_flop)
 	    char *tmps = SvPV(final, len);
 
 	    sv = sv_mortalcopy(left);
-	    while (!SvNIOK(sv) && SvCUR(sv) <= len &&
+	    while (!SvNIOKp(sv) && SvCUR(sv) <= len &&
 		strNE(SvPVX(sv),tmps) ) {
 		XPUSHs(sv);
 		sv = sv_2mortal(newSVsv(sv));
@@ -942,12 +950,27 @@ char *message;
 	register CONTEXT *cx;
 	I32 gimme;
 	SV **newsp;
-	SV *errsv;
-
-	errsv = GvSV(gv_fetchpv("@",TRUE, SVt_PV));
-	/* As destructors may produce errors we set $@ at the last moment */
-	sv_setpv(errsv, ""); /* clear $@ before destroying */
 
+	if (in_eval & 4) {
+	    SV **svp;
+	    STRLEN klen = strlen(message);
+	    
+	    svp = hv_fetch(GvHV(errgv), message, klen, TRUE);
+	    if (svp) {
+		if (!SvIOK(*svp)) {
+		    static char prefix[] = "\t(in cleanup) ";
+		    sv_upgrade(*svp, SVt_IV);
+		    (void)SvIOK_only(*svp);
+		    SvGROW(GvSV(errgv), SvCUR(GvSV(errgv))+sizeof(prefix)+klen);
+		    sv_catpvn(GvSV(errgv), prefix, sizeof(prefix)-1);
+		    sv_catpvn(GvSV(errgv), message, klen);
+		}
+		sv_inc(*svp);
+	    }
+	}
+	else
+	    sv_catpv(GvSV(errgv), message);
+	
 	cxix = dopoptoeval(cxstack_ix);
 	if (cxix >= 0) {
 	    I32 optype;
@@ -968,9 +991,8 @@ char *message;
 
 	    LEAVE;
 
-	    sv_insert(errsv, 0, 0, message, strlen(message));
 	    if (optype == OP_REQUIRE)
-		DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
+		DIE("%s", SvPVx(GvSV(errgv), na));
 	    return pop_return();
 	}
     }
@@ -1082,10 +1104,14 @@ PP(pp_caller)
 	PUSHs(sv_2mortal(newSViv(0)));
     }
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme)));
-    if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL)
-	PUSHs(cx->blk_eval.cur_text);
-
-    if (cx->blk_sub.hasargs && curcop->cop_stash == debstash) {
+    if (cx->cx_type == CXt_EVAL) {
+	if (cx->blk_eval.old_op_type == OP_ENTEREVAL)
+	    PUSHs(cx->blk_eval.cur_text);
+    }
+    else if (cx->cx_type == CXt_SUB &&
+	    cx->blk_sub.hasargs &&
+	    curcop->cop_stash == debstash)
+    {
 	AV *ary = cx->blk_sub.argarray;
 	int off = AvARRAY(ary) - AvALLOC(ary);
 
@@ -1141,6 +1167,15 @@ const void *b;
     register SV *str2 = *(SV **) b;
     I32 retval;
 
+    if (!SvPOKp(str1)) {
+	if (!SvPOKp(str2))
+	    return 0;
+	else
+	    return -1;
+    }
+    if (!SvPOKp(str2))
+	return 1;
+
     if (SvCUR(str1) < SvCUR(str2)) {
 	/*SUPPRESS 560*/
 	if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str1)))
@@ -1192,17 +1227,17 @@ PP(pp_dbstate)
 	I32 hasargs;
 	GV *gv;
 
-	ENTER;
-	SAVETMPS;
-
 	gv = DBgv;
 	cv = GvCV(gv);
 	if (!cv)
 	    DIE("No DB::DB routine defined");
 
-	if (CvDEPTH(cv) >= 1 && !(debug & (1<<30)))		/* don't do recursive DB::DB call */
+	if (CvDEPTH(cv) >= 1)		/* don't do recursive DB::DB call */
 	    return NORMAL;
 
+	ENTER;
+	SAVETMPS;
+
 	SAVEI32(debug);
 	SAVESPTR(stack_sp);
 	debug = 0;
@@ -1234,19 +1269,30 @@ PP(pp_enteriter)
     I32 gimme = GIMME;
     SV **svp;
 
+    ENTER;
+    SAVETMPS;
+
     if (op->op_targ)
 	svp = &curpad[op->op_targ];		/* "my" variable */
     else
 	svp = &GvSV((GV*)POPs);			/* symbol table variable */
 
-    ENTER;
-    SAVETMPS;
+    SAVESPTR(*svp);
+
     ENTER;
 
     PUSHBLOCK(cx, CXt_LOOP, SP);
     PUSHLOOP(cx, svp, MARK);
-    cx->blk_loop.iterary = stack;
-    cx->blk_loop.iterix = MARK - stack_base;
+    if (op->op_flags & OPf_STACKED) {
+	AV* av = (AV*)POPs;
+	cx->blk_loop.iterary = av;
+	cx->blk_loop.iterix = -1;
+    }
+    else {
+	cx->blk_loop.iterary = stack;
+	AvFILL(stack) = sp - stack_base;
+	cx->blk_loop.iterix = MARK - stack_base;
+    }
 
     RETURN;
 }
@@ -1572,8 +1618,8 @@ PP(pp_goto)
 		Copy(AvARRAY(av), ++stack_sp, items, SV*);
 		stack_sp += items;
 		GvAV(defgv) = cx->blk_sub.savearray;
-		av_clear(av);
 		AvREAL_off(av);
+		av_clear(av);
 	    }
 	    if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
 		SvREFCNT_dec(cx->blk_sub.cv);
@@ -1926,7 +1972,7 @@ int gimme;
     rslen = 1;
     rschar = '\n';
     rspara = 0;
-    sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+    sv_setpv(GvSV(errgv),"");
     if (yyparse() || error_count || !eval_root) {
 	SV **newsp;
 	I32 gimme;
@@ -1944,7 +1990,7 @@ int gimme;
 	lex_end();
 	LEAVE;
 	if (optype == OP_REQUIRE)
-	    DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
+	    DIE("%s", SvPVx(GvSV(errgv), na));
 	rs = nrs;
 	rslen = nrslen;
 	rschar = nrschar;
@@ -1981,7 +2027,7 @@ PP(pp_require)
     FILE *tryrsfp = 0;
 
     sv = POPs;
-    if (SvNIOK(sv) && !SvPOKp(sv)) {
+    if (SvNIOKp(sv) && !SvPOKp(sv)) {
 	if (atof(patchlevel) + 0.000999 < SvNV(sv))
 	    DIE("Perl %3.3f required--this is only version %s, stopped",
 		SvNV(sv),patchlevel);
@@ -1990,6 +2036,7 @@ PP(pp_require)
     name = SvPV(sv, na);
     if (!*name)
 	DIE("Null filename used");
+    TAINT_PROPER("require");
     if (op->op_type == OP_REQUIRE &&
       (svp = hv_fetch(GvHVn(incgv), name, SvCUR(sv), 0)) &&
       *svp != &sv_undef)
@@ -2002,9 +2049,12 @@ PP(pp_require)
 	(*tmpname == '.' && 
 	    (tmpname[1] == '/' ||
 	     (tmpname[1] == '.' && tmpname[2] == '/')))
+#ifdef DOSISH
+      || (tmpname[0] && tmpname[1] == ':')
+#endif
 #ifdef VMS
-	|| ((*tmpname == '[' || *tmpname == '<') &&
-	    (tmpname[1] == '-' || tmpname[1] == ']' || tmpname[1] == '>'))
+	|| (strchr(tmpname,':') || ((*tmpname == '[' || *tmpname == '<') &&
+	    (tmpname[1] == '-' || tmpname[1] == ']' || tmpname[1] == '>')))
 #endif
     )
     {
@@ -2017,9 +2067,8 @@ PP(pp_require)
 	for (i = 0; i <= AvFILL(ar); i++) {
 #ifdef VMS
 	    if (tounixpath_ts(SvPVx(*av_fetch(ar, i, TRUE), na),buf) == NULL)
-		croak("Error converting file specification %s",
-		      SvPVx(*av_fetch(ar, i, TRUE), na));
-		strcat(buf,name);
+		continue;
+	    strcat(buf,name);
 #else
 	    (void)sprintf(buf, "%s/%s",
 		SvPVx(*av_fetch(ar, i, TRUE), na), name);
@@ -2182,7 +2231,7 @@ PP(pp_leaveeval)
 
     lex_end();
     LEAVE;
-    sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+    sv_setpv(GvSV(errgv),"");
 
     RETURNOP(retop);
 }
@@ -2202,7 +2251,7 @@ PP(pp_entertry)
     eval_root = op;		/* Only needed so that goto works right. */
 
     in_eval = 1;
-    sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+    sv_setpv(GvSV(errgv),"");
     RETURN;
 }
 
@@ -2247,7 +2296,7 @@ PP(pp_leavetry)
     curpm = newpm;	/* Don't pop $1 et al till now */
 
     LEAVE;
-    sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+    sv_setpv(GvSV(errgv),"");
     RETURN;
 }
 
@@ -2426,4 +2475,3 @@ SV *sv;
     Safefree(fops);
     SvCOMPILED_on(sv);
 }
-