Change 30075 by [EMAIL PROTECTED] on 2007/01/29 23:16:13
Integrate:
[ 29429]
Verify that the debugger has an array where to store lines before
doing so. This fixes an assertion failure when parsing a script
that begins with '#!perl -d'.
Also, code factorization in toke.c.
[ 29433]
Remove the pp_entersub specific logic from S_get_db_sub.
[ 29434]
Make get_db_sub non-static, and call it from pp_goto, which allows the
removal of duplicate code. (The conversion of GvSV(PL_DBsub) to
GvSVn(PL_DBsub) implicit in this change should fix a failure with
Devel::SmallProf.)
[ 29463]
Move Perl_get_db_sub() from pp_hot.c to util.c
[ 29749]
In toke.c, merge S_update_debugger_info_pv() and
S_update_debugger_info_sv() into S_update_debugger_info().
Affected files ...
... //depot/maint-5.8/perl/embed.fnc#203 integrate
... //depot/maint-5.8/perl/embed.h#152 integrate
... //depot/maint-5.8/perl/op.c#193 integrate
... //depot/maint-5.8/perl/pp_ctl.c#167 integrate
... //depot/maint-5.8/perl/pp_hot.c#127 integrate
... //depot/maint-5.8/perl/proto.h#194 integrate
... //depot/maint-5.8/perl/toke.c#160 integrate
... //depot/maint-5.8/perl/util.c#140 edit
Differences ...
==== //depot/maint-5.8/perl/embed.fnc#203 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#202~30069~ 2007-01-29 13:05:26.000000000 -0800
+++ perl/embed.fnc 2007-01-29 15:16:13.000000000 -0800
@@ -279,6 +279,7 @@
#if !defined(HAS_GETENV_LEN)
p |char* |getenv_len |NN const char* key|NN unsigned long *len
#endif
+pox |void |get_db_sub |NULLOK SV **svp|NN CV *cv
Ap |void |gp_free |NULLOK GV* gv
Ap |GP* |gp_ref |NULLOK GP* gp
Ap |GV* |gv_AVadd |NN GV* gv
@@ -1220,7 +1221,6 @@
s |int |do_maybe_phash |NN AV *ary|NN SV **lelem|NN SV **firstlelem \
|NN SV **relem|NN SV **lastrelem
s |void |do_oddball |NN HV *hash|NN SV **relem|NN SV **firstrelem
-sR |CV* |get_db_sub |NN SV **svp|NN CV *cv
sR |SV* |method_common |NN SV* meth|NULLOK U32* hashp
#endif
@@ -1369,6 +1369,8 @@
sR |char* |scan_trans |NN char *start
s |char* |scan_word |NN char *s|NN char *dest|STRLEN destlen \
|int allow_package|NN STRLEN *slp
+s |void |update_debugger_info|NULLOK SV *orig_sv \
+ |NULLOK const char *buf|STRLEN len
sR |char* |skipspace |NN char *s
sR |char* |swallow_bom |NN U8 *s
s |void |checkcomma |NN const char *s|NN const char *name \
==== //depot/maint-5.8/perl/embed.h#152 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#151~30069~ 2007-01-29 13:05:26.000000000 -0800
+++ perl/embed.h 2007-01-29 15:16:13.000000000 -0800
@@ -1229,7 +1229,6 @@
#ifdef PERL_CORE
#define do_maybe_phash S_do_maybe_phash
#define do_oddball S_do_oddball
-#define get_db_sub S_get_db_sub
#define method_common S_method_common
#endif
#endif
@@ -1393,6 +1392,7 @@
#define scan_subst S_scan_subst
#define scan_trans S_scan_trans
#define scan_word S_scan_word
+#define update_debugger_info S_update_debugger_info
#define skipspace S_skipspace
#define swallow_bom S_swallow_bom
#define checkcomma S_checkcomma
@@ -2373,6 +2373,8 @@
#define getenv_len(a,b) Perl_getenv_len(aTHX_ a,b)
#endif
#endif
+#ifdef PERL_CORE
+#endif
#define gp_free(a) Perl_gp_free(aTHX_ a)
#define gp_ref(a) Perl_gp_ref(aTHX_ a)
#define gv_AVadd(a) Perl_gv_AVadd(aTHX_ a)
@@ -3324,7 +3326,6 @@
#ifdef PERL_CORE
#define do_maybe_phash(a,b,c,d,e) S_do_maybe_phash(aTHX_ a,b,c,d,e)
#define do_oddball(a,b,c) S_do_oddball(aTHX_ a,b,c)
-#define get_db_sub(a,b) S_get_db_sub(aTHX_ a,b)
#define method_common(a,b) S_method_common(aTHX_ a,b)
#endif
#endif
@@ -3487,6 +3488,7 @@
#define scan_subst(a) S_scan_subst(aTHX_ a)
#define scan_trans(a) S_scan_trans(aTHX_ a)
#define scan_word(a,b,c,d,e) S_scan_word(aTHX_ a,b,c,d,e)
+#define update_debugger_info(a,b,c) S_update_debugger_info(aTHX_ a,b,c)
#define skipspace(a) S_skipspace(aTHX_ a)
#define swallow_bom(a) S_swallow_bom(aTHX_ a)
#define checkcomma(a,b,c) S_checkcomma(aTHX_ a,b,c)
==== //depot/maint-5.8/perl/op.c#193 (text) ====
Index: perl/op.c
--- perl/op.c#192~30070~ 2007-01-29 14:12:03.000000000 -0800
+++ perl/op.c 2007-01-29 15:16:13.000000000 -0800
@@ -3580,10 +3580,13 @@
CopSTASH_set(cop, PL_curstash);
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const * const svp = av_fetch(CopFILEAVx(PL_curcop),
(I32)CopLINE(cop), FALSE);
- if (svp && *svp != &PL_sv_undef ) {
- (void)SvIOK_on(*svp);
- SvIV_set(*svp, PTR2IV(cop));
+ AV *av = CopFILEAVx(PL_curcop);
+ if (av) {
+ SV * const * const svp = av_fetch(av, (I32)CopLINE(cop), FALSE);
+ if (svp && *svp != &PL_sv_undef ) {
+ (void)SvIOK_on(*svp);
+ SvIV_set(*svp, PTR2IV(cop));
+ }
}
}
==== //depot/maint-5.8/perl/pp_ctl.c#167 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#166~30068~ 2007-01-29 12:23:46.000000000 -0800
+++ perl/pp_ctl.c 2007-01-29 15:16:13.000000000 -0800
@@ -2354,21 +2354,7 @@
}
}
if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
- /*
- * We do not care about using sv to call CV;
- * it's for informational purposes only.
- */
- SV * const sv = GvSV(PL_DBsub);
- save_item(sv);
- if (PERLDB_SUB_NN) {
- const int type = SvTYPE(sv);
- if (type < SVt_PVIV && type != SVt_IV)
- sv_upgrade(sv, SVt_PVIV);
- (void)SvIOK_on(sv);
- SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
- } else {
- gv_efullname3(sv, CvGV(cv), NULL);
- }
+ Perl_get_db_sub(aTHX_ NULL, cv);
if (PERLDB_GOTO) {
CV * const gotocv = get_cv("DB::goto", FALSE);
if (gotocv) {
==== //depot/maint-5.8/perl/pp_hot.c#127 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#126~30071~ 2007-01-29 14:30:00.000000000 -0800
+++ perl/pp_hot.c 2007-01-29 15:16:13.000000000 -0800
@@ -2614,44 +2614,6 @@
return pop_return();
}
-
-STATIC CV *
-S_get_db_sub(pTHX_ SV **svp, CV *cv)
-{
- SV * const dbsv = GvSVn(PL_DBsub);
-
- save_item(dbsv);
- if (!PERLDB_SUB_NN) {
- GV * const gv = CvGV(cv);
-
- if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
- || strEQ(GvNAME(gv), "END")
- || ((GvCV(gv) != cv) && /* Could be imported, and old sub
redefined. */
- !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) ))) {
- /* Use GV from the stack as a fallback. */
- /* GV is potentially non-unique, or contain different CV. */
- SV * const tmp = newRV((SV*)cv);
- sv_setsv(dbsv, tmp);
- SvREFCNT_dec(tmp);
- }
- else {
- gv_efullname3(dbsv, gv, NULL);
- }
- }
- else {
- const int type = SvTYPE(dbsv);
- if (type < SVt_PVIV && type != SVt_IV)
- sv_upgrade(dbsv, SVt_PVIV);
- (void)SvIOK_on(dbsv);
- SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */
- }
-
- if (CvISXSUB(cv))
- PL_curcopdb = PL_curcop;
- cv = GvCV(PL_DBsub);
- return cv;
-}
-
PP(pp_entersub)
{
dSP; dPOPss;
@@ -2756,7 +2718,11 @@
gimme = GIMME_V;
if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) &&
!CvNODEBUG(cv)) {
- cv = get_db_sub(&sv, cv);
+ Perl_get_db_sub(aTHX_ &sv, cv);
+ if (CvISXSUB(cv))
+ PL_curcopdb = PL_curcop;
+ cv = GvCV(PL_DBsub);
+
if (!cv || (!CvXSUB(cv) && !CvSTART(cv)))
DIE(aTHX_ "No DB::sub routine defined");
}
==== //depot/maint-5.8/perl/proto.h#194 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#193~30069~ 2007-01-29 13:05:26.000000000 -0800
+++ perl/proto.h 2007-01-29 15:16:13.000000000 -0800
@@ -354,6 +354,8 @@
#if !defined(HAS_GETENV_LEN)
PERL_CALLCONV char* Perl_getenv_len(pTHX_ const char* key, unsigned long
*len);
#endif
+PERL_CALLCONV void Perl_get_db_sub(pTHX_ SV **svp, CV *cv);
+
PERL_CALLCONV void Perl_gp_free(pTHX_ GV* gv);
PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp);
PERL_CALLCONV GV* Perl_gv_AVadd(pTHX_ GV* gv);
@@ -1780,9 +1782,6 @@
#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
STATIC int S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV
**relem, SV **lastrelem);
STATIC void S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem);
-STATIC CV* S_get_db_sub(pTHX_ SV **svp, CV *cv)
- __attribute__warn_unused_result__;
-
STATIC SV* S_method_common(pTHX_ SV* meth, U32* hashp)
__attribute__warn_unused_result__;
@@ -1965,6 +1964,7 @@
__attribute__warn_unused_result__;
STATIC char* S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int
allow_package, STRLEN *slp);
+STATIC void S_update_debugger_info(pTHX_ SV *orig_sv, const char *buf,
STRLEN len);
STATIC char* S_skipspace(pTHX_ char *s)
__attribute__warn_unused_result__;
==== //depot/maint-5.8/perl/toke.c#160 (text) ====
Index: perl/toke.c
--- perl/toke.c#159~30070~ 2007-01-29 14:12:03.000000000 -0800
+++ perl/toke.c 2007-01-29 15:16:13.000000000 -0800
@@ -735,6 +735,23 @@
}
+STATIC void
+S_update_debugger_info(pTHX_ SV *orig_sv, const char *buf, STRLEN len)
+{
+ AV *av = CopFILEAVx(PL_curcop);
+ if (av) {
+ SV * const sv = newSV(0);
+ sv_upgrade(sv, SVt_PVMG);
+ if (orig_sv)
+ sv_setsv(sv, orig_sv);
+ else
+ sv_setpvn(sv, buf, len);
+ (void)SvIOK_on(sv);
+ SvIV_set(sv, 0);
+ av_store(av, (I32)CopLINE(PL_curcop), sv);
+ }
+}
+
/*
* S_skipspace
* Called to gobble the appropriate amount and type of whitespace.
@@ -841,15 +858,8 @@
/* debugger active and we're not compiling the debugger code,
* so store the line into the debugger's array of lines
*/
- if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const sv = newSV(0);
-
- sv_upgrade(sv, SVt_PVMG);
- sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
- (void)SvIOK_on(sv);
- SvIV_set(sv, 0);
- av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
- }
+ if (PERLDB_LINE && PL_curstash != PL_debstash)
+ update_debugger_info(NULL, PL_bufptr, PL_bufend - PL_bufptr);
}
}
@@ -2850,15 +2860,8 @@
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart =
SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
- if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const sv = newSV(0);
-
- sv_upgrade(sv, SVt_PVMG);
- sv_setsv(sv,PL_linestr);
- (void)SvIOK_on(sv);
- SvIV_set(sv, 0);
- av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
- }
+ if (PERLDB_LINE && PL_curstash != PL_debstash)
+ update_debugger_info(PL_linestr, NULL, 0);
goto retry;
}
do {
@@ -2939,15 +2942,8 @@
incline(s);
} while (PL_doextract);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
- if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const sv = newSV(0);
-
- sv_upgrade(sv, SVt_PVMG);
- sv_setsv(sv,PL_linestr);
- (void)SvIOK_on(sv);
- SvIV_set(sv, 0);
- av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
- }
+ if (PERLDB_LINE && PL_curstash != PL_debstash)
+ update_debugger_info(PL_linestr, NULL, 0);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
if (CopLINE(PL_curcop) == 1) {
@@ -9852,15 +9848,8 @@
else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
PL_bufend[-1] = '\n';
#endif
- if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const sv = newSV(0);
-
- sv_upgrade(sv, SVt_PVMG);
- sv_setsv(sv,PL_linestr);
- (void)SvIOK_on(sv);
- SvIV_set(sv, 0);
- av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop),sv);
- }
+ if (PERLDB_LINE && PL_curstash != PL_debstash)
+ update_debugger_info(PL_linestr, NULL, 0);
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
*(SvPVX(PL_linestr) + off ) = ' ';
@@ -10322,15 +10311,8 @@
CopLINE_inc(PL_curcop);
/* update debugger info */
- if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const line_sv = newSV(0);
-
- sv_upgrade(line_sv, SVt_PVMG);
- sv_setsv(line_sv,PL_linestr);
- (void)SvIOK_on(line_sv);
- SvIV_set(line_sv, 0);
- av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop), line_sv);
- }
+ if (PERLDB_LINE && PL_curstash != PL_debstash)
+ update_debugger_info(PL_linestr, NULL, 0);
/* having changed the buffer, we must update PL_bufend */
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
==== //depot/maint-5.8/perl/util.c#140 (text) ====
Index: perl/util.c
--- perl/util.c#139~30070~ 2007-01-29 14:12:03.000000000 -0800
+++ perl/util.c 2007-01-29 15:16:13.000000000 -0800
@@ -5095,6 +5095,41 @@
}
#endif
+void
+Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
+{
+ SV * const dbsv = GvSVn(PL_DBsub);
+ /* We do not care about using sv to call CV;
+ * it's for informational purposes only.
+ */
+
+ save_item(dbsv);
+ if (!PERLDB_SUB_NN) {
+ GV * const gv = CvGV(cv);
+
+ if ( svp && ((CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
+ || strEQ(GvNAME(gv), "END")
+ || ((GvCV(gv) != cv) && /* Could be imported, and old sub
redefined. */
+ !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv) )))) {
+ /* Use GV from the stack as a fallback. */
+ /* GV is potentially non-unique, or contain different CV. */
+ SV * const tmp = newRV((SV*)cv);
+ sv_setsv(dbsv, tmp);
+ SvREFCNT_dec(tmp);
+ }
+ else {
+ gv_efullname3(dbsv, gv, NULL);
+ }
+ }
+ else {
+ const int type = SvTYPE(dbsv);
+ if (type < SVt_PVIV && type != SVt_IV)
+ sv_upgrade(dbsv, SVt_PVIV);
+ (void)SvIOK_on(dbsv);
+ SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */
+ }
+}
+
/*
* Local variables:
* c-indentation-style: bsd
End of Patch.
