[libcatmandu-perl] 32/101: Fixing $append bug in data_at, adding more tests

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libcatmandu-perl.

commit 42aeee2708b51fe5fda8748e4f960eaaa11144f7
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Sat Dec 12 09:40:48 2015 +0100

    Fixing $append bug in data_at, adding more tests
---
 lib/Catmandu/Util.pm |  2 +-
 t/Catmandu-Util.t    | 72 +++++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 70 insertions(+), 4 deletions(-)

diff --git a/lib/Catmandu/Util.pm b/lib/Catmandu/Util.pm
index 75fd3c3..09abfd1 100644
--- a/lib/Catmandu/Util.pm
+++ b/lib/Catmandu/Util.pm
@@ -266,7 +266,7 @@ sub data_at {
                 if ($key eq '$first') { $key = 0 }
                 elsif ($key eq '$last') { $key = -1 }
                 elsif ($key eq '$prepend') { unshift @$data, undef; $key = 0 }
-                elsif ($key eq '$append') { $key = @$data }
+                elsif ($key eq '$append') { push @$data, undef; $key = @$data }
                 is_integer($key) || return;
                 if ($create && @$path) {
                     $data = $data->[$key] ||= is_integer($path->[0]) || ord($path->[0]) == ord('$') ? [] : {};
diff --git a/t/Catmandu-Util.t b/t/Catmandu-Util.t
index 78e3b91..6e91ffb 100644
--- a/t/Catmandu-Util.t
+++ b/t/Catmandu-Util.t
@@ -41,6 +41,9 @@ require_ok $pkg;
     use Catmandu::Util qw(:human);
     package T::ImportXML;
     use Catmandu::Util qw(:xml);
+    package T::Foo;
+    use Moo;
+    sub bar { 'bar' }
 }
 
 for my $sym (qw(same different)) {
@@ -251,6 +254,8 @@ is Catmandu::Util::segmented_path("12345678",segment_size =>2,base_path=>"/x") ,
 is_deeply [Catmandu::Util::parse_data_path("foo.bar.x")] , [ ['foo','bar'], "x" ] , "parse_data_path";
 
 is Catmandu::Util::get_data({ foo => 'bar'} , 'foo') , 'bar' , 'get_data(foo)';
+ok ! Catmandu::Util::get_data({ foo => 'bar'} , 'foo2') , 'get_data(foo2)';
+ok ! Catmandu::Util::get_data([qw(0 1 2)], 3) , 'get_data(3)';
 is Catmandu::Util::get_data([qw(0 1 2)], 1) , '1' , 'get_data(1)';
 is Catmandu::Util::get_data([qw(0 1 2)], '$first') , '0' , 'get_data($first)';
 is Catmandu::Util::get_data([qw(0 1 2)], '$last') , '2' , 'get_data($last)';
@@ -293,6 +298,24 @@ is_deeply [Catmandu::Util::get_data([qw(0 1 2)], '*')] , [qw(0 1 2)] , 'get_data
 }
 
 { 
+    my $data = [qw(0 1 2)];
+    Catmandu::Util::set_data($data, '*', 'bar', 'bar' , 'bar');
+    is_deeply $data , [qw(bar bar bar)] , 'set_data 7';
+}
+
+{ 
+    my $data = [qw(0 1 2)];
+    Catmandu::Util::set_data($data, 'foo', 'bar');
+    is_deeply $data , [qw(0 1 2)] , 'set_data 8';
+}
+
+{ 
+    my $data = undef;
+    Catmandu::Util::set_data($data,'foo2','bar2');
+    is_deeply $data , undef , 'set_data 9';
+}
+
+{ 
     my $data = { foo => 'bar'};
     Catmandu::Util::set_data($data,'foo','bar2');
     is_deeply $data , { foo => 'bar2' } , 'set_data 1';
@@ -358,11 +381,35 @@ is_deeply [Catmandu::Util::get_data([qw(0 1 2)], '*')] , [qw(0 1 2)] , 'get_data
     is_deeply $data , [] , 'delete_data 5';
 }
 
+{ 
+    my $data = [qw(0 1 2)];
+    Catmandu::Util::delete_data($data, '100');
+    is_deeply $data , [qw(0 1 2)] , 'delete_data 6';
+}
+
+{ 
+    my $data = undef;
+    Catmandu::Util::delete_data($data, '100');
+    is_deeply $data , undef , 'delete_data 7';
+}
+
 is Catmandu::Util::data_at('foo', { foo => 'bar'}) , 'bar' , 'data_at 1';
 is Catmandu::Util::data_at('foo.1', { foo => [qw(bar bar2 bar3)] }) , 'bar2' , 'data_at 2';
 is Catmandu::Util::data_at('foo.$first', { foo => [qw(bar bar2 bar3)] }) , 'bar' , 'data_at 3';
 is Catmandu::Util::data_at('foo.$last', { foo => [qw(bar bar2 bar3)] }) , 'bar3' , 'data_at 4';
 
+{
+    my $data = {foo => [qw(0 1 2)]};
+    is_deeply Catmandu::Util::data_at('foo.$prepend', $data) , undef , 'data_at 5';
+    is_deeply $data , {foo => [undef, qw(0 1 2)]} , 'data_at 5';
+}
+
+{
+    my $data = {foo => [qw(0 1 2)]};
+    is_deeply Catmandu::Util::data_at('foo.$append', $data) , undef , 'data_at 6';
+    is_deeply $data , {foo => [qw(0 1 2), undef]} , 'data_at 6';
+}
+
 ok Catmandu::Util::array_exists([qw(0 1 2)],0) , 'array_exists 1';
 ok ! Catmandu::Util::array_exists([qw(0 1 2)],3) , '!array_exists';
 
@@ -411,12 +458,31 @@ ok Catmandu::Util::is_different({ a => [ { b => 1 , c => 1 }]} , { a => [ { d =>
 
 ok Catmandu::Util::check_same({ a => [ { b => 1 , c => 1 }]} , { a => [ { c => 1 , b => 1 }]}) , 'check_same';
 
-throws_ok { Catmandu::Util::check_same({ a => [ { b => 1 , c => 1 }]} , { a => [ { d => 1 , b => 1 }]}) } 'Catmandu::BadVal' , '!check_same';
+throws_ok { Catmandu::Util::check_same({ a => [ { b => 1 , c => 1 }]} , { a => [ { d => 1 , b => 1 }]}) } 'Catmandu::BadVal' , '! check_same';
 
 ok Catmandu::Util::check_different({ a => [ { b => 1 , c => 1 }]} , { a => [ { b => 1 , b => 1 }]}) , 'check_different';
 
-throws_ok { Catmandu::Util::check_different({ a => [ { b => 1 , c => 1 }]} , { a => [ { c => 1 , b => 1 }]}) } 'Catmandu::BadVal' , '!check_different';
+throws_ok { Catmandu::Util::check_different({ a => [ { b => 1 , c => 1 }]} , { a => [ { c => 1 , b => 1 }]}) } 'Catmandu::BadVal' , '! check_different';
+
+ok Catmandu::Util::is_able(T::Foo->new,'bar') , 'is_able';
+ok !Catmandu::Util::is_able(T::Foo->new,'bar2') , '! is_able';
+ok !Catmandu::Util::is_able('123','bar2') , '! is_able';
+
+ok Catmandu::Util::check_able(T::Foo->new,'bar') , 'check_able';
+throws_ok { Catmandu::Util::check_able('123','bar2') } 'Catmandu::BadVal' , '! check_able';
+
+ok !Catmandu::Util::check_maybe_able(undef,'bar2') , 'check_maybe_able';
+throws_ok { Catmandu::Util::check_maybe_able('123','bar2') }  'Catmandu::BadVal' , '! check_maybe_able';
+
+ok Catmandu::Util::is_instance(T::Foo->new, 'T::Foo') , 'is_instance';
+ok ! Catmandu::Util::is_instance(T::Foo->new, 'T::Foo2') , '! is_instance';
+ok ! Catmandu::Util::is_instance(undef, 'T::Foo') , '! is_instance';
+
+ok Catmandu::Util::check_instance(T::Foo->new, 'T::Foo') , 'check_instance';
+throws_ok { Catmandu::Util::check_instance(undef, 'T::Foo')  } 'Catmandu::BadVal' , '! check_instance';
 
+ok ! Catmandu::Util::check_maybe_instance(undef, 'T::Foo') , '! check_maybe_instance';
+throws_ok { Catmandu::Util::check_maybe_instance(123, 'T::Foo')  } 'Catmandu::BadVal' , '! check_maybe_instance';
 
 is Catmandu::Util::human_number(64354) , "64,354" , 'human_number';
 
@@ -431,4 +497,4 @@ is Catmandu::Util::xml_declaration() , qq(<?xml version="1.0" encoding="UTF-8"?>
 
 is Catmandu::Util::xml_escape("<>'&") , '<>'&' , 'xml_escape';
 
-done_testing 547;
\ No newline at end of file
+done_testing 572;
\ 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