perl 5.003_06: utils/h2xs.PL
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
index a2dc38e..0c7e3d4 100644 (file)
--- 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;
@@ -96,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)
@@ -108,12 +114,13 @@ 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);
 
+           (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);
        }
@@ -204,9 +212,9 @@ PP(pp_formline)
            case FF_END:        name = "END";           break;
            }
            if (arg >= 0)
-               fprintf(stderr, "%-16s%ld\n", name, (long) arg);
+               PerlIO_printf(PerlIO_stderr(), "%-16s%ld\n", name, (long) arg);
            else
-               fprintf(stderr, "%-16s\n", name);
+               PerlIO_printf(PerlIO_stderr(), "%-16s\n", name);
        } )
        switch (*fpc++) {
        case FF_LINEMARK:
@@ -566,7 +574,7 @@ PP(pp_sort)
            if (!(cv && CvROOT(cv))) {
                if (gv) {
                    SV *tmpstr = sv_newmortal();
-                   gv_efullname(tmpstr, gv);
+                   gv_efullname3(tmpstr, gv, Nullch);
                    if (cv && CvXSUB(cv))
                        DIE("Xsub \"%s\" called in sort", SvPVX(tmpstr));
                    DIE("Undefined sort subroutine \"%s\" called",
@@ -613,13 +621,13 @@ PP(pp_sort)
            SAVETMPS;
            SAVESPTR(op);
 
-           oldstack = stack;
+           oldstack = curstack;
            if (!sortstack) {
                sortstack = newAV();
                AvREAL_off(sortstack);
                av_extend(sortstack, 32);
            }
-           SWITCHSTACK(stack, sortstack);
+           SWITCHSTACK(curstack, sortstack);
            if (sortstash != stash) {
                firstgv = gv_fetchpv("a", TRUE, SVt_PV);
                secondgv = gv_fetchpv("b", TRUE, SVt_PV);
@@ -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));
@@ -780,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;
@@ -858,7 +881,7 @@ I32 cxix;
 
     while (cxstack_ix > cxix) {
        cx = &cxstack[cxstack_ix--];
-       DEBUG_l(fprintf(stderr, "Unwinding block %ld, type %s\n", (long) cxstack_ix+1,
+       DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", (long) cxstack_ix+1,
                    block_type[cx->cx_type]));
        /* Note: we don't need to restore the base context info till the end. */
        switch (cx->cx_type) {
@@ -896,6 +919,13 @@ die(pat, va_alist)
     GV *gv;
     CV *cv;
 
+    /* We have to switch back to mainstack or die_where may try to pop
+     * the eval block from the wrong stack if die is being called from a
+     * signal handler.  - dkindred@cs.cmu.edu */
+    if (curstack != mainstack) {
+        dSP;
+        SWITCHSTACK(curstack, mainstack);
+    }
 #ifdef I_STDARG
     va_start(args, pat);
 #else
@@ -914,7 +944,7 @@ die(pat, va_alist)
     }
     restartop = die_where(message);
     if ((!restartop && was_in_eval) || oldrunlevel > 1)
-       longjmp(top_env, 3);
+       Siglongjmp(top_env, 3);
     return restartop;
 }
 
@@ -927,12 +957,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_setpv(GvSV(errgv), message);
+       
        cxix = dopoptoeval(cxstack_ix);
        if (cxix >= 0) {
            I32 optype;
@@ -942,7 +987,7 @@ char *message;
 
            POPBLOCK(cx,curpm);
            if (cx->cx_type != CXt_EVAL) {
-               fprintf(stderr, "panic: die %s", message);
+               PerlIO_printf(PerlIO_stderr(), "panic: die %s", message);
                my_exit(1);
            }
            POPEVAL(cx);
@@ -953,16 +998,22 @@ 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();
        }
     }
-    fputs(message, stderr);
-    (void)fflush(stderr);
-    if (e_fp)
+    PerlIO_printf(PerlIO_stderr(), "%s",message);
+    PerlIO_flush(PerlIO_stderr());
+    if (e_tmpname) {
+       if (e_fp) {
+           PerlIO_close(e_fp);
+           e_fp = Nullfp;
+       }
        (void)UNLINK(e_tmpname);
+       Safefree(e_tmpname);
+       e_tmpname = Nullch;
+    }
     statusvalue = SHIFTSTATUS(statusvalue);
 #ifdef VMS
     my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
@@ -1040,6 +1091,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;
 
@@ -1047,18 +1106,15 @@ 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));
+       gv_efullname3(sv, CvGV(cxstack[cxix].blk_sub.cv), Nullch);
        PUSHs(sv_2mortal(sv));
        PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
     }
@@ -1067,10 +1123,21 @@ 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);
+           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);
 
@@ -1078,7 +1145,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 */
        }
 
