[libcatmandu-perl] 15/85: Bind supporting return statements
Jonas Smedegaard
dr at jones.dk
Tue May 20 09:56:15 UTC 2014
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.hochstenbach at 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
More information about the Pkg-perl-cvs-commits
mailing list