[libcatmandu-perl] 14/85: Adding tests and documentation for Binds

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 fa45feeda7080ff7b92f22cb2c0440a0a9b36e4e
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Fri May 9 18:01:42 2014 +0200

    Adding tests and documentation for Binds
---
 lib/Catmandu/Fix/Bind.pm           |  62 ++++++++++---------
 lib/Catmandu/Fix/Bind/benchmark.pm |  14 +++--
 lib/Catmandu/Fix/Bind/each.pm      |  32 ++++++++++
 lib/Catmandu/Fix/Bind/eval.pm      |   3 -
 t/Catmandu-Fix-Bind-benchmark.t    |  96 +++++++++++++++++++++++++++++
 t/Catmandu-Fix-Bind-each.t         | 110 ++++++++++++++++++++++++++++++++++
 t/Catmandu-Fix-Bind-eval.t         | 116 +++++++++++++++++++++++++++++++++++
 t/Catmandu-Fix-Bind-identity.t     |  96 +++++++++++++++++++++++++++++
 t/Catmandu-Fix-Bind-loop.t         | 120 +++++++++++++++++++++++++++++++++++++
 t/Catmandu-Fix-Bind.t              |  15 +++++
 10 files changed, 627 insertions(+), 37 deletions(-)

diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm
index b8215e9..01e2052 100644
--- a/lib/Catmandu/Fix/Bind.pm
+++ b/lib/Catmandu/Fix/Bind.pm
@@ -8,18 +8,14 @@ requires 'bind';
 
 has fixes => (is => 'rw', default => sub { [] });
 