@@ -1104,7 +1171,7 @@ const void *b;
     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 (!SvNIOKp(*stack_sp))
@@ -1126,6 +1193,45 @@ 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 (lc_collate_active) {   /* NOTE: this is the LC_COLLATE branch */
+      register char * pv1, * pv2, * pvx;
+      STRLEN cur1, cur2, curx;
+
+      pv1 = SvPV(str1, cur1);
+      pvx = mem_collxfrm(pv1, cur1, &curx);
+      pv1 = pvx;
+      cur1 = curx;
+
+      pv2 = SvPV(str2, cur2);
+      pvx = mem_collxfrm(pv2, cur2, &curx);
+      pv2 = pvx;
+      cur2 = curx;
+
+      retval = memcmp((void *)pv1, (void *)pv2, cur1 < cur2 ? cur1 : cur2);
+
+      Safefree(pv1);
+      Safefree(pv2);
+
+      if (retval)
+       return retval < 0 ? -1 : 1;
+
+      if (cur1 == cur2)
+       return 0;
+      else
+       return cur1 < cur2 ? -1 : 1;
+    }
+
+    /* NOTE: this is the non-LC_COLLATE area */
+
     if (SvCUR(str1) < SvCUR(str2)) {
        /*SUPPRESS 560*/
        if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str1)))
@@ -1177,17 +1283,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)           /* don't do recursive DB::DB call */
+       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;
@@ -1219,19 +1325,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 = curstack;
+       AvFILL(curstack) = sp - stack_base;
+       cx->blk_loop.iterix = MARK - stack_base;
+    }
 
     RETURN;
 }
@@ -1296,11 +1413,11 @@ PP(pp_return)
     PMOP *newpm;
     I32 optype = 0;
 
-    if (stack == sortstack) {
+    if (curstack == sortstack) {
        if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) < sortcxix) {
            if (cxstack_ix > sortcxix)
                dounwind(sortcxix);
-           AvARRAY(stack)[1] = *SP;
+           AvARRAY(curstack)[1] = *SP;
            stack_sp = stack_base + 1;
            return 0;
        }
@@ -1533,6 +1650,15 @@ PP(pp_goto)
            I32 items = 0;
            I32 oldsave;
 
+           if (!CvROOT(cv) && !CvXSUB(cv)) {
+               if (CvGV(cv)) {
+                   SV *tmpstr = sv_newmortal();
+                   gv_efullname3(tmpstr, CvGV(cv), Nullch);
+                   DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
+               }
+               DIE("Goto undefined subroutine");
+           }
+
            /* First do some returnish stuff. */
            cxix = dopoptosub(cxstack_ix);
            if (cxix < 0)
@@ -1545,11 +1671,13 @@ PP(pp_goto)
                AV* av = cx->blk_sub.argarray;
                
                items = AvFILL(av) + 1;
-               Copy(AvARRAY(av), ++stack_sp, items, SV*);
+               stack_sp++;
+               EXTEND(stack_sp, items); /* @_ could have been extended. */
+               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);
@@ -1572,6 +1700,7 @@ PP(pp_goto)
                    sp = stack_base + items;
                }
                else {
+                   stack_sp--;         /* There is no cv arg. */
                    (void)(*CvXSUB(cv))(cv);
                }
                LEAVE;
@@ -1591,7 +1720,7 @@ PP(pp_goto)
                            GvENAME(CvGV(cv)));
                    if (CvDEPTH(cv) > AvFILL(padlist)) {
                        AV *newpad = newAV();
-                       AV *oldpad = (AV*)AvARRAY(svp[CvDEPTH(cv)-1]);
+                       SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
                        I32 ix = AvFILL((AV*)svp[1]);
                        svp = AvARRAY(svp[0]);
                        for ( ;ix > 0; ix--) {
@@ -1600,7 +1729,7 @@ PP(pp_goto)
                                if (SvFLAGS(svp[ix]) & SVf_FAKE) {
                                    /* outer lexical? */
                                    av_store(newpad, ix,
-                                       SvREFCNT_inc(AvARRAY(oldpad)[ix]) );
+                                       SvREFCNT_inc(oldpad[ix]) );
                                }
                                else {          /* our own lexical */
                                    if (*name == '@')
@@ -1661,6 +1790,14 @@ PP(pp_goto)
                        mark++;
                    }
                }
+               if (perldb && curstash != debstash) {
+                   /* &xsub is not copying @_ */
+                   SV *sv = GvSV(DBsub);
+                   save_item(sv);
+                   gv_efullname3(sv, CvGV(cv), Nullch);
+                   /* We do not care about using sv to call CV,
+                    * just for info. */
+               }
                RETURNOP(CvSTART(cv));
            }
        }
