X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=e57e88a1679c40c00bb8443dc666bc2c8028d839;hb=93d3b392e52f4dbaeb643dd62c1be55b27ef77d4;hp=0b6dcd2464ba9de72f5bbd278b80a80c13266cb3;hpb=ecfc54246c2a6f42dc95b17a964a6048192067d2;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index 0b6dcd2..e57e88a 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) {
-	regfree(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 = regcomp(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;
@@ -80,15 +86,9 @@ PP(pp_regcomp) {
 	pm->op_pmflags |= PMf_WHITE;
 
     if (pm->op_pmflags & PMf_KEEP) {
-#ifdef NOTDEF
-	if (!(pm->op_pmflags & PMf_FOLD))
-	    scan_prefix(pm, pm->op_pmregexp->precomp,
-		pm->op_pmregexp->prelen);
-#endif
 	pm->op_pmflags &= ~PMf_RUNTIME;	/* no point compiling again */
 	hoistmust(pm);
 	cLOGOP->op_first->op_next = op->op_next;
-	/* XXX delete push code? */
     }
     RETURN;
 }
@@ -102,7 +102,7 @@ PP(pp_substcont)
     register char *s = cx->sb_s;
     register char *m = cx->sb_m;
     char *orig = cx->sb_orig;
-    register REGEXP *rx = pm->op_pmregexp;
+    register REGEXP *rx = cx->sb_rx;
 
     if (cx->sb_iters++) {
 	if (cx->sb_iters > cx->sb_maxiters)
@@ -114,15 +114,24 @@ PP(pp_substcont)
 	rx->subbase = cx->sb_subbase;
 
 	/* Are we done */
-	if (cx->sb_once || !regexec(rx, s, cx->sb_strend, orig,
+	if (cx->sb_once || !pregexec(rx, s, cx->sb_strend, orig,
 				s == m, Nullsv, cx->sb_safebase))
 	{
 	    SV *targ = cx->sb_targ;
 	    sv_catpvn(dstr, s, cx->sb_strend - s);
-	    sv_replace(targ, dstr);
+
+	    (void)SvOOK_off(targ);
+	    Safefree(SvPVX(targ));
+	    SvPVX(targ) = SvPVX(dstr);
+	    SvCUR_set(targ, SvCUR(dstr));
+	    SvLEN_set(targ, SvLEN(dstr));
+	    SvPVX(dstr) = 0;
+	    sv_free(dstr);
+
 	    (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);
 	}
@@ -161,8 +170,6 @@ PP(pp_formline)
     bool chopspace = (strchr(chopset, ' ') != Nullch);
     char *chophere;
     char *linemark;
-    char *formmark;
-    SV **markmark;
     double value;
     bool gotsome;
     STRLEN len;
@@ -212,8 +219,6 @@ PP(pp_formline)
 	switch (*fpc++) {
 	case FF_LINEMARK:
 	    linemark = t;
-	    formmark = f;
-	    markmark = MARK;
 	    lines++;
 	    gotsome = FALSE;
 	    break;
@@ -701,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);
@@ -719,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));
@@ -783,6 +788,21 @@ char *label;
     return i;
 }
 
+I32
+dowantarray()
+{
+    I32 cxix;
+
+    cxix = dopoptosub(cxstack_ix);
+    if (cxix < 0)
+	return G_SCALAR;
+
+    if (cxstack[cxix].blk_gimme == G_ARRAY)
+	return G_ARRAY;
+    else
+	return G_SCALAR;
+}
+
 static I32
 dopoptosub(startingblock)
 I32 startingblock;
@@ -895,6 +915,9 @@ die(pat, va_alist)
     char *message;
     int oldrunlevel = runlevel;
     int was_in_eval = in_eval;
+    HV *stash;
+    GV *gv;
+    CV *cv;
 
 #ifdef I_STDARG
     va_start(args, pat);
@@ -903,9 +926,18 @@ die(pat, va_alist)
 #endif
     message = mess(pat, &args);
     va_end(args);
+    if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+	dSP;
+
+	PUSHMARK(sp);
+	EXTEND(sp, 1);
+	PUSHs(sv_2mortal(newSVpv(message,0)));
+	PUTBACK;
+	perl_call_sv((SV*)cv, G_DISCARD);
+    }
     restartop = die_where(message);
     if ((!restartop && was_in_eval) || oldrunlevel > 1)
-	longjmp(top_env, 3);
+	Siglongjmp(top_env, 3);
     return restartop;
 }
 
@@ -919,7 +951,26 @@ char *message;
 	I32 gimme;
 	SV **newsp;
 
-	sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),message);
+	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_setpv(GvSV(errgv), message);
+	
 	cxix = dopoptoeval(cxstack_ix);
 	if (cxix >= 0) {
 	    I32 optype;
@@ -939,17 +990,29 @@ char *message;
 	    stack_sp = newsp;
 
 	    LEAVE;
+
 	    if (optype == OP_REQUIRE)
-		DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
+		DIE("%s", SvPVx(GvSV(errgv), na));
 	    return pop_return();
 	}
     }
     fputs(message, stderr);
