Here's a more efficient, updated G_KEEPERR patch. This one was coerced
out of Mr. Laziness Me by Tim Bunce. :-)
The only change is in the pp_ctl.c hunk.
(and don't forget to run 'make regen_headers' before make)
- Sarathy.
gsar@engin.umich.edu
----------------------------------8<----------------------------------
*** toke.c.old Tue Oct 10 12:13:24 1995
--- toke.c Wed Oct 18 19:35:58 1995
***************
*** 4851,4857 ****
if (in_eval & 2)
warn("%s",buf);
else if (in_eval)
! sv_catpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),buf);
else
fputs(buf,stderr);
if (++error_count >= 10)
--- 4851,4857 ----
if (in_eval & 2)
warn("%s",buf);
else if (in_eval)
! sv_catpv(GvSV(errgv),buf);
else
fputs(buf,stderr);
if (++error_count >= 10)
*** perl.c.old Thu Jun 22 18:38:28 1995
--- perl.c Wed Oct 18 19:44:37 1995
***************
*** 671,677 ****
cLOGOP->op_other = op;
markstack_ptr--;
! pp_entertry();
markstack_ptr++;
restart:
--- 671,695 ----
cLOGOP->op_other = op;
markstack_ptr--;
! /* we're trying to emulate pp_entertry() here */
! {
! register CONTEXT *cx;
! I32 gimme = GIMME;
!
! ENTER;
! SAVETMPS;
!
! push_return(op->op_next);
! PUSHBLOCK(cx, CXt_EVAL, stack_sp);
! PUSHEVAL(cx, 0, 0);
! eval_root = op; /* Only needed so that goto works right. */
!
! in_eval = 1;
! if (flags & G_KEEPERR)
! in_eval |= 4;
! else
! sv_setpv(GvSV(errgv),"");
! }
markstack_ptr++;
restart:
***************
*** 716,723 ****
if (op)
run();
retval = stack_sp - (stack_base + oldmark);
! if (flags & G_EVAL)
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
cleanup:
if (flags & G_EVAL) {
--- 734,741 ----
if (op)
run();
retval = stack_sp - (stack_base + oldmark);
! if ((flags & G_EVAL) && !(flags & G_KEEPERR))
! sv_setpv(GvSV(errgv),"");
cleanup:
if (flags & G_EVAL) {
***************
*** 1077,1082 ****
--- 1095,1102 ----
incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
SvMULTI_on(incgv);
defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
+ errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+ SvMULTI_on(errgv);
curstash = defstash;
compiling.cop_stash = defstash;
debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
***************
*** 1721,1727 ****
switch (setjmp(top_env)) {
case 0: {
! SV* atsv = GvSV(gv_fetchpv("@",TRUE, SVt_PV));
PUSHMARK(stack_sp);
perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
(void)SvPV(atsv, len);
--- 1741,1747 ----
switch (setjmp(top_env)) {
case 0: {
! SV* atsv = GvSV(errgv);
PUSHMARK(stack_sp);
perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
(void)SvPV(atsv, len);
*** pp_ctl.c.old Tue Sep 5 21:52:09 1995
--- pp_ctl.c Wed Oct 28 11:27:55 1995
***************
*** 942,953 ****
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 */
!
cxix = dopoptoeval(cxstack_ix);
if (cxix >= 0) {
I32 optype;
--- 942,968 ----
register CONTEXT *cx;
I32 gimme;
SV **newsp;
! 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);
! 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,976 ****
LEAVE;
- sv_insert(errsv, 0, 0, message, strlen(message));
if (optype == OP_REQUIRE)
! DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
return pop_return();
}
}
--- 983,990 ----
LEAVE;
if (optype == OP_REQUIRE)
! DIE("%s", SvPVx(GvSV(errgv), na));
return pop_return();
}
}
***************
*** 1925,1931 ****
rslen = 1;
rschar = '\n';
rspara = 0;
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
--- 1940,1946 ----
rslen = 1;
rschar = '\n';
rspara = 0;
! sv_setpv(GvSV(errgv),"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
***************
*** 1943,1949 ****
lex_end();
LEAVE;
if (optype == OP_REQUIRE)
! DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
rs = nrs;
rslen = nrslen;
rschar = nrschar;
--- 1958,1964 ----
lex_end();
LEAVE;
if (optype == OP_REQUIRE)
! DIE("%s", SvPVx(GvSV(errgv), na));
rs = nrs;
rslen = nrslen;
rschar = nrschar;
***************
*** 2182,2188 ****
lex_end();
LEAVE;
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
RETURNOP(retop);
}
--- 2196,2202 ----
lex_end();
LEAVE;
! sv_setpv(GvSV(errgv),"");
RETURNOP(retop);
}
***************
*** 2202,2208 ****
eval_root = op; /* Only needed so that goto works right. */
in_eval = 1;
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
RETURN;
}
--- 2216,2222 ----
eval_root = op; /* Only needed so that goto works right. */
in_eval = 1;
! sv_setpv(GvSV(errgv),"");
RETURN;
}
***************
*** 2247,2253 ****
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
RETURN;
}
--- 2261,2267 ----
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
! sv_setpv(GvSV(errgv),"");
RETURN;
}
*** pp_sys.c.dist Thu Jun 1 18:06:10 1995
--- pp_sys.c Wed Oct 18 19:33:58 1995
***************
*** 192,198 ****
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
! SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
--- 192,198 ----
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
! SV *error = GvSV(errgv);
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
***************
*** 218,224 ****
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
! SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
--- 218,224 ----
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
! SV *error = GvSV(errgv);
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
*** perl.h.old Thu Jun 22 18:38:30 1995
--- perl.h Wed Oct 18 18:48:45 1995
***************
*** 1247,1252 ****
--- 1247,1255 ----
IEXT I32 Imaxscream IINIT(-1);
IEXT SV * Ilastscream;
+ /* shortcuts to misc objects */
+ IEXT GV * Ierrgv;
+
/* shortcuts to debugging objects */
IEXT GV * IDBgv;
IEXT GV * IDBline;
*** interp.sym.old Thu Jun 22 18:38:19 1995
--- interp.sym Wed Oct 18 18:42:50 1995
***************
*** 47,52 ****
--- 47,53 ----
e_tmpname
endav
envgv
+ errgv
eval_root
eval_start
fdpid
*** sv.c.old Fri Aug 18 18:33:54 1995
--- sv.c Wed Sep 13 21:04:55 1995
***************
*** 2129,2135 ****
PUSHMARK(SP);
PUSHs(&ref);
PUTBACK;
! perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL);
del_XRV(SvANY(&ref));
}
LEAVE;
--- 2129,2135 ----
PUSHMARK(SP);
PUSHs(&ref);
PUTBACK;
! perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
del_XRV(SvANY(&ref));
}
LEAVE;
*** cop.h.dist Sun Mar 12 22:25:47 1995
--- cop.h Tue Sep 5 18:14:17 1995
***************
*** 231,233 ****
--- 231,234 ----
#define G_DISCARD 2 /* Call FREETMPS. */
#define G_EVAL 4 /* Assume eval {} around subroutine call. */
#define G_NOARGS 8 /* Don't construct a @_ array. */
+ #define G_KEEPERR 16 /* Append errors to $@ rather than overwriting it */
out of Mr. Laziness Me by Tim Bunce. :-)
The only change is in the pp_ctl.c hunk.
(and don't forget to run 'make regen_headers' before make)
- Sarathy.
gsar@engin.umich.edu
----------------------------------8<----------------------------------
*** toke.c.old Tue Oct 10 12:13:24 1995
--- toke.c Wed Oct 18 19:35:58 1995
***************
*** 4851,4857 ****
if (in_eval & 2)
warn("%s",buf);
else if (in_eval)
! sv_catpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),buf);
else
fputs(buf,stderr);
if (++error_count >= 10)
--- 4851,4857 ----
if (in_eval & 2)
warn("%s",buf);
else if (in_eval)
! sv_catpv(GvSV(errgv),buf);
else
fputs(buf,stderr);
if (++error_count >= 10)
*** perl.c.old Thu Jun 22 18:38:28 1995
--- perl.c Wed Oct 18 19:44:37 1995
***************
*** 671,677 ****
cLOGOP->op_other = op;
markstack_ptr--;
! pp_entertry();
markstack_ptr++;
restart:
--- 671,695 ----
cLOGOP->op_other = op;
markstack_ptr--;
! /* we're trying to emulate pp_entertry() here */
! {
! register CONTEXT *cx;
! I32 gimme = GIMME;
!
! ENTER;
! SAVETMPS;
!
! push_return(op->op_next);
! PUSHBLOCK(cx, CXt_EVAL, stack_sp);
! PUSHEVAL(cx, 0, 0);
! eval_root = op; /* Only needed so that goto works right. */
!
! in_eval = 1;
! if (flags & G_KEEPERR)
! in_eval |= 4;
! else
! sv_setpv(GvSV(errgv),"");
! }
markstack_ptr++;
restart:
***************
*** 716,723 ****
if (op)
run();
retval = stack_sp - (stack_base + oldmark);
! if (flags & G_EVAL)
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
cleanup:
if (flags & G_EVAL) {
--- 734,741 ----
if (op)
run();
retval = stack_sp - (stack_base + oldmark);
! if ((flags & G_EVAL) && !(flags & G_KEEPERR))
! sv_setpv(GvSV(errgv),"");
cleanup:
if (flags & G_EVAL) {
***************
*** 1077,1082 ****
--- 1095,1102 ----
incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
SvMULTI_on(incgv);
defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
+ errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+ SvMULTI_on(errgv);
curstash = defstash;
compiling.cop_stash = defstash;
debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
***************
*** 1721,1727 ****
switch (setjmp(top_env)) {
case 0: {
! SV* atsv = GvSV(gv_fetchpv("@",TRUE, SVt_PV));
PUSHMARK(stack_sp);
perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
(void)SvPV(atsv, len);
--- 1741,1747 ----
switch (setjmp(top_env)) {
case 0: {
! SV* atsv = GvSV(errgv);
PUSHMARK(stack_sp);
perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
(void)SvPV(atsv, len);
*** pp_ctl.c.old Tue Sep 5 21:52:09 1995
--- pp_ctl.c Wed Oct 28 11:27:55 1995
***************
*** 942,953 ****
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 */
!
cxix = dopoptoeval(cxstack_ix);
if (cxix >= 0) {
I32 optype;
--- 942,968 ----
register CONTEXT *cx;
I32 gimme;
SV **newsp;
! 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);
! 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,976 ****
LEAVE;
- sv_insert(errsv, 0, 0, message, strlen(message));
if (optype == OP_REQUIRE)
! DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
return pop_return();
}
}
--- 983,990 ----
LEAVE;
if (optype == OP_REQUIRE)
! DIE("%s", SvPVx(GvSV(errgv), na));
return pop_return();
}
}
***************
*** 1925,1931 ****
rslen = 1;
rschar = '\n';
rspara = 0;
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
--- 1940,1946 ----
rslen = 1;
rschar = '\n';
rspara = 0;
! sv_setpv(GvSV(errgv),"");
if (yyparse() || error_count || !eval_root) {
SV **newsp;
I32 gimme;
***************
*** 1943,1949 ****
lex_end();
LEAVE;
if (optype == OP_REQUIRE)
! DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE, SVt_PV)), na));
rs = nrs;
rslen = nrslen;
rschar = nrschar;
--- 1958,1964 ----
lex_end();
LEAVE;
if (optype == OP_REQUIRE)
! DIE("%s", SvPVx(GvSV(errgv), na));
rs = nrs;
rslen = nrslen;
rschar = nrschar;
***************
*** 2182,2188 ****
lex_end();
LEAVE;
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
RETURNOP(retop);
}
--- 2196,2202 ----
lex_end();
LEAVE;
! sv_setpv(GvSV(errgv),"");
RETURNOP(retop);
}
***************
*** 2202,2208 ****
eval_root = op; /* Only needed so that goto works right. */
in_eval = 1;
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
RETURN;
}
--- 2216,2222 ----
eval_root = op; /* Only needed so that goto works right. */
in_eval = 1;
! sv_setpv(GvSV(errgv),"");
RETURN;
}
***************
*** 2247,2253 ****
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
RETURN;
}
--- 2261,2267 ----
curpm = newpm; /* Don't pop $1 et al till now */
LEAVE;
! sv_setpv(GvSV(errgv),"");
RETURN;
}
*** pp_sys.c.dist Thu Jun 1 18:06:10 1995
--- pp_sys.c Wed Oct 18 19:33:58 1995
***************
*** 192,198 ****
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
! SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
--- 192,198 ----
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
! SV *error = GvSV(errgv);
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
***************
*** 218,224 ****
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
! SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
--- 218,224 ----
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
! SV *error = GvSV(errgv);
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
*** perl.h.old Thu Jun 22 18:38:30 1995
--- perl.h Wed Oct 18 18:48:45 1995
***************
*** 1247,1252 ****
--- 1247,1255 ----
IEXT I32 Imaxscream IINIT(-1);
IEXT SV * Ilastscream;
+ /* shortcuts to misc objects */
+ IEXT GV * Ierrgv;
+
/* shortcuts to debugging objects */
IEXT GV * IDBgv;
IEXT GV * IDBline;
*** interp.sym.old Thu Jun 22 18:38:19 1995
--- interp.sym Wed Oct 18 18:42:50 1995
***************
*** 47,52 ****
--- 47,53 ----
e_tmpname
endav
envgv
+ errgv
eval_root
eval_start
fdpid
*** sv.c.old Fri Aug 18 18:33:54 1995
--- sv.c Wed Sep 13 21:04:55 1995
***************
*** 2129,2135 ****
PUSHMARK(SP);
PUSHs(&ref);
PUTBACK;
! perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL);
del_XRV(SvANY(&ref));
}
LEAVE;
--- 2129,2135 ----
PUSHMARK(SP);
PUSHs(&ref);
PUTBACK;
! perl_call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR);
del_XRV(SvANY(&ref));
}
LEAVE;
*** cop.h.dist Sun Mar 12 22:25:47 1995
--- cop.h Tue Sep 5 18:14:17 1995
***************
*** 231,233 ****
--- 231,234 ----
#define G_DISCARD 2 /* Call FREETMPS. */
#define G_EVAL 4 /* Assume eval {} around subroutine call. */
#define G_NOARGS 8 /* Don't construct a @_ array. */
+ #define G_KEEPERR 16 /* Append errors to $@ rather than overwriting it */