@@ -1742,6 +1879,9 @@ PP(pp_goto)
     }
 
     if (do_dump) {
+#ifdef VMS
+       if (!retop) retop = main_start;
+#endif
        restartop = retop;
        do_undump = TRUE;
 
@@ -1751,9 +1891,9 @@ PP(pp_goto)
        do_undump = FALSE;
     }
 
-    if (stack == signalstack) {
+    if (curstack == signalstack) {
         restartop = retop;
-        longjmp(top_env, 3);
+        Siglongjmp(top_env, 3);
     }
 
     RETURNOP(retop);
@@ -1852,6 +1992,8 @@ int gimme;
 
     in_eval = 1;
 
+    PUSHMARK(SP);
+
     /* set up a scratch pad */
 
     SAVEINT(padix);
@@ -1876,9 +2018,10 @@ int gimme;
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);
-    av_store(comppadlist, 0, SvREFCNT_inc((SV*)comppad_name));
-    av_store(comppadlist, 1, SvREFCNT_inc((SV*)comppad));
+    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 */
 
@@ -1897,11 +2040,12 @@ 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);
+    if (saveop->op_flags & OPf_SPECIAL)
+       in_eval |= 4;
+    else
+       sv_setpv(GvSV(errgv),"");
     if (yyparse() || error_count || !eval_root) {
        SV **newsp;
        I32 gimme;
@@ -1913,25 +2057,21 @@ int gimme;
            op_free(eval_root);
            eval_root = Nullop;
        }
+       SP = stack_base + POPMARK;              /* pop original mark */
        POPBLOCK(cx,curpm);
        POPEVAL(cx);
        pop_return();
        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(compcv);
     SAVEFREEOP(eval_root);
     if (gimme & G_ARRAY)
        list(eval_root);
@@ -1942,6 +2082,7 @@ int gimme;
 
     /* compiled okay, so do it */
 
+    SP = stack_base + POPMARK;         /* pop original mark */
     RETURNOP(eval_start);
 }
 
@@ -1954,18 +2095,19 @@ PP(pp_require)
     char *tmpname;
     SV** svp;
     I32 gimme = G_SCALAR;
-    FILE *tryrsfp = 0;
+    PerlIO *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)
@@ -1978,13 +2120,16 @@ 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
     )
     {
-       tryrsfp = fopen(tmpname,"r");
+       tryrsfp = PerlIO_open(tmpname,"r");
     }
     else {
        AV *ar = GvAVn(incgv);
@@ -1993,14 +2138,13 @@ 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);
 #endif
-           tryrsfp = fopen(buf, "r");
+           tryrsfp = PerlIO_open(buf, "r");
            if (tryrsfp) {
                char *s = buf;
 
@@ -2036,6 +2180,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);
@@ -2107,6 +2256,7 @@ PP(pp_leaveeval)
     I32 gimme;
     register CONTEXT *cx;
     OP *retop;
+    U8 save_flags = op -> op_flags;
     I32 optype;
 
     POPBLOCK(cx,newpm);
@@ -2133,27 +2283,25 @@ PP(pp_leaveeval)
     }
     else {
        for (mark = newsp + 1; mark <= SP; mark++)
-           if (!(SvFLAGS(TOPs) & SVs_TEMP))
+           if (!(SvFLAGS(*mark) & SVs_TEMP))
                *mark = sv_mortalcopy(*mark);
                /* in case LEAVE wipes old return values */
     }
     curpm = newpm;     /* Don't pop $1 et al till now */
 
-    if (optype != OP_ENTEREVAL) {
+    if (optype == OP_REQUIRE &&
+       !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
        char *name = cx->blk_eval.old_name;
 
-       if (!(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) {
-           /* Unassume the success we assumed earlier. */
-           (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
-
-           if (optype == OP_REQUIRE)
-               retop = die("%s did not return a true value", name);
-       }
+       /* Unassume the success we assumed earlier. */
+       (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD);
+       retop = die("%s did not return a true value", name);
     }
 
     lex_end();
     LEAVE;
-    sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+    if (!(save_flags & OPf_SPECIAL))
+       sv_setpv(GvSV(errgv),"");
 
     RETURNOP(retop);
 }
@@ -2173,7 +2321,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;
 }
 
@@ -2211,14 +2359,14 @@ PP(pp_leavetry)
     }
     else {
        for (mark = newsp + 1; mark <= SP; mark++)
-           if (!(SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)))
+           if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
                *mark = sv_mortalcopy(*mark);
                /* in case LEAVE wipes old return values */
     }
     curpm = newpm;     /* Don't pop $1 et al till now */
 
     LEAVE;
-    sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
+    sv_setpv(GvSV(errgv),"");
     RETURN;
 }
 
@@ -2397,4 +2545,3 @@ SV *sv;
     Safefree(fops);
     SvCOMPILED_on(sv);
 }
-