-    (void)fflush(stderr);
-    if (e_fp)
+    (void)Fflush(stderr);
+    if (e_tmpname) {
+	if (e_fp) {
+	    fclose(e_fp);
+	    e_fp = Nullfp;
+	}
 	(void)UNLINK(e_tmpname);
-    statusvalue >>= 8;
+	Safefree(e_tmpname);
+	e_tmpname = Nullch;
+    }
+    statusvalue = SHIFTSTATUS(statusvalue);
+#ifdef VMS
+    my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
+#else
     my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+#endif
     return 0;
 }
 
@@ -1021,6 +1084,14 @@ PP(pp_caller)
 	cxix = dopoptosub(cxix - 1);
     }
     cx = &cxstack[cxix];
+    if (cxstack[cxix].cx_type == CXt_SUB) {
+        dbcxix = dopoptosub(cxix - 1);
+	/* We expect that cxstack[dbcxix] is CXt_SUB, anyway, the
+	   field below is defined for any cx. */
+	if (DBsub && dbcxix >= 0 && cxstack[dbcxix].blk_sub.cv == GvCV(DBsub))
+	    cx = &cxstack[dbcxix];
+    }
+
     if (GIMME != G_ARRAY) {
 	dTARGET;
 
@@ -1028,16 +1099,13 @@ PP(pp_caller)
 	PUSHs(TARG);
 	RETURN;
     }
-    dbcxix = dopoptosub(cxix - 1);
-    if (DBsub && dbcxix >= 0 && cxstack[dbcxix].blk_sub.cv == GvCV(DBsub))
-	cx = &cxstack[dbcxix];
 
     PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0)));
     PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0)));
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
     if (!MAXARG)
 	RETURN;
-    if (cx->cx_type == CXt_SUB) {
+    if (cx->cx_type == CXt_SUB) { /* So is cxstack[dbcxix]. */
 	sv = NEWSV(49, 0);
 	gv_efullname(sv, CvGV(cxstack[cxix].blk_sub.cv));
 	PUSHs(sv_2mortal(sv));
@@ -1048,7 +1116,21 @@ PP(pp_caller)
 	PUSHs(sv_2mortal(newSViv(0)));
     }
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme)));
-    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);
+	    PUSHs(&sv_no);
+	} 
+	else if (cx->blk_eval.old_name) { /* Try blocks have old_name == 0. */
+	    /* Require, put the name. */
+	    PUSHs(sv_2mortal(newSVpv(cx->blk_eval.old_name, 0)));
+	    PUSHs(&sv_yes);
+	}
+    }
+    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);
 
@@ -1056,7 +1138,7 @@ PP(pp_caller)
 	    GV* tmpgv;
 	    dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
 				SVt_PVAV)));
-	    SvMULTI_on(tmpgv);
+	    GvMULTI_on(tmpgv);
 	    AvREAL_off(dbargs);		/* XXX Should be REIFY */
 	}
 
@@ -1075,21 +1157,23 @@ const void *b;
 {
     SV **str1 = (SV **) a;
     SV **str2 = (SV **) b;
+    I32 oldsaveix = savestack_ix;
     I32 oldscopeix = scopestack_ix;
     I32 result;
     GvSV(firstgv) = *str1;
     GvSV(secondgv) = *str2;
     stack_sp = stack_base;
     op = sortcop;
-    run();
+    runops();
     if (stack_sp != stack_base + 1)
 	croak("Sort subroutine didn't return single value");
-    if (!SvNIOK(*stack_sp))
+    if (!SvNIOKp(*stack_sp))
 	croak("Sort subroutine didn't return a numeric value");
     result = SvIV(*stack_sp);
     while (scopestack_ix > oldscopeix) {
 	LEAVE;
     }
+    leave_scope(oldsaveix);
     return result;
 }
 
