In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/88df5f01a6650d6895e7d3f03d1b340ca2506b05?hp=b27804d8b48d647c08dc853b49e5b311fe166616>
- Log ----------------------------------------------------------------- commit 88df5f01a6650d6895e7d3f03d1b340ca2506b05 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 25 06:16:31 2013 -0800 Revert "[perl #119801] Stop @DB::dbline modifications from crashing" This reverts commit c1cec775e9019cc8ae244d4db239a7ea5c0b343e. See ticket #120864. ----------------------------------------------------------------------- Summary of changes: cop.h | 44 +++++++++++++++----------------------------- embedvar.h | 6 ------ mg.c | 17 +++++++++++------ op.c | 22 +++------------------- perlapi.h | 6 ------ perlvars.h | 4 ---- pp_ctl.c | 4 +--- t/run/switchd.t | 19 +------------------ 8 files changed, 31 insertions(+), 91 deletions(-) diff --git a/cop.h b/cop.h index d74da17..6950814 100644 --- a/cop.h +++ b/cop.h @@ -370,41 +370,27 @@ string/length pair. #include "mydtrace.h" +struct cop { + BASEOP + /* On LP64 putting this here takes advantage of the fact that BASEOP isn't + an exact multiple of 8 bytes to save structure padding. */ + line_t cop_line; /* line # of this command */ + /* label for this construct is now stored in cop_hints_hash */ #ifdef USE_ITHREADS -# define _COP_STASH_N_FILE \ - PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the \ - package the line was compiled in */ \ + PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the + package the line was compiled in */ char * cop_file; /* file name the following line # is from */ #else -# define _COP_STASH_N_FILE \ - HV * cop_stash; /* package line was compiled in */ \ + HV * cop_stash; /* package line was compiled in */ GV * cop_filegv; /* file the following line # is from */ #endif - -#define _COP_FIELDS \ - /* On LP64 putting this here takes advantage of the fact that BASEOP \ - isn't an exact multiple of 8 bytes to save structure padding. */ \ - line_t cop_line; /* line # of this command */ \ - /* label for this construct is now stored in cop_hints_hash */ \ - _COP_STASH_N_FILE \ - U32 cop_hints; /* hints bits from pragmata */ \ - U32 cop_seq; /* parse sequence number */ \ - /* Beware. mg.c and warnings.pl assume the type of this \ - is STRLEN *: */ \ - STRLEN * cop_warnings; /* lexical warnings bitmask */ \ - /* compile time state of %^H. See the comment in op.c for how this \ - is used to recreate a hash to return from caller. */ \ + U32 cop_hints; /* hints bits from pragmata */ + U32 cop_seq; /* parse sequence number */ + /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *: */ + STRLEN * cop_warnings; /* lexical warnings bitmask */ + /* compile time state of %^H. See the comment in op.c for how this is + used to recreate a hash to return from caller. */ COPHH * cop_hints_hash; - -struct cop { - BASEOP - _COP_FIELDS -}; - -struct dbop { - BASEOP - _COP_FIELDS - size_t dbop_seq; /* sequence number for breakpoint */ }; #ifdef USE_ITHREADS diff --git a/embedvar.h b/embedvar.h index f90a19e..06d4e18 100644 --- a/embedvar.h +++ b/embedvar.h @@ -357,12 +357,6 @@ #define PL_appctx (my_vars->Gappctx) #define PL_Gappctx (my_vars->Gappctx) -#define PL_breakpoints (my_vars->Gbreakpoints) -#define PL_Gbreakpoints (my_vars->Gbreakpoints) -#define PL_breakpointseq (my_vars->Gbreakpointseq) -#define PL_Gbreakpointseq (my_vars->Gbreakpointseq) -#define PL_breakpointslen (my_vars->Gbreakpointslen) -#define PL_Gbreakpointslen (my_vars->Gbreakpointslen) #define PL_check (my_vars->Gcheck) #define PL_Gcheck (my_vars->Gcheck) #define PL_check_mutex (my_vars->Gcheck_mutex) diff --git a/mg.c b/mg.c index b98a194..8c57e2a 100644 --- a/mg.c +++ b/mg.c @@ -2002,14 +2002,19 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE); if (svp && SvIOKp(*svp)) { - size_t off = SvUVX(*svp); - size_t sz = off+8/8; - if (sz <= PL_breakpointslen) { - /* set or clear breakpoint */ + OP * const o = INT2PTR(OP*,SvIVX(*svp)); + if (o) { +#ifdef PERL_DEBUG_READONLY_OPS + Slab_to_rw(OpSLAB(o)); +#endif + /* set or clear breakpoint in the relevant control op */ if (SvTRUE(sv)) - PL_breakpoints[off/8] |= 1 << off%8; + o->op_flags |= OPf_SPECIAL; else - PL_breakpoints[off/8] &= ~(U8)(1 << off%8); + o->op_flags &= ~OPf_SPECIAL; +#ifdef PERL_DEBUG_READONLY_OPS + Slab_to_ro(OpSLAB(o)); +#endif } } return 0; diff --git a/op.c b/op.c index 0426e87..46e8e7d 100644 --- a/op.c +++ b/op.c @@ -5922,28 +5922,12 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) flags &= ~SVf_UTF8; + NewOp(1101, cop, 1, COP); if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) { - size_t sz, seq; - NewOp(1101, *(struct dbop **)&cop, 1, struct dbop); cop->op_type = OP_DBSTATE; cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ]; - OP_REFCNT_LOCK; - sz = PL_breakpointseq+8/8; - if (!PL_breakpoints) { - PL_breakpoints = (U8 *)PerlMemShared_malloc(sz); - PL_breakpointslen = sz; - } - else if (PL_breakpointslen < sz) { - PL_breakpoints = - (U8 *)PerlMemShared_realloc(PL_breakpoints,sz); - PL_breakpointslen = sz; - } - seq = ((struct dbop *)cop)->dbop_seq = PL_breakpointseq++; - PL_breakpoints[seq/8] &= ~(U8)(1 << seq%8); - OP_REFCNT_UNLOCK; } else { - NewOp(1101, cop, 1, COP); cop->op_type = OP_NEXTSTATE; cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ]; } @@ -5988,13 +5972,13 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) CopSTASH_set(cop, PL_curstash); if (cop->op_type == OP_DBSTATE) { - /* this line can have a breakpoint - store the dbop seq in IV */ + /* this line can have a breakpoint - store the cop in IV */ AV *av = CopFILEAVx(PL_curcop); if (av) { SV * const * const svp = av_fetch(av, CopLINE(cop), FALSE); if (svp && *svp != &PL_sv_undef ) { (void)SvIOK_on(*svp); - SvUV_set(*svp, ((struct dbop *)cop)->dbop_seq); + SvIV_set(*svp, PTR2IV(cop)); } } } diff --git a/perlapi.h b/perlapi.h index 4dc8074..910f789 100644 --- a/perlapi.h +++ b/perlapi.h @@ -101,12 +101,6 @@ END_EXTERN_C #undef PL_appctx #define PL_appctx (*Perl_Gappctx_ptr(NULL)) -#undef PL_breakpoints -#define PL_breakpoints (*Perl_Gbreakpoints_ptr(NULL)) -#undef PL_breakpointseq -#define PL_breakpointseq (*Perl_Gbreakpointseq_ptr(NULL)) -#undef PL_breakpointslen -#define PL_breakpointslen (*Perl_Gbreakpointslen_ptr(NULL)) #undef PL_check #define PL_check (*Perl_Gcheck_ptr(NULL)) #undef PL_check_mutex diff --git a/perlvars.h b/perlvars.h index 56cb96c..aa724e8 100644 --- a/perlvars.h +++ b/perlvars.h @@ -237,7 +237,3 @@ PERLVAR(G, malloc_mutex, perl_mutex) /* Mutex for malloc */ PERLVARI(G, hash_seed_set, bool, FALSE) /* perl.c */ PERLVARA(G, hash_seed, PERL_HASH_SEED_BYTES, unsigned char) /* perl.c and hv.h */ - -PERLVARI(G, breakpoints, U8 *, NULL) /* For setting DB breakpoints */ -PERLVARI(G, breakpointslen, size_t, 0) -PERLVARI(G, breakpointseq, size_t, 0) diff --git a/pp_ctl.c b/pp_ctl.c index 70250cc..c06e796 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1929,7 +1929,6 @@ PP(pp_reset) PP(pp_dbstate) { dVAR; - size_t const seq = ((struct dbop *)PL_op)->dbop_seq; PL_curcop = (COP*)PL_op; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -1937,8 +1936,7 @@ PP(pp_dbstate) PERL_ASYNC_CHECK(); - assert(seq+8/8 <= PL_breakpointslen); - if (PL_breakpoints[seq/8] & 1 << seq%8 + if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */ || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace)) { dSP; diff --git a/t/run/switchd.t b/t/run/switchd.t index 68a97d6..f901bf6 100644 --- a/t/run/switchd.t +++ b/t/run/switchd.t @@ -9,7 +9,7 @@ BEGIN { require "./test.pl"; } # This test depends on t/lib/Devel/switchd*.pm. -plan(tests => 18); +plan(tests => 17); my $r; @@ -253,20 +253,3 @@ is( "ok\n", "setting breakpoints without *DB::dbline aliased" ); - -# Test setting breakpoints after overwriting source lines -is( - runperl( - switches => [ '-Ilib', '-d:switchd_empty' ], - progs => [ split "\n", - '*DB::dbline = *{q(_<).__FILE__}; - $DB::dbline[1] = 7; # IVX used to point to the cop address - $DB::dbline{1} = 1; # crash accessing cCOPx(7)->op_flags - print qq[ok\n]; - ' - ], - stderr => 1 - ), - "ok\n", - 'no crash when setting $DB::dbline{1} after $DB::dbline[1]' -); -- Perl5 Master Repository
