Oct 11, 1995, 11:51 AM
Post #2 of 10
(1389 views)
Permalink
On Wed, 11 Oct 1995 17:38:01 -0000, Paul Marquess wrote:
>What is the current status if the G_KEEPERR flag?
>
>If it has been finalised and is going to make it into 5.002, I would
>quite like to include it in perlcall.pod.
>
>Can you tell I'm in a "get things tidied up for 5.002" mode today? :-)
>
>Paul
>
This is my pumpkin (slightly stale, because I haven't revisited this for
some time, I'm afraid).
I cleaned up the tentative patch I sent for it, and then decided the
problem is thornier than it seems. With the patch I currently have,
the G_KEEPERR flag induces appending to $@ rather than overwriting it,
but this doesn't work all that well with DESTROY because the main
error message might get pushed behind. Consider this:
package Demo;
sub new { bless {}}
sub DESTROY { die "fuz" }
sub foo {
my($self) = @_;
$self = $self->new() unless (ref $self);
my(@other) = (); # 1
for (1..2) { push @other, $self->new(); } # 2
my($a1) = $self->new(); # 3
my($a2) = $self->new(); # 4
die "foo";
}
package main;
eval { @a = Demo->foo() };
print $@ if $@;
__END__
fuz at - line 3.
(also) fuz at - line 3.
(also) foo at - line 11.
(also) fuz at - line 3.
(also) fuz at - line 3.
(also) fuz at - line 3.
That's the result from applying the patch appended. [.Tim and Tye will
notice, I didn't put in any code to check for duplicates with a %@ hash yet
:-(] I don't like the above behavior a whole lot because it simply rolls all
the error messages in the sequence they were received, and ends up with the
errors in a less useful order in many situations. This is unavoidable even
if the duplicates are removed, because the code inside the G_KEEPERR call
has no way to find out it is inside a G_KEEPERR call.
Ideally I would like control over background errors--errors generated from
from perl code execution that the user has no control over (where it gets
executed, I mean), like DESTROYs, and turn the display of such errors on or
off, or even display them differently with indentation/prefix etc.
BOTTOM-LINE:
We need the 'flags' argument to perl_call_sv() to become part of the execution
context. I am not sure where exactly this should be added, though.
This patch is better than not having the functionality at all, but I am
not too proud of the result.
- Sarathy.
gsar@engin.umich.edu
---------------------------------------8<-------------------------------------
*** perl.c.dist Thu Jun 22 18:38:28 1995
--- perl.c Tue Sep 5 21:46:14 1995
***************
*** 671,677 ****
cLOGOP->op_other = op;
markstack_ptr--;
! pp_entertry();
markstack_ptr++;
restart:
--- 671,693 ----
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))
! sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
! }
markstack_ptr++;
restart:
***************
*** 716,722 ****
if (op)
run();
retval = stack_sp - (stack_base + oldmark);
! if (flags & G_EVAL)
sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
cleanup:
--- 732,738 ----
if (op)
run();
retval = stack_sp - (stack_base + oldmark);
! if ((flags & G_EVAL) && !(flags & G_KEEPERR))
sv_setpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),"");
cleanup:
*** sv.c.dist Tue Sep 5 21:54:45 1995
--- sv.c Tue Sep 5 18:55:15 1995
***************
*** 2123,2129 ****
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;
*** pp_ctl.c.dist Tue Sep 5 21:52:09 1995
--- pp_ctl.c Wed Sep 13 21:09:30 1995
***************
*** 946,952 ****
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) {
--- 946,951 ----
***************
*** 968,974 ****
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();
--- 967,980 ----
LEAVE;
! if (SvTRUE(errsv)) {
! SV *tmpstr = newSVpv("\t(also) ", 0);
! sv_catpv(tmpstr, message);
! sv_catsv(errsv, tmpstr);
! SvREFCNT_dec(tmpstr);
! }
! else
! 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();
*** 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 */