From bb6c22e795117e6d984471c0be74c8b3302b3b9a Mon Sep 17 00:00:00 2001 From: Ben Morrow Date: Mon, 7 Dec 2009 12:55:57 +0000 Subject: [PATCH] Wrap PL_blockhooks in an API function. This should help prevent people from thinking they can get cute with the contents. --- embed.fnc | 1 + embed.h | 4 ++++ ext/XS-APItest/APItest.xs | 5 +---- global.sym | 1 + op.c | 8 ++++++++ proto.h | 5 +++++ 6 files changed, 20 insertions(+), 4 deletions(-) diff --git a/embed.fnc b/embed.fnc index d3f14b1..054616a 100644 --- a/embed.fnc +++ b/embed.fnc @@ -214,6 +214,7 @@ pR |OP* |block_end |I32 floor|NULLOK OP* seq ApR |I32 |block_gimme : Used in perly.y pR |int |block_start |int full +Aop |void |blockhook_register |NN BHK *hk : Used in perl.c p |void |boot_core_UNIVERSAL : Used in perl.c diff --git a/embed.h b/embed.h index df31c37..5e79e58 100644 --- a/embed.h +++ b/embed.h @@ -84,6 +84,8 @@ #define block_gimme Perl_block_gimme #ifdef PERL_CORE #define block_start Perl_block_start +#endif +#ifdef PERL_CORE #define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL #define boot_core_PerlIO Perl_boot_core_PerlIO #endif @@ -2531,6 +2533,8 @@ #define block_gimme() Perl_block_gimme(aTHX) #ifdef PERL_CORE #define block_start(a) Perl_block_start(aTHX_ a) +#endif +#ifdef PERL_CORE #define boot_core_UNIVERSAL() Perl_boot_core_UNIVERSAL(aTHX) #define boot_core_PerlIO() Perl_boot_core_PerlIO(aTHX) #endif diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 54880b7..35533fc 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -641,10 +641,7 @@ BOOT: Newxz(bhk, 1, BHK); BhkENTRY_set(bhk, start, blockhook_start); BhkENTRY_set(bhk, pre_end, blockhook_pre_end); - - if (!PL_blockhooks) - PL_blockhooks = newAV(); - av_push(PL_blockhooks, newSViv(PTR2IV(bhk))); + Perl_blockhook_register(aTHX_ bhk); } void diff --git a/global.sym b/global.sym index f7fb28d..db01b92 100644 --- a/global.sym +++ b/global.sym @@ -56,6 +56,7 @@ Perl_av_unshift Perl_av_arylen_p Perl_av_iter_p Perl_block_gimme +Perl_blockhook_register Perl_call_list Perl_cast_ulong Perl_cast_i32 diff --git a/op.c b/op.c index dc18a2d..9caf8cd 100644 --- a/op.c +++ b/op.c @@ -2343,6 +2343,14 @@ Perl_block_end(pTHX_ I32 floor, OP *seq) return retval; } +void +Perl_blockhook_register(pTHX_ BHK *hk) +{ + PERL_ARGS_ASSERT_BLOCKHOOK_REGISTER; + + Perl_av_create_and_push(aTHX_ &PL_blockhooks, newSViv(PTR2IV(hk))); +} + STATIC OP * S_newDEFSVOP(pTHX) { diff --git a/proto.h b/proto.h index c1c0f05..535dc78 100644 --- a/proto.h +++ b/proto.h @@ -289,6 +289,11 @@ PERL_CALLCONV I32 Perl_block_gimme(pTHX) PERL_CALLCONV int Perl_block_start(pTHX_ int full) __attribute__warn_unused_result__; +PERL_CALLCONV void Perl_blockhook_register(pTHX_ BHK *hk) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_BLOCKHOOK_REGISTER \ + assert(hk) + PERL_CALLCONV void Perl_boot_core_UNIVERSAL(pTHX); PERL_CALLCONV void Perl_boot_core_PerlIO(pTHX); PERL_CALLCONV void Perl_call_list(pTHX_ I32 oldscope, AV *paramList) -- 2.7.4