From: Ævar Arnfjörð Bjarmason Date: Thu, 27 Dec 2007 20:56:28 +0000 (+0000) Subject: Backported from 0.04_01 X-Git-Tag: v0.04~7 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fre-engine-Plugin.git;a=commitdiff_plain;h=86e082409eeb8df843893486f92273c0e46d7637 Backported from 0.04_01 --- diff --git a/ChangeLog b/ChangeLog index 9755293..3651a43 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,16 @@ -2007-12-27 Ævar Arnfjörð Bjarmason +2007-12-27 Ævar Arnfjörð Bjarmason (0.04) * Plugin.(xs|h): Fix up prototypes to match the callbacks in the actual 5.10 release + * Plugin.xs: Dumped CODE: in favor of PPCODE:, the former is teh sux + * Plugin.xs: Minor cleanups here and there + * Plugin.pod: New todo and a developer release notice + * Plugin.[h|pm]: Named buffer callbacks + * t/methods/stash.t: Test return value of $rx->stash({}); + * t/methods/str/modify.t: New test for modification of ->str when + a reference is used + * t/methods/str/types.t: This was testing pattern types, fixed + * t/Example.[t|pm]: Moved to t/usage + 2007-05-17 Ævar Arnfjörð Bjarmason (0.03) diff --git a/Plugin.h b/Plugin.h index 1f354d5..1b18630 100644 --- a/Plugin.h +++ b/Plugin.h @@ -1,4 +1,3 @@ - #define GET_SELF_FROM_PPRIVATE(pprivate) \ re__engine__Plugin self; \ SELF_FROM_PPRIVATE(self,pprivate); diff --git a/Plugin.pm b/Plugin.pm index 220dfdf..062f152 100644 --- a/Plugin.pm +++ b/Plugin.pm @@ -26,7 +26,7 @@ sub import my ($pkg, %sub) = @_; # Valid callbacks - my @callback = qw(comp exec intuit checkstr free dupe); + my @callback = qw(comp exec); for (@callback) { next unless exists $sub{$_}; diff --git a/Plugin.xs b/Plugin.xs index d0bc33e..5e5452a 100644 --- a/Plugin.xs +++ b/Plugin.xs @@ -67,7 +67,7 @@ Plugin_comp(pTHX_ const SV * const pattern, const U32 flags) rx->extflags = flags; /* Flags for perl to use */ rx->engine = RE_ENGINE_PLUGIN; /* Compile to use this engine */ - /* Store a precompiled regexp for pp_regcomp to use */ + /* Precompiled pattern for pp_regcomp to use */ rx->prelen = plen; rx->precomp = savepvn(exp, rx->prelen); @@ -292,9 +292,7 @@ Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const rx, const SV * const sv, dSP; I32 items; SV * callback; - re__engine__Plugin self; - - SELF_FROM_PPRIVATE(self,rx->pprivate); + GET_SELF_FROM_PPRIVATE(rx->pprivate); callback = self->cb_num_capture_buff_LENGTH; @@ -347,23 +345,17 @@ Plugin_package(pTHX_ REGEXP * const rx) } MODULE = re::engine::Plugin PACKAGE = re::engine::Plugin -PROTOTYPES: ENABLE +PROTOTYPES: DISABLE -SV * +void pattern(re::engine::Plugin self, ...) -CODE: - SvREFCNT_inc(self->pattern); - RETVAL = self->pattern; -OUTPUT: - RETVAL +PPCODE: + XPUSHs(self->pattern); -SV * +void str(re::engine::Plugin self, ...) -CODE: - SvREFCNT_inc(self->str); - RETVAL = self->str; -OUTPUT: - RETVAL +PPCODE: + XPUSHs(self->str); char* mod(re::engine::Plugin self, ...) @@ -398,50 +390,58 @@ PPCODE: XPUSHs(&PL_sv_yes); } -SV * +void stash(re::engine::Plugin self, ...) -PREINIT: - SV * stash; -CODE: +PPCODE: if (items > 1) { - self->stash = sv_mortalcopy(ST(1)); + self->stash = ST(1); SvREFCNT_inc(self->stash); + XSRETURN_EMPTY; + } else { + XPUSHs(self->stash); } - SvREFCNT_inc(self->stash); - RETVAL = self->stash; -OUTPUT: - RETVAL -SV * +void minlen(re::engine::Plugin self, ...) -CODE: +PPCODE: if (items > 1) { self->rx->minlen = (I32)SvIV(ST(1)); + XSRETURN_EMPTY; + } else { + if (self->rx->minlen) { + XPUSHs(sv_2mortal(newSViv(self->rx->minlen))); + } else { + XPUSHs(sv_2mortal(&PL_sv_undef)); + } } - RETVAL = self->rx->minlen ? newSViv(self->rx->minlen) : &PL_sv_undef; -OUTPUT: - RETVAL - -SV * +void gofs(re::engine::Plugin self, ...) -CODE: +PPCODE: if (items > 1) { self->rx->gofs = (U32)SvIV(ST(1)); + XSRETURN_EMPTY; + } else { + if (self->rx->gofs) { + XPUSHs(sv_2mortal(newSVuv(self->rx->gofs))); + } else { + XPUSHs(sv_2mortal(&PL_sv_undef)); + } } - RETVAL = self->rx->gofs ? newSVuv(self->rx->gofs) : &PL_sv_undef; -OUTPUT: - RETVAL -SV * +void nparens(re::engine::Plugin self, ...) -CODE: +PPCODE: if (items > 1) { self->rx->nparens = (U32)SvIV(ST(1)); + XSRETURN_EMPTY; + } else { + if (self->rx->nparens) { + XPUSHs(sv_2mortal(newSVuv(self->rx->nparens))); + } else { + XPUSHs(sv_2mortal(&PL_sv_undef)); + } } - RETVAL = self->rx->nparens ? newSVuv(self->rx->nparens) : &PL_sv_undef; -OUTPUT: - RETVAL void _num_capture_buff_FETCH(re::engine::Plugin self, ...) diff --git a/t/methods/stash.t b/t/methods/stash.t index b719753..9083263 100644 --- a/t/methods/stash.t +++ b/t/methods/stash.t @@ -5,7 +5,7 @@ Test the C method =cut use strict; -use Test::More tests => 4; +use Test::More tests => 5; use re::engine::Plugin ( comp => sub { @@ -19,6 +19,8 @@ use re::engine::Plugin ( my ($re, $str) = @_; my $stash = $re->stash; + my $ret = $re->stash( $stash ); + ok(!$ret, "stash returns no value on assignment"); my %h = qw( 0 a 1 o 2 e 3 u ); for (keys %h) { is($h{$_}, $stash->[$_]); diff --git a/t/methods/str/modify.t b/t/methods/str/modify.t new file mode 100644 index 0000000..0d4536f --- /dev/null +++ b/t/methods/str/modify.t @@ -0,0 +1,16 @@ +use strict; +use Test::More tests => 1; +use re::engine::Plugin ( + exec => sub { + my ($re, $str) = @_; + + $$str = "eek"; + + return 1; + }, +); + +my $sv = "ook"; +if (\$sv =~ /pattern/) { + is($sv, "eek"); +} diff --git a/t/methods/str/types.t b/t/methods/str/types.t index f79ba36..f5064e9 100644 --- a/t/methods/str/types.t +++ b/t/methods/str/types.t @@ -4,18 +4,17 @@ use re::engine::Plugin ( exec => sub { my ($re, $str) = @_; - is_deeply($str, $re->str); + isa_ok($str, $re->pattern); return 1; }, ); my $sv; -"SCALAR" =~ \$sv; -"REF" =~ \\$sv; -"ARRAY" =~ []; -"HASH" =~ {}; -"GLOB" =~ \*STDIN; -"CODE" =~ sub {}; -"main" =~ bless {} => "main"; - +\$sv =~ "SCALAR"; +\\$sv =~ "REF"; +[] =~ "ARRAY"; +{} =~ "HASH"; +\*STDIN =~ "GLOB"; +sub {} =~ "CODE"; +bless({} => "main") =~ "main" diff --git a/t/Example.pm b/t/usage/basic.pm similarity index 96% rename from t/Example.pm rename to t/usage/basic.pm index efe9bab..80add8b 100644 --- a/t/Example.pm +++ b/t/usage/basic.pm @@ -1,4 +1,4 @@ -package Example; +package basic; use strict; # Note the (), doesn't call ->import diff --git a/t/Example.t b/t/usage/basic.t similarity index 72% rename from t/Example.t rename to t/usage/basic.t index f9080c0..d7f2c57 100644 --- a/t/Example.t +++ b/t/usage/basic.t @@ -1,8 +1,8 @@ use strict; -use lib 't'; +use lib 't/usage'; use Test::More tests => 1; -use Example; +use basic; "str" =~ /pattern/; diff --git a/t/usage/impor.t b/t/usage/impor.t new file mode 100644 index 0000000..40aad43 --- /dev/null +++ b/t/usage/impor.t @@ -0,0 +1,40 @@ +use strict; +use lib 't/usage'; +use Test::More skip_all => "Needs lameness in user code"; + +# my $caller = caller; +# +# This won't work unless the subs are predeclared before the C statement +# # Handle import tags +# if (@_ == 1) { +# if ($_[0] ne ":import") { +# require Carp; +# Carp::croak("Unknown tag '$_[0]'"); +# } +# +# # We have :import, generate import and unimport methods in the +# # calling package +# my %pkg; +# for (qw(comp exec)) { +# no strict 'refs'; +# $pkg{$_} = *{"$caller\::$_"}{CODE} if *{"$caller\::$_"}{CODE}; +# } +# +# use Data::Dumper; +# warn Dumper \%pkg; +# +# no strict 'refs'; +# *{"$caller\::import"} = sub { +# __PACKAGE__->import(%pkg); +# }; +# *{"$caller\::unimport"} = \&unimport; +# +# return; +# } +# + +use import; + +"ook" =~ /pattern/; + +is($1, "ook_1"); diff --git a/t/usage/import.pm b/t/usage/import.pm new file mode 100644 index 0000000..0c364ec --- /dev/null +++ b/t/usage/import.pm @@ -0,0 +1,22 @@ +package import; +use strict; + +sub exec; +use re::engine::Plugin ':import'; + +sub exec +{ + my ($re, $str) = @_; + + $re->num_captures( + FETCH => sub { + my ($re, $paren) = @_; + + $str . "_" . $paren; + } + ); + + 1; +} + +1;