Perl_magic_setdbline() should clear and set read-only OP slabs.

The debugger implements breakpoints by setting/clearing OPf_SPECIAL on
OP_DBSTATE ops. This means that it is writing to the optree at runtime,
and it falls foul of the enforced read-only OP slabs when debugging with
-DPERL_DEBUG_READONLY_OPS

Avoid this by removing static from Slab_to_rw(), and using it and Slab_to_ro()
in Perl_magic_setdbline() to temporarily make the slab re-write whilst
changing the breakpoint flag.

With this all tests pass with -DPERL_DEBUG_READONLY_OPS (on this system)

diff --git a/embed.fnc b/embed.fnc
index cb26c72..ab2cdec 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1797,14 +1797,12 @@ Xp      |void   |Slab_Free      |NN void *op
 #if defined(PERL_DEBUG_READONLY_OPS)
 #    if defined(PERL_CORE)
 px     |void   |Slab_to_ro     |NN OPSLAB *slab
+px     |void   |Slab_to_rw     |NN OPSLAB *const slab
 #    endif
 : Used in OpREFCNT_inc() in sv.c
 poxM   |OP *   |op_refcnt_inc  |NULLOK OP *o
 : FIXME - can be static.
 poxM   |PADOFFSET      |op_refcnt_dec  |NN OP *o
-#    if defined(PERL_IN_OP_C)
-s      |void   |Slab_to_rw     |NN OPSLAB *const slab
-#    endif
 #endif
 
 #if defined(PERL_IN_PERL_C)

diff --git a/embed.h b/embed.h
index ecce321..45291f0 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1319,6 +1319,7 @@
 #define opslab_free_nopad(a)   Perl_opslab_free_nopad(aTHX_ a)
 #    if defined(PERL_DEBUG_READONLY_OPS)
 #define Slab_to_ro(a)          Perl_Slab_to_ro(aTHX_ a)
+#define Slab_to_rw(a)          Perl_Slab_to_rw(aTHX_ a)
 #    endif
 #  endif
 #  if defined(PERL_CR_FILTER)
@@ -1327,11 +1328,6 @@
 #define strip_return(a)                S_strip_return(aTHX_ a)
 #    endif
 #  endif
-#  if defined(PERL_DEBUG_READONLY_OPS)
-#    if defined(PERL_IN_OP_C)
-#define Slab_to_rw(a)          S_Slab_to_rw(aTHX_ a)
-#    endif
-#  endif
 #  if defined(PERL_IN_AV_C)
 #define get_aux_mg(a)          S_get_aux_mg(aTHX_ a)
 #  endif

diff --git a/mg.c b/mg.c
index 3dea5c2..1f6d062 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2020,11 +2020,17 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
     if (svp && SvIOKp(*svp)) {
        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 (i)
                o->op_flags |= OPf_SPECIAL;
            else
                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 8beb0fe..9ad4499 100644 (file)
--- a/op.c
+++ b/op.c
@@ -261,8 +261,8 @@ Perl_Slab_to_ro(pTHX_ OPSLAB *slab)
     }
 }
 
-STATIC void
-S_Slab_to_rw(pTHX_ OPSLAB *const slab)
+void
+Perl_Slab_to_rw(pTHX_ OPSLAB *const slab)
 {
     OPSLAB *slab2;
 

diff --git a/proto.h b/proto.h
index 07cfd9a..f97fe1f 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5304,6 +5304,11 @@ PERL_CALLCONV void       Perl_Slab_to_ro(pTHX_ OPSLAB *slab)
 #define PERL_ARGS_ASSERT_SLAB_TO_RO    \
        assert(slab)
 
+PERL_CALLCONV void     Perl_Slab_to_rw(pTHX_ OPSLAB *const slab)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_SLAB_TO_RW    \
+       assert(slab)
+
 #  endif
 #endif
 #if defined(PERL_CR_FILTER)
@@ -5323,13 +5328,6 @@ PERL_CALLCONV PADOFFSET  Perl_op_refcnt_dec(pTHX_ OP *o)
        assert(o)
 
 PERL_CALLCONV OP *     Perl_op_refcnt_inc(pTHX_ OP *o);
-#  if defined(PERL_IN_OP_C)
-STATIC void    S_Slab_to_rw(pTHX_ OPSLAB *const slab)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_SLAB_TO_RW    \
-       assert(slab)
-
-#  endif
 #endif
 #if defined(PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION)
 /* PERL_CALLCONV bool  Perl_do_exec(pTHX_ const char* cmd)