@@ -1102,6 +1186,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)))
@@ -1149,28 +1242,29 @@ PP(pp_dbstate)
 	SV **sp;
 	register CV *cv;
 	register CONTEXT *cx;
-	I32 gimme = GIMME;
+	I32 gimme = G_ARRAY;
 	I32 hasargs;
 	GV *gv;
 
+	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 */
+	    return NORMAL;
+
 	ENTER;
 	SAVETMPS;
 
 	SAVEI32(debug);
+	SAVESPTR(stack_sp);
 	debug = 0;
 	hasargs = 0;
-	gv = DBgv;
-	cv = GvCV(gv);
 	sp = stack_sp;
-	*++sp = Nullsv;
 
-	if (!cv)
-	    DIE("No DB::DB routine defined");
-
-	if (CvDEPTH(cv) >= 1)		/* don't do recursive DB::DB call */
-	    return NORMAL;
 	push_return(op->op_next);
-	PUSHBLOCK(cx, CXt_SUB, sp - 1);
+	PUSHBLOCK(cx, CXt_SUB, sp);
 	PUSHSUB(cx);
 	CvDEPTH(cv)++;
 	(void)SvREFCNT_inc(cv);
@@ -1194,19 +1288,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;
 }
@@ -1273,6 +1378,8 @@ PP(pp_return)
 
     if (stack == sortstack) {
 	if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) < sortcxix) {
+	    if (cxstack_ix > sortcxix)
+		dounwind(sortcxix);
 	    AvARRAY(stack)[1] = *SP;
 	    stack_sp = stack_base + 1;
 	    return 0;
@@ -1292,6 +1399,13 @@ PP(pp_return)
 	break;
     case CXt_EVAL:
 	POPEVAL(cx);
+	if (optype == OP_REQUIRE &&
+	    (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) )
+	{
+	    char *name = cx->blk_eval.old_name;
+	    (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
+	    DIE("%s did not return a true value", name);
+	}
 	break;
     default:
 	DIE("panic: return");
@@ -1303,12 +1417,8 @@ PP(pp_return)
 	    *++newsp = sv_mortalcopy(*SP);
 	else
 	    *++newsp = &sv_undef;
-	if (optype == OP_REQUIRE && !SvTRUE(*newsp))
-	    DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
     }
     else {
-	if (optype == OP_REQUIRE && MARK == SP)
-	    DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
 	while (MARK < SP)
 	    *++newsp = sv_mortalcopy(*++MARK);
     }
@@ -1330,7 +1440,6 @@ PP(pp_last)
     SV **newsp;
     PMOP *newpm;
     SV **mark = stack_base + cxstack[cxstack_ix].blk_oldsp;
-    /* XXX The sp is probably not right yet... */
 
     if (op->op_flags & OPf_SPECIAL) {
 	cxix = dopoptoloop(cxstack_ix);
@@ -1504,6 +1613,15 @@ PP(pp_goto)
 	    I32 items = 0;
 	    I32 oldsave;
 
+	    if (!CvROOT(cv) && !CvXSUB(cv)) {
+		if (CvGV(cv)) {
+		    SV *tmpstr = sv_newmortal();
+		    gv_efullname(tmpstr, CvGV(cv));
+		    DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
+		}
+		DIE("Goto undefined subroutine");
+	    }
+
 	    /* First do some returnish stuff. */
 	    cxix = dopoptosub(cxstack_ix);
 	    if (cxix < 0)
@@ -1519,8 +1637,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);
@@ -1562,21 +1680,29 @@ PP(pp_goto)
 			    GvENAME(CvGV(cv)));
 		    if (CvDEPTH(cv) > AvFILL(padlist)) {
 			AV *newpad = newAV();
+			SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
 			I32 ix = AvFILL((AV*)svp[1]);
 			svp = AvARRAY(svp[0]);
-			while (ix > 0) {
+			for ( ;ix > 0; ix--) {
 			    if (svp[ix] != &sv_undef) {
-				char *name = SvPVX(svp[ix]);	/* XXX */
-				if (*name == '@')
-				    av_store(newpad, ix--, sv = (SV*)newAV());
-				else if (*name == '%')
-				    av_store(newpad, ix--, sv = (SV*)newHV());
-				else
-				    av_store(newpad, ix--, sv = NEWSV(0,0));
-				SvPADMY_on(sv);
+				char *name = SvPVX(svp[ix]);
+				if (SvFLAGS(svp[ix]) & SVf_FAKE) {
+				    /* outer lexical? */
+				    av_store(newpad, ix,
+					SvREFCNT_inc(oldpad[ix]) );
+				}
+				else {		/* our own lexical */
+				    if (*name == '@')
+					av_store(newpad, ix, sv = (SV*)newAV());
+				    else if (*name == '%')
+					av_store(newpad, ix, sv = (SV*)newHV());
+				    else
+					av_store(newpad, ix, sv = NEWSV(0,0));
+				    SvPADMY_on(sv);
+				}
 			    }
 			    else {
-				av_store(newpad, ix--, sv = NEWSV(0,0));
+				av_store(newpad, ix, sv = NEWSV(0,0));
 				SvPADTMP_on(sv);
 			    }
 			}
@@ -1694,9 +1820,9 @@ PP(pp_goto)
 
 	/* push wanted frames */
 
-	if (*enterops) {
+	if (*enterops && enterops[1]) {
 	    OP *oldop = op;
-	    for (ix = 0 + (gotoprobe == main_root); enterops[ix]; ix++) {
+	    for (ix = 1; enterops[ix]; ix++) {
 		op = enterops[ix];
 		(*op->op_ppaddr)();
 	    }
@@ -1705,6 +1831,9 @@ PP(pp_goto)
     }
 
     if (do_dump) {
+#ifdef VMS
+	if (!retop) retop = main_start;
+#endif
 	restartop = retop;
 	do_undump = TRUE;
 
@@ -1714,6 +1843,11 @@ PP(pp_goto)
 	do_undump = FALSE;
     }
 
+    if (stack == signalstack) {
+        restartop = retop;
+        Siglongjmp(top_env, 3);
+    }
+
     RETURNOP(retop);
 }
 
@@ -1806,6 +1940,7 @@ int gimme;
     dSP;
     OP *saveop = op;
     HV *newstash;
+    AV* comppadlist;
 
     in_eval = 1;
 
@@ -1818,6 +1953,11 @@ int gimme;
     SAVEINT(comppad_name_fill);
     SAVEINT(min_intro_pending);
     SAVEINT(max_intro_pending);
+
+    SAVESPTR(compcv);
+    compcv = (CV*)NEWSV(1104,0);
+    sv_upgrade((SV *)compcv, SVt_PVCV);
+
     comppad = newAV();
     comppad_name = newAV();
     comppad_name_fill = 0;
@@ -1826,6 +1966,13 @@ int gimme;
     curpad = AvARRAY(comppad);
     padix = 0;
 
+    comppadlist = newAV();
+    AvREAL_off(comppadlist);
+    av_store(comppadlist, 0, (SV*)comppad_name);
+    av_store(comppadlist, 1, (SV*)comppad);
+    CvPADLIST(compcv) = comppadlist;
+    SAVEFREESV(compcv);
+
     /* make sure we compile in the right package */
 
     newstash = curcop->cop_stash;
@@ -1843,11 +1990,9 @@ int gimme;
     error_count = 0;
     curcop = &compiling;
     curcop->cop_arybase = 0;
-    rs = "\n";
-    rslen = 1;
-    rschar = '\n';
-    rspara = 0;
-    sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+    SvREFCNT_dec(rs);
+    rs = newSVpv("\n", 1);
+    sv_setpv(GvSV(errgv),"");
     if (yyparse() || error_count || !eval_root) {
 	SV **newsp;
 	I32 gimme;
@@ -1865,20 +2010,14 @@ int gimme;
 	lex_end();
 	LEAVE;
 	if (optype == OP_REQUIRE)
-	    DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
-	rs = nrs;
-	rslen = nrslen;
-	rschar = nrschar;
-	rspara = (nrslen == 2);
+	    DIE("%s", SvPVx(GvSV(errgv), na));
+	SvREFCNT_dec(rs);
+	rs = SvREFCNT_inc(nrs);
 	RETPUSHUNDEF;
     }
-    rs = nrs;
-    rslen = nrslen;
-    rschar = nrschar;
-    rspara = (nrslen == 2);
+    SvREFCNT_dec(rs);
+    rs = SvREFCNT_inc(nrs);
     compiling.cop_line = 0;
-    SAVEFREESV(comppad);
-    SAVEFREESV(comppad_name);
     SAVEFREEOP(eval_root);
     if (gimme & G_ARRAY)
 	list(eval_root);
@@ -1904,15 +2043,16 @@ PP(pp_require)
     FILE *tryrsfp = 0;
 
     sv = POPs;
-    if (SvNIOK(sv) && !SvPOKp(sv)) {
-	if (atof(patchlevel) + 0.000999 < SvNV(sv))
-	    DIE("Perl %3.3f required--this is only version %s, stopped",
-		SvNV(sv),patchlevel);
+    if (SvNIOKp(sv) && !SvPOKp(sv)) {
+	if (atof(patchlevel) + 0.00000999 < SvNV(sv))
+	    DIE("Perl %s required--this is only version %s, stopped",
+		SvPV(sv,na),patchlevel);
 	RETPUSHYES;
     }
     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)
@@ -1924,7 +2064,15 @@ PP(pp_require)
     if (*tmpname == '/' ||
 	(*tmpname == '.' && 
 	    (tmpname[1] == '/' ||
-	     (tmpname[1] == '.' && tmpname[2] == '/'))))
+	     (tmpname[1] == '.' && tmpname[2] == '/')))
+#ifdef DOSISH
+      || (tmpname[0] && tmpname[1] == ':')
+#endif
+#ifdef VMS
+	|| (strchr(tmpname,':') || ((*tmpname == '[' || *tmpname == '<') &&
+	    (tmpname[1] == '-' || tmpname[1] == ']' || tmpname[1] == '>')))
+#endif
+    )
     {
 	tryrsfp = fopen(tmpname,"r");
     }
@@ -1933,8 +2081,14 @@ PP(pp_require)
 	I32 i;
 
 	for (i = 0; i <= AvFILL(ar); i++) {
+#ifdef VMS
+	    if (tounixpath_ts(SvPVx(*av_fetch(ar, i, TRUE), na),buf) == NULL)
+		continue;
+	    strcat(buf,name);
+#else
 	    (void)sprintf(buf, "%s/%s",
 		SvPVx(*av_fetch(ar, i, TRUE), na), name);
+#endif
 	    tryrsfp = fopen(buf, "r");
 	    if (tryrsfp) {
 		char *s = buf;
@@ -1971,6 +2125,11 @@ PP(pp_require)
     ENTER;
     SAVETMPS;
     lex_start(sv_2mortal(newSVpv("",0)));
+    if (rsfp_filters){
+ 	save_aptr(&rsfp_filters);
+	rsfp_filters = NULL;
+    }
+
     rsfp = tryrsfp;
     name = savepv(name);
     SAVEFREEPV(name);
@@ -2005,13 +2164,15 @@ PP(pp_entereval)
 
     if (!SvPV(sv,len) || !len)
 	RETPUSHUNDEF;
+    TAINT_PROPER("eval");
 
     ENTER;
-    SAVETMPS;
     lex_start(sv);
+    SAVETMPS;
  
     /* switch to eval mode */
 
+    SAVESPTR(compiling.cop_filegv);
     sprintf(tmpbuf, "_<(eval %d)", ++evalseq);
     compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
     compiling.cop_line = 1;
@@ -2077,7 +2238,7 @@ PP(pp_leaveeval)
 
 	if (!(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
 	    /* Unassume the success we assumed earlier. */
-	    (void)hv_delete(GvHVn(incgv), name, strlen(name));
+	    (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
 
 	    if (optype == OP_REQUIRE)
 		retop = die("%s did not return a true value", name);
@@ -2086,27 +2247,11 @@ PP(pp_leaveeval)
 
     lex_end();
     LEAVE;
-    sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+    sv_setpv(GvSV(errgv),"");
 
     RETURNOP(retop);
 }
 
-#ifdef NOTYET
-PP(pp_evalonce)
-{
-    dSP;
-    SP = do_eval(st[1], OP_EVAL, curcop->cop_stash, TRUE,
-	GIMME, arglast);
-    if (eval_root) {
-	SvREFCNT_dec(cSVOP->op_sv);
-	op[1].arg_ptr.arg_cmd = eval_root;
-	op[1].op_type = (A_CMD|A_DONT);
-	op[0].op_type = OP_TRY;
-    }
-    RETURN;
-}
-#endif
-
 PP(pp_entertry)
 {
     dSP;
@@ -2122,7 +2267,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;
 }
 
@@ -2167,7 +2312,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;
 }
 
@@ -2346,4 +2491,3 @@ SV *sv;
     Safefree(fops);
     SvCOMPILED_on(sv);
 }
-