This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
-DS should not invoke warnhook
authorFather Chrysostomos <sprout@cpan.org>
Thu, 28 Jun 2012 05:38:25 +0000 (22:38 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 29 Jun 2012 07:21:01 +0000 (00:21 -0700)
I was using Perl_warn, both for its convenience, and because the line
numbers were extremely helpful in tracking bugs.

But it invokes the warnhook, if present, and also respects tied
STDERR.  We should be using Perl_debug_log.

Changing this also avoids the need for /* diag_listed_as: SKIPME */
all over the place.

op.c

diff --git a/op.c b/op.c
index dd70028..bfcd83c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -318,6 +318,12 @@ S_new_slab(pTHX_ size_t sz)
     return slab;
 }
 
+/* requires double parens and aTHX_ */
+#define DEBUG_S_warn(args)                                            \
+    DEBUG_S(                                                           \
+       PerlIO_printf(Perl_debug_log, "%s", SvPVx_nolen(Perl_mess args)) \
+    )
+
 void *
 Perl_Slab_Alloc(pTHX_ size_t sz)
 {
@@ -345,13 +351,11 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
     if (slab->opslab_freed) {
        OP **too = &slab->opslab_freed;
        o = *too;
-       DEBUG_S(Perl_warn(aTHX_ "found free op at %p, slab %p", o, slab));
+       DEBUG_S_warn((aTHX_ "found free op at %p, slab %p", o, slab));
        while (o && DIFF(OpSLOT(o), OpSLOT(o)->opslot_next) < sz) {
-           DEBUG_S(Perl_warn(aTHX_ "Alas! too small"));
+           DEBUG_S_warn((aTHX_ "Alas! too small"));
            o = *(too = &o->op_next);
-           DEBUG_S(
-               if(o) Perl_warn(aTHX_ "found another free op at %p", o)
-           );
+           if (o) DEBUG_S_warn((aTHX_ "found another free op at %p", o));
        }
        if (o) {
            *too = o->op_next;
@@ -401,7 +405,7 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
         < SIZE_TO_PSIZE(sizeof(OP)) + OPSLOT_HEADER_P)
        slot = &slab2->opslab_slots;
     INIT_OPSLOT;
-    DEBUG_S(Perl_warn(aTHX_ "allocating op at %p, slab %p", o, slab));
+    DEBUG_S_warn((aTHX_ "allocating op at %p, slab %p", o, slab));
     return (void *)o;
 }
 
@@ -434,9 +438,7 @@ Perl_Slab_Free(pTHX_ void *op)
     o->op_type = OP_FREED;
     o->op_next = slab->opslab_freed;
     slab->opslab_freed = o;
-    DEBUG_S(
-       Perl_warn(aTHX_ "free op at %p, recorded in slab %p", o, slab)
-    );
+    DEBUG_S_warn((aTHX_ "free op at %p, recorded in slab %p", o, slab));
     OpslabREFCNT_dec_padok(slab);
 }
 
@@ -460,7 +462,7 @@ Perl_opslab_free(pTHX_ OPSLAB *slab)
     dVAR;
     OPSLAB *slab2;
     PERL_ARGS_ASSERT_OPSLAB_FREE;
-    DEBUG_S(Perl_warn(aTHX_ "freeing slab %p", slab));
+    DEBUG_S_warn((aTHX_ "freeing slab %p", slab));
     assert(slab->opslab_refcnt == 1);
     for (; slab; slab = slab2) {
        slab2 = slab->opslab_next;