From: Vincent Pit Date: Wed, 4 Nov 2015 17:41:16 +0000 (-0200) Subject: Enable free callbcks X-Git-Tag: v0.11~6 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Plugin.git;a=commitdiff_plain;h=d4db715e455063f957068da7ac3bc548935f9ff5 Enable free callbcks --- diff --git a/MANIFEST b/MANIFEST index 4fc5bf7..b0837a3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -16,7 +16,6 @@ t/10-usage/import.t t/10-usage/integrate.t t/10-usage/scope.t t/20-methods/base.t -t/20-methods/free.t t/20-methods/minlen/bytes.t t/20-methods/minlen/get.t t/20-methods/minlen/set.t @@ -28,6 +27,7 @@ t/20-methods/str/modify.t t/20-methods/str/types.t t/20-methods/str/undef.t t/30-callbacks/exec.t +t/30-callbacks/free.t t/40-ctl/eval-comp.t t/40-ctl/eval-exec.t t/50-num_buff/FETCH.t diff --git a/Plugin.pm b/Plugin.pm index 93ac7e6..ad5e219 100644 --- a/Plugin.pm +++ b/Plugin.pm @@ -20,7 +20,7 @@ sub import my ($pkg, %sub) = @_; # Valid callbacks - my @callback = qw; + my @callback = qw; for (@callback) { next unless exists $sub{$_}; @@ -55,7 +55,7 @@ sub callbacks { my ($re, %callback) = @_; - my %map = map { $_ => "_$_" } qw; + my %map = map { $_ => "_$_" } qw; for my $key (keys %callback) { my $name = $map{$key}; diff --git a/Plugin.pod b/Plugin.pod index 1c98ce5..e69c8f4 100644 --- a/Plugin.pod +++ b/Plugin.pod @@ -45,6 +45,7 @@ key-value pairs of names and subroutine references: use re::engine::Plugin ( comp => sub {}, exec => sub {}, + free => sub {}, ); To write a custom engine which imports your functions into the @@ -59,6 +60,7 @@ caller's scope use use the following snippet: re::engine::Plugin->import( comp => \&comp, exec => \&exec, + free => \&free, ); } @@ -67,6 +69,7 @@ caller's scope use use the following snippet: # Implementation of the engine sub comp { ... } sub exec { ... } + sub free { ... } 1; @@ -110,15 +113,21 @@ invalid pattern such as C. =head2 exec - exec => sub { - my ($rx, $str) = @_; + my $ponies; + use re::engine::Plugin( + exec => sub { + my ($rx, $str) = @_; - # We always like ponies! - return 1 if $str ~~ /pony/; + # We always like ponies! + if ($str ~~ /pony/) { + $ponies++; + return 1; + } - # Failed to match - return; - } + # Failed to match + return; + } + ); Called when a regex is being executed, i.e. when it's being matched against something. The scalar being matched against the pattern is @@ -129,6 +138,28 @@ successful, and a false one if it wasn't. This callback can also be specified on an individual basis with the L method. +=head2 free + + use re::engine::Plugin( + free => sub { + my ($rx) = @_; + + say 'matched ' ($ponies // 'no') + . ' pon' . ($ponies > 1 ? 'ies' : 'y'); + + return; + } + ); + +Called when the regexp structure is freed by the perl interpreter. +Note that this happens pretty late in the destruction process, but +still before global destruction kicks in. The only argument this +callback receives is the C object associated +with the regexp, and its return value is ignored. + +This callback can also be specified on an individual basis with the +L method. + =head1 METHODS =head2 str @@ -213,8 +244,8 @@ Takes a list of key-value pairs of names and subroutines, and replace the callback currently attached to the regular expression for the type given as the key by the code reference passed as the corresponding value. -The only valid key is currently C. See L for more details about -this callback. +The only valid keys are currently C and C. See L and +L for more details about these callbacks. =head2 num_captures diff --git a/Plugin.xs b/Plugin.xs index da33ce2..c16dfba 100644 --- a/Plugin.xs +++ b/Plugin.xs @@ -18,6 +18,7 @@ typedef struct { SV *comp; SV *exec; + SV *free; } xsh_hints_user_t; static SV *rep_validate_callback(SV *code) { @@ -34,6 +35,7 @@ static SV *rep_validate_callback(SV *code) { static void xsh_hints_user_init(pTHX_ xsh_hints_user_t *hv, xsh_hints_user_t *v) { hv->comp = rep_validate_callback(v->comp); hv->exec = rep_validate_callback(v->exec); + hv->free = rep_validate_callback(v->free); return; } @@ -43,6 +45,7 @@ static void xsh_hints_user_init(pTHX_ xsh_hints_user_t *hv, xsh_hints_user_t *v) static void xsh_hints_user_clone(pTHX_ xsh_hints_user_t *nv, xsh_hints_user_t *ov, CLONE_PARAMS *params) { nv->comp = xsh_dup_inc(ov->comp, params); nv->exec = xsh_dup_inc(ov->exec, params); + nv->free = xsh_dup_inc(ov->free, params); return; } @@ -52,6 +55,7 @@ static void xsh_hints_user_clone(pTHX_ xsh_hints_user_t *nv, xsh_hints_user_t *o static void xsh_hints_user_deinit(pTHX_ xsh_hints_user_t *hv) { SvREFCNT_dec(hv->comp); SvREFCNT_dec(hv->exec); + SvREFCNT_dec(hv->free); return; } @@ -248,6 +252,12 @@ Plugin_comp(pTHX_ const SV * const pattern, const U32 flags) SvREFCNT_inc_simple_void_NN(h->exec); } + /* Same goes for the free callback, if there's one. */ + if (h->free) { + re->cb_free = h->free; + SvREFCNT_inc_simple_void_NN(h->free); + } + re->cb_num_capture_buff_FETCH = NULL; re->cb_num_capture_buff_STORE = NULL; re->cb_num_capture_buff_LENGTH = NULL; @@ -359,6 +369,8 @@ Plugin_free(pTHX_ REGEXP * const RX) { struct regexp *rx; re__engine__Plugin self; + SV *callback; + dSP; if (PL_dirty) return; @@ -366,26 +378,6 @@ Plugin_free(pTHX_ REGEXP * const RX) rx = rxREGEXP(RX); SELF_FROM_PPRIVATE(self, rx->pprivate); - SvREFCNT_dec(self->pattern); - SvREFCNT_dec(self->str); - SvREFCNT_dec(self->stash); - - SvREFCNT_dec(self->cb_exec); - - SvREFCNT_dec(self->cb_num_capture_buff_FETCH); - SvREFCNT_dec(self->cb_num_capture_buff_STORE); - SvREFCNT_dec(self->cb_num_capture_buff_LENGTH); - - self->rx = NULL; - - Safefree(self); - - SvREFCNT_dec(rx->pprivate); - -/* - dSP; - SV *callback; - callback = self->cb_free; if (callback) { @@ -402,8 +394,24 @@ Plugin_free(pTHX_ REGEXP * const RX) FREETMPS; LEAVE; } + + SvREFCNT_dec(self->pattern); + SvREFCNT_dec(self->str); + SvREFCNT_dec(self->stash); + + SvREFCNT_dec(self->cb_exec); + + SvREFCNT_dec(self->cb_num_capture_buff_FETCH); + SvREFCNT_dec(self->cb_num_capture_buff_STORE); + SvREFCNT_dec(self->cb_num_capture_buff_LENGTH); + + self->rx = NULL; + + Safefree(self); + + SvREFCNT_dec(rx->pprivate); + return; -*/ } void * @@ -695,6 +703,16 @@ PPCODE: } XSRETURN(0); +void +_free(re::engine::Plugin self, ...) +PPCODE: + if (items > 1) { + SvREFCNT_dec(self->cb_free); + self->cb_free = ST(1); + SvREFCNT_inc_simple_void(self->cb_free); + } + XSRETURN(0); + void _num_capture_buff_FETCH(re::engine::Plugin self, ...) PPCODE: @@ -726,12 +744,13 @@ PPCODE: XSRETURN(0); SV * -_tag(SV *comp, SV *exec) +_tag(SV *comp, SV *exec, SV *free) PREINIT: xsh_hints_user_t arg; CODE: arg.comp = comp; arg.exec = exec; + arg.free = free; RETVAL = xsh_hints_tag(&arg); OUTPUT: RETVAL diff --git a/t/20-methods/free.t b/t/20-methods/free.t deleted file mode 100644 index 61c5dff..0000000 --- a/t/20-methods/free.t +++ /dev/null @@ -1,18 +0,0 @@ -=pod - -Test the C method - -=cut - -use strict; -use Test::More skip_all => "Doesn't work currently (where did my scope go?!)"; - -use re::engine::Plugin ( - comp => sub { - my ($re) = @_; - - $re->free( sub { pass "ran free" } ); - } -); - -"str" ~~ /pattern/; diff --git a/t/30-callbacks/free.t b/t/30-callbacks/free.t new file mode 100644 index 0000000..b3f1660 --- /dev/null +++ b/t/30-callbacks/free.t @@ -0,0 +1,42 @@ +=pod + +Test the C callback + +=cut + +use strict; +use Test::More tests => 2; + +my $pat = 'pattern'; + +{ + use re::engine::Plugin ( + free => sub { + pass 'default free callback'; + }, + ); + + # Regexp destruction happens too late for Test::More, so do it in an eval. + eval q[ + "str" =~ /$pat/; + ]; + die $@ if $@; +} + +{ + use re::engine::Plugin ( + comp => sub { + my ($re) = @_; + + $re->callbacks( + free => sub { pass 'free callback set in the comp callback' }, + ); + } + ); + + # Ditto. + eval q[ + "str" =~ /$pat/; + ]; + die $@ if $@; +}