diff options
| author | Gurusamy Sarathy <gsar@cpan.org> | 2000-02-04 05:51:14 +0000 |
|---|---|---|
| committer | Gurusamy Sarathy <gsar@cpan.org> | 2000-02-04 05:51:14 +0000 |
| commit | 83ee9e095f68fdbdc131f9a00306fb151d58abe2 (patch) | |
| tree | f0460c4669eb8df6bd5bf9f2a5f9b5f8e4a4045c /pp_ctl.c | |
| parent | b48f1ba55530934180c410ecc1fb73c4bc730b30 (diff) | |
| download | perl-83ee9e095f68fdbdc131f9a00306fb151d58abe2.tar.gz | |
patch to provide more informative names for evals and anonymous
subroutines (from Ilya Zakharevich)
p4raw-id: //depot/perl@4975
Diffstat (limited to 'pp_ctl.c')
| -rw-r--r-- | pp_ctl.c | 26 |
1 files changed, 22 insertions, 4 deletions
@@ -2570,7 +2570,8 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) I32 optype; OP dummy; OP *oop = PL_op, *rop; - char tmpbuf[TYPE_DIGITS(long) + 12 + 10]; + char tbuf[TYPE_DIGITS(long) + 12 + 10]; + char *tmpbuf = tbuf; char *safestr; ENTER; @@ -2584,7 +2585,15 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) } SAVECOPFILE(&PL_compiling); SAVECOPLINE(&PL_compiling); - sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); + if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { + SV *sv = sv_newmortal(); + Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]", + code, (unsigned long)++PL_evalseq, + CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); + tmpbuf = SvPVX(sv); + } + else + sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); CopFILE_set(&PL_compiling, tmpbuf+2); CopLINE_set(&PL_compiling, 1); /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up @@ -3155,7 +3164,8 @@ PP(pp_entereval) register PERL_CONTEXT *cx; dPOPss; I32 gimme = GIMME_V, was = PL_sub_generation; - char tmpbuf[TYPE_DIGITS(long) + 12]; + char tbuf[TYPE_DIGITS(long) + 12]; + char *tmpbuf = tbuf; char *safestr; STRLEN len; OP *ret; @@ -3171,7 +3181,15 @@ PP(pp_entereval) /* switch to eval mode */ SAVECOPFILE(&PL_compiling); - sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); + if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { + SV *sv = sv_newmortal(); + Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]", + (unsigned long)++PL_evalseq, + CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); + tmpbuf = SvPVX(sv); + } + else + sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); CopFILE_set(&PL_compiling, tmpbuf+2); CopLINE_set(&PL_compiling, 1); /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up |