This is an automated email from the git hooks/post-receive script. js pushed a commit to tag 0.91 in repository libcatmandu-perl.
commit ae6801dbf90ac37a6ea81a0b24ccbb4d3552abff Author: Patrick Hochstenbach <patrick.hochstenb...@ugent.be> Date: Fri May 9 20:21:43 2014 +0200 Bind supporting return statements --- lib/Catmandu/Fix/Bind.pm | 3 ++ lib/Catmandu/Fix/Bind/eval.pm | 22 -------- lib/Catmandu/Fix/Bind/loop.pm | 2 +- t/Catmandu-Fix-Bind-benchmark.t | 2 +- t/Catmandu-Fix-Bind-each.t | 64 +++++++++++++++------- t/Catmandu-Fix-Bind-eval.t | 116 ---------------------------------------- t/Catmandu-Fix-Bind-identity.t | 2 +- t/Catmandu-Fix-Bind-loop.t | 2 +- 8 files changed, 51 insertions(+), 162 deletions(-) diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm index 01e2052..29c08f3 100644 --- a/lib/Catmandu/Fix/Bind.pm +++ b/lib/Catmandu/Fix/Bind.pm @@ -56,6 +56,9 @@ sub emit_bind { } $perl .= "${unit} = ${bind_var}->finally(${unit});" if $self->can('finally'); + + my $reject = $fixer->capture($fixer->_reject); + $perl .= "return ${unit} if ${unit} == ${reject};"; $perl; } diff --git a/lib/Catmandu/Fix/Bind/eval.pm b/lib/Catmandu/Fix/Bind/eval.pm deleted file mode 100644 index a47a74b..0000000 --- a/lib/Catmandu/Fix/Bind/eval.pm +++ /dev/null @@ -1,22 +0,0 @@ -package Catmandu::Fix::Bind::eval; - -use Moo; -use Data::Dumper; -use Perl::Tidy; - -with 'Catmandu::Fix::Bind'; - -sub bind { - my ($self,$data,$code,$name,$perl) = @_; - - eval { - $data = $code->($data); - }; - if ($@) { - warn "$name : failed : $@"; - } - - $data -} - -1; \ No newline at end of file diff --git a/lib/Catmandu/Fix/Bind/loop.pm b/lib/Catmandu/Fix/Bind/loop.pm index 767db38..72610e5 100644 --- a/lib/Catmandu/Fix/Bind/loop.pm +++ b/lib/Catmandu/Fix/Bind/loop.pm @@ -26,7 +26,7 @@ sub finally { if (defined $self->index) { $data->{$self->index} = $i; } - $data = $code->($data); + $data = $code->($data); } } diff --git a/t/Catmandu-Fix-Bind-benchmark.t b/t/Catmandu-Fix-Bind-benchmark.t index d6c3ffc..8338be8 100644 --- a/t/Catmandu-Fix-Bind-benchmark.t +++ b/t/Catmandu-Fix-Bind-benchmark.t @@ -67,7 +67,7 @@ EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); -is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; +ok ! defined $fixer->fix({foo => 'bar'}) , 'testing reject'; $fixes =<<EOF; do benchmark(output => /dev/null) diff --git a/t/Catmandu-Fix-Bind-each.t b/t/Catmandu-Fix-Bind-each.t index 4021ac6..ed0f2cf 100644 --- a/t/Catmandu-Fix-Bind-each.t +++ b/t/Catmandu-Fix-Bind-each.t @@ -9,15 +9,17 @@ use Catmandu::Util qw(:is); my $pkg; BEGIN { - $pkg = 'Catmandu::Fix::Bind::loop'; + $pkg = 'Catmandu::Fix::Bind::each'; use_ok $pkg; } require_ok $pkg; my $fixes =<<EOF; -do loop(count => 1) +add_field(test.\$append,1) +do each(path => test) add_field(foo,bar) end +remove_field(test) EOF my $fixer = Catmandu::Fix->new(fixes => [$fixes]); @@ -27,8 +29,10 @@ ok $fixer , 'create fixer'; is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing add_field'; $fixes =<<EOF; -do loop(count => 1) +add_field(test.\$append,1) +do each(path => test) end +remove_field(test) EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); @@ -36,11 +40,13 @@ $fixer = Catmandu::Fix->new(fixes => [$fixes]); is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions'; $fixes =<<EOF; -do loop(count => 1) +add_field(test.\$append,1) +do each(path => test) unless exists(foo) - add_field(foo,bar) + add_field(foo,bar) end end +remove_field(test) EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); @@ -48,11 +54,13 @@ $fixer = Catmandu::Fix->new(fixes => [$fixes]); is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing unless'; $fixes =<<EOF; -do loop(count => 1) +add_field(test.\$append,1) +do each(path => test) if exists(foo) - add_field(foo2,bar) + add_field(foo2,bar) end end +remove_field(test) EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); @@ -60,19 +68,23 @@ $fixer = Catmandu::Fix->new(fixes => [$fixes]); is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar', foo2 => 'bar'} , 'testing if'; $fixes =<<EOF; -do loop(count => 1) +add_field(test.\$append,1) +do each(path => test) reject exists(foo) end +remove_field(test) EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); -is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; +ok ! defined $fixer->fix({foo => 'bar'}) , 'testing reject'; $fixes =<<EOF; -do loop(count => 1) +add_field(test.\$append,1) +do each(path => test) select exists(foo) end +remove_field(test) EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); @@ -80,24 +92,36 @@ $fixer = Catmandu::Fix->new(fixes => [$fixes]); is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select'; $fixes =<<EOF; -do loop(count => 1) - do loop(count => 1) - do loop(count => 1) +add_field(test.\$append,1) +do each(path => test) + do each(path => test) + do each(path => test) add_field(foo,bar) end end end +remove_field(test) EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting'; -$fixes =<<EOF; -add_field(demo.\$append,foo) -add_field(demo.\$append,bar) -do each(path => demo, index => i) - do each(path => demo) +$fixes =<<EOF; +do loop(count => 3 , index => i) + copy_field(i,demo.\$append) + copy_field(i,demo2.\$append) +end +EOF + +$fixer = Catmandu::Fix->new(fixes => [$fixes]); + +is_deeply $fixer->fix({}), {demo => [(qw(0 1 2))] , demo2 => [qw(0 1 2 )]} , 'testing specific loop'; + +$fixes =<<EOF; +do loop(count => 3 , index => i) + copy_field(i,demo.\$append) + do loop(count => 3) copy_field(i,demo2.\$append) end end @@ -105,6 +129,6 @@ EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); -is_deeply $fixer->fix({}), { demo => [qw(foo bar)] , demo2 => [qw(foo foo bar bar)] } , 'testing each specifics'; +is_deeply $fixer->fix({}), {demo => [(qw(0 1 2))] , demo2 => [qw(0 0 0 1 1 1 2 2 2)]} , 'testing specific loop'; -done_testing 11; +done_testing 12; \ No newline at end of file diff --git a/t/Catmandu-Fix-Bind-eval.t b/t/Catmandu-Fix-Bind-eval.t deleted file mode 100644 index b30af20..0000000 --- a/t/Catmandu-Fix-Bind-eval.t +++ /dev/null @@ -1,116 +0,0 @@ -#!/usr/bin/env perl -package Catmandu::Fix::bad_fix; - -use Moo; - -sub fix { - die "this should show that something failed"; -} - -package main; - -use strict; -use warnings; -use Test::More; -use Test::Exception; -use Catmandu::Fix; -use Catmandu::Importer::Mock; -use Catmandu::Util qw(:is); - -my $pkg; -BEGIN { - $pkg = 'Catmandu::Fix::Bind::benchmark'; - use_ok $pkg; -} -require_ok $pkg; - -my $fixes =<<EOF; -do eval() - add_field(foo,bar) -end -EOF - -my $fixer = Catmandu::Fix->new(fixes => [$fixes]); - -ok $fixer , 'create fixer'; - -is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing add_field'; - -$fixes =<<EOF; -do eval() -end -EOF - -$fixer = Catmandu::Fix->new(fixes => [$fixes]); - -is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions'; - -$fixes =<<EOF; -do eval() - unless exists(foo) - add_field(foo,bar) - end -end -EOF - -$fixer = Catmandu::Fix->new(fixes => [$fixes]); - -is_deeply $fixer->fix({}), {foo => 'bar'} , 'testing unless'; - -$fixes =<<EOF; -do eval() - if exists(foo) - add_field(foo2,bar) - end -end -EOF - -$fixer = Catmandu::Fix->new(fixes => [$fixes]); - -is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar', foo2 => 'bar'} , 'testing if'; - -$fixes =<<EOF; -do eval() - reject exists(foo) -end -EOF - -$fixer = Catmandu::Fix->new(fixes => [$fixes]); - -is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; - -$fixes =<<EOF; -do eval() - select exists(foo) -end -EOF - -$fixer = Catmandu::Fix->new(fixes => [$fixes]); - -is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select'; - -$fixes =<<EOF; -do eval() - do eval() - do eval() - add_field(foo,bar) - end - end -end -EOF - -$fixer = Catmandu::Fix->new(fixes => [$fixes]); - -is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting'; - -$fixes =<<EOF; -do eval() - bad_fix() -end -EOF - -$fixer = Catmandu::Fix->new(fixes => [$fixes]); - -is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing bad_fix'; - -done_testing 11; \ No newline at end of file diff --git a/t/Catmandu-Fix-Bind-identity.t b/t/Catmandu-Fix-Bind-identity.t index 8caa8ad..b5989e6 100644 --- a/t/Catmandu-Fix-Bind-identity.t +++ b/t/Catmandu-Fix-Bind-identity.t @@ -67,7 +67,7 @@ EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); -is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; +ok !defined $fixer->fix({foo => 'bar'}) , 'testing reject'; $fixes =<<EOF; do identity() diff --git a/t/Catmandu-Fix-Bind-loop.t b/t/Catmandu-Fix-Bind-loop.t index 19eda6b..be05ed1 100644 --- a/t/Catmandu-Fix-Bind-loop.t +++ b/t/Catmandu-Fix-Bind-loop.t @@ -67,7 +67,7 @@ EOF $fixer = Catmandu::Fix->new(fixes => [$fixes]); -is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject'; +ok ! defined $fixer->fix({foo => 'bar'}) , 'testing reject'; $fixes =<<EOF; do loop(count => 1) -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits