This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "[perl #119801] Stop @DB::dbline modifications from crashing"
authorFather Chrysostomos <sprout@cpan.org>
Wed, 25 Dec 2013 14:16:31 +0000 (06:16 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 26 Dec 2013 01:47:23 +0000 (17:47 -0800)
This reverts commit c1cec775e9019cc8ae244d4db239a7ea5c0b343e.

See ticket #120864.

cop.h
embedvar.h
mg.c
op.c
perlapi.h
perlvars.h
pp_ctl.c
t/run/switchd.t

diff --git a/cop.h b/cop.h
index d74da17..6950814 100644 (file)
--- 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
index f90a19e..06d4e18 100644 (file)
 
 #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 (file)
--- 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 (file)
--- 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));
            }
        }
     }
index 4dc8074..910f789 100644 (file)
--- 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
index 56cb96c..aa724e8 100644 (file)
@@ -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)
index 70250cc..c06e796 100644 (file)
--- 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;
index 68a97d6..f901bf6 100644 (file)
@@ -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]'
-);