-sub BUILD {
-    warn "creating " . $_[0];
-}
-
 sub unit {
 	my ($self,$data) = @_;
 	return $data;
 }
 
 sub bind {
-    my ($self,$data,$code,$name) = @_;
-	return $code->($data);
+    my ($self,$data,$code,$name,$perl) = @_;
+	  return $code->($data);
 }
 
 sub finally {
@@ -66,42 +62,49 @@ sub emit_bind {
 
 =head1 NAME
 
-Catmandu::Fix::Bind - a Binder for fixes
+Catmandu::Fix::Bind - a wrapper for Catmandu::Fix-es
 
 =head1 SYNOPSIS
 
-  package Catmandu::Fix::Bind::Demo;
+  package Catmandu::Fix::Bind::demo;
   use Moo;
   with 'Catmandu::Fix::Bind';
 
   sub bind {
-    my $(self,$data,$code,$name) = @_;
+    my ($self,$data,$code,$name) = @_;
     warn "executing $name";
     $code->($data);
   }
 
-  package main;
-  use Catmandu::Importer::JSON;
-  use Catmandu::Fix;
-
-  my $importer = Catmandu::Importer::JSON->new(file => 'test.data');
-  my $fixer = Catmandu::Fix->new(
-           fixes => ['add_field("foo","bar"); set_field("foo","test")'],
-           binds => ['Demo']
-  );
+  # in your fix script you can now write
+  do
+     demo()
 
-  # This will print:
-  #   executing add_field
-  #   executing set_field
-  #   executing add_field
-  #   executing set_field
-  $fixer->fix($importer)->each(sub {});
+     fix1()
+     fix2()
+     fix3()
+  end
 
+  # this will execute all the fixes as expected plus print to STDERR
+  executing fix1
+  executing fix2
+  executing fix3
+   
 =head1 DESCRIPTION
 
 Bind is a package that wraps Catmandu::Fix-es and other Catmandu::Bind-s together. This gives
 the programmer further control on the excution of fixes. With Catmandu::Fix::Bind you can simulate
-the 'before', 'after' and 'around' modifiers as found in Moo. 
+the 'before', 'after' and 'around' modifiers as found in Moo or Dancer.
+
+To wrap Fix functions, the Fix language has provided a 'do' statment:
+
+  do BIND
+     FIX1
+     FIX2
+     FIX3
+  end
+
+In the example above the BIND will wrap FIX1, FIX2 and FIX3.
 
 A Catmandu::Fix::Bind needs to implement two methods: 'unit' and 'bind'.
 
@@ -124,17 +127,18 @@ The bind method is executed for every Catmandu::Fix method in the fixer. It rece
 code to run it. It should return the fixed code. A trivial implementaion of 'bind' is:
 
   sub bind {
-	  my ($self,$data,$code,$name) = @_;
-	  return $code->($data);
+    my ($self,$data,$code,$name) = @_;
+    return $code->($data);
   } 
 
 =head2 finally($data)
 
-Optionally finally is executed on the data when all the fixes have run.
+Optionally finally is executed on the data when all the fixes in a do block have run.
 
 =head1 SEE ALSO
 
-L<Catmandu::Fix>
+L<Catmandu::Fix::Bind::identity>, L<Catmandu::Fix::Bind::each> , L<Catmandu::Fix::Bind::loop> ,
+L<Catmandu::Fix::Bind::eval>, L<Catmandu::Fix::Bind::benchmark>
 
 =cut
 
diff --git a/lib/Catmandu/Fix/Bind/benchmark.pm b/lib/Catmandu/Fix/Bind/benchmark.pm
index 06eb964..807b309 100644
--- a/lib/Catmandu/Fix/Bind/benchmark.pm
+++ b/lib/Catmandu/Fix/Bind/benchmark.pm
@@ -6,7 +6,8 @@ use Time::HiRes qw(gettimeofday tv_interval);
 
 with 'Catmandu::Fix::Bind';
 
-has stats => (is => 'lazy');
+has output => (is => 'ro' , required => 1);
+has stats  => (is => 'lazy');
 
 sub _build_stats {
 	+{};
@@ -27,24 +28,27 @@ sub bind {
 
 sub DESTROY {
 	my ($self) = @_;
+	local(*OUT);
+	open (OUT, '>' , $self->output) || return undef;
 
-	printf STDERR "%-8.8s\t%-40.40s\t%-8.8s\t%-8.8s\n"
+	printf OUT "%-8.8s\t%-40.40s\t%-8.8s\t%-8.8s\n"
 					, 'elapsed'
 					, 'command'
 					, 'calls'
 					, 'sec/command';
-	printf STDERR "-" x 100 . "\n";
+	printf OUT "-" x 100 . "\n";
 
 	for my $key (sort { $self->stats->{$b}->{elapsed} cmp $self->stats->{$a}->{elapsed} } keys %{$self->stats} ) {
 		my $speed = $self->stats->{$key}->{elapsed} / $self->stats->{$key}->{count};
-		printf STDERR "%f\t%-40.40s\t%d times\t%f secs/command\n" 
+		printf OUT "%f\t%-40.40s\t%d times\t%f secs/command\n" 
 					, $self->stats->{$key}->{elapsed}
 					, $key 
 					, $self->stats->{$key}->{count}
 					, $speed;
 	}
 
-	printf STDERR "\n\n";
+	printf OUT "\n\n";
+	close (OUT);
 }
 
 1;
\ No newline at end of file
diff --git a/lib/Catmandu/Fix/Bind/each.pm b/lib/Catmandu/Fix/Bind/each.pm
index 2d30e27..f3958d3 100644
--- a/lib/Catmandu/Fix/Bind/each.pm
+++ b/lib/Catmandu/Fix/Bind/each.pm
@@ -46,4 +46,36 @@ sub finally {
     $data;
 }
 
+=head1 NAME
+
+Catmandu::Fix::Bind::each - loop over all the values in a path
+
+=head1 SYNOPSIS
+
+   add_field(demo.$append,foo)
+   add_field(demo.$append,bar)
+
+   do each(path => demo, index => val)
+        copy_field(val,demo2.$append)
+   end
+
+   # demo  = ['foo' , 'bar'];
+   # demo2 = ['foo' , 'bar'];
+
+=head1 PARAMETERS
+
+=head2 path (required)
+
+A path to an array ref over which the 'each' needs to loop
+
+=head2 index (optional)
+
+The name of an index field that gets populated for every value on the path
+
+=head1 SEE ALSO
+
+L<Catmandu::Fix::Bind>
+
+=cut
+
 1;
diff --git a/lib/Catmandu/Fix/Bind/eval.pm b/lib/Catmandu/Fix/Bind/eval.pm
index 35ee65d..a47a74b 100644
--- a/lib/Catmandu/Fix/Bind/eval.pm
+++ b/lib/Catmandu/Fix/Bind/eval.pm
@@ -15,9 +15,6 @@ sub bind {
 	if ($@) {
 		warn "$name : failed : $@";
 	}
-	else {
-		warn "$name : ok";
-	}
 
 	$data
 }
diff --git a/t/Catmandu-Fix-Bind-benchmark.t b/t/Catmandu-Fix-Bind-benchmark.t
new file mode 100644
index 0000000..d6c3ffc
--- /dev/null
+++ b/t/Catmandu-Fix-Bind-benchmark.t
@@ -0,0 +1,96 @@
+#!/usr/bin/env perl
+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 benchmark(output => /dev/null)
+  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 benchmark(output => /dev/null)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions';
+
+$fixes =<<EOF;
+do benchmark(output => /dev/null)
+  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 benchmark(output => /dev/null)
+  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 benchmark(output => /dev/null)
+  reject exists(foo)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject';
+
+$fixes =<<EOF;
+do benchmark(output => /dev/null)
+  select exists(foo)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select';
+
+$fixes =<<EOF;
+do benchmark(output => /dev/null)
+ do benchmark(output => /dev/null)
+  do benchmark(output => /dev/null)
+   add_field(foo,bar)
+  end
+ end
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting';
+
+done_testing 10;
\ No newline at end of file
diff --git a/t/Catmandu-Fix-Bind-each.t b/t/Catmandu-Fix-Bind-each.t
new file mode 100644
index 0000000..4021ac6
--- /dev/null
+++ b/t/Catmandu-Fix-Bind-each.t
@@ -0,0 +1,110 @@
+#!/usr/bin/env perl
+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::loop';
+    use_ok $pkg;
+}
+require_ok $pkg;
+
+my $fixes =<<EOF;
+do loop(count => 1)
+  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 loop(count => 1)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions';
+
+$fixes =<<EOF;
+do loop(count => 1)
+  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 loop(count => 1)
+  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 loop(count => 1)
+  reject exists(foo)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject';
+
+$fixes =<<EOF;
+do loop(count => 1)
+  select exists(foo)
+end
+EOF
+
+$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(foo,bar)
+  end
+ end
+end
+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)
+    copy_field(i,demo2.\$append)
+  end
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({}), { demo => [qw(foo bar)] , demo2 => [qw(foo foo bar bar)] } , 'testing each specifics';
+
+done_testing 11;
diff --git a/t/Catmandu-Fix-Bind-eval.t b/t/Catmandu-Fix-Bind-eval.t
new file mode 100644
index 0000000..b30af20
--- /dev/null
+++ b/t/Catmandu-Fix-Bind-eval.t
@@ -0,0 +1,116 @@
+#!/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
new file mode 100644
index 0000000..8caa8ad
--- /dev/null
+++ b/t/Catmandu-Fix-Bind-identity.t
@@ -0,0 +1,96 @@
+#!/usr/bin/env perl
+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::identity';
+    use_ok $pkg;
+}
+require_ok $pkg;
+
+my $fixes =<<EOF;
+do identity()
+  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 identity()
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions';
+
+$fixes =<<EOF;
+do identity()
+  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 identity()
+  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 identity()
+  reject exists(foo)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject';
+
+$fixes =<<EOF;
+do identity()
+  select exists(foo)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing select';
+
+$fixes =<<EOF;
+do identity()
+ do identity()
+  do identity()
+   add_field(foo,bar)
+  end
+ end
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting';
+
+done_testing 10;
\ No newline at end of file
diff --git a/t/Catmandu-Fix-Bind-loop.t b/t/Catmandu-Fix-Bind-loop.t
new file mode 100644
index 0000000..19eda6b
--- /dev/null
+++ b/t/Catmandu-Fix-Bind-loop.t
@@ -0,0 +1,120 @@
+#!/usr/bin/env perl
+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::loop';
+    use_ok $pkg;
+}
+require_ok $pkg;
+
+my $fixes =<<EOF;
+do loop(count => 1)
+  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 loop(count => 1)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing zero fix functions';
+
+$fixes =<<EOF;
+do loop(count => 1)
+  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 loop(count => 1)
+  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 loop(count => 1)
+  reject exists(foo)
+end
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+is_deeply $fixer->fix({foo => 'bar'}), undef , 'testing reject';
+
+$fixes =<<EOF;
+do loop(count => 1)
+  select exists(foo)
+end
+EOF
+
+$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(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 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
+EOF
+
+$fixer = Catmandu::Fix->new(fixes => [$fixes]);
+
+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 12;
diff --git a/t/Catmandu-Fix-Bind.t b/t/Catmandu-Fix-Bind.t
new file mode 100644
index 0000000..c43f94c
--- /dev/null
+++ b/t/Catmandu-Fix-Bind.t
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use Catmandu::Util qw(:is);
+
+my $pkg;
+BEGIN {
+    $pkg = 'Catmandu::Fix::Bind';
+    use_ok $pkg;
+}
+require_ok $pkg;
+
+done_testing 2;
\ No newline at end of file

-- 
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