[libcatmandu-perl] 11/101: Adding more tests
Jonas Smedegaard
dr at jones.dk
Tue Feb 23 13:43:49 UTC 2016
This is an automated email from the git hooks/post-receive script.
js pushed a commit to branch master
in repository libcatmandu-perl.
commit be27eac5c8b75e6cb0e3623cde8244d24b522be5
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Thu Dec 10 15:50:59 2015 +0100
Adding more tests
---
lib/Catmandu/Util.pm | 7 +-
t/Catmandu-Util.t | 266 ++++++++++++++++++++++++++++++++++++++++++++++++++-
t/russian.txt | 11 +++
t/small.json | 1 +
t/small.yaml | 3 +
5 files changed, 284 insertions(+), 4 deletions(-)
diff --git a/lib/Catmandu/Util.pm b/lib/Catmandu/Util.pm
index ce590ff..990b6f7 100644
--- a/lib/Catmandu/Util.pm
+++ b/lib/Catmandu/Util.pm
@@ -123,7 +123,7 @@ sub io {
sub read_file {
my ($path) = @_;
local $/;
- open my $fh, "<", $path or Catmandu::Error->throw(qq(can't open "$path" for reading));
+ open my $fh, "<:encoding(UTF-8)", $path or Catmandu::Error->throw(qq(can't open "$path" for reading));
my $str = <$fh>;
close $fh;
$str;
@@ -131,6 +131,7 @@ sub read_file {
sub read_io {
my ($io) = @_;
+ $io->binmode("encoding(UTF-8)");
my @lines = ();
while (<$io>) {
push @lines, $_;
@@ -142,7 +143,7 @@ sub read_io {
# Deprecated use tools like File::Slurp::Tiny
sub write_file {
my ($path, $str) = @_;
- open my $fh, ">", $path or Catmandu::Error->throw(qq(can't open "$path" for writing));
+ open my $fh, ">:encoding(UTF-8)", $path or Catmandu::Error->throw(qq(can't open "$path" for writing));
print $fh $str;
close $fh;
$path;
@@ -156,7 +157,7 @@ sub read_yaml {
sub read_json {
my $text = read_file($_[0]);
# dies on error
- JSON::XS::decode_json(read_file($_[0]));
+ JSON::XS->new->decode($text);
}
sub join_path {
diff --git a/t/Catmandu-Util.t b/t/Catmandu-Util.t
index 77905b7..6a31585 100644
--- a/t/Catmandu-Util.t
+++ b/t/Catmandu-Util.t
@@ -4,6 +4,10 @@ use strict;
use warnings;
use Test::More;
use Test::Exception;
+use IO::Handle;
+
+use utf8;
+use feature 'state';
my $pkg;
BEGIN {
@@ -137,4 +141,264 @@ for my $sym (qw(xml_declaration xml_escape)) {
can_ok 'T::ImportXML', $sym;
}
-done_testing 474;
+{
+ my $coderef = sub {
+ state $counter = 0;
+ return "Count: $counter\n" if $counter++ < 5;
+ };
+
+ my $io = Catmandu::Util::io($coderef, mode => 'r');
+
+ ok $io , 'io from code_ref read';
+ is $io->getline() , "Count: 1\n" , 'getline';
+}
+
+{
+ my $coderef = sub {
+ my $line = shift;
+ return 1;
+ };
+
+ my $io = Catmandu::Util::io($coderef, mode => 'w');
+
+ ok $io , 'io from code_ref write';
+ ok $io->print("Test") , 'print';
+}
+
+
+{
+ my $io = Catmandu::Util::io(IO::File->new("< Changes"));
+
+ ok $io , 'io IO::Handle instance';
+}
+
+{
+ use Math::BigRat;
+ throws_ok { Catmandu::Util::io(Math::BigRat->new('3/7')) } 'Catmandu::BadArg' , 'got Catmandu::BadArg';
+}
+
+{
+ my $test =<<EOF;
+На берегу пустынных волн
+Стоял он, дум великих полн,
+И вдаль глядел. Пред ним широко
+Река неслася; бедный чёлн
+По ней стремился одиноко.
+По мшистым, топким берегам
+Чернели избы здесь и там,
+Приют убогого чухонца;
+И лес, неведомый лучам
+В тумане спрятанного солнца,
+Кругом шумел.
+EOF
+ chop($test);
+ is Catmandu::Util::read_file("t/russian.txt") , $test , 'read_file';
+}
+
+{
+ my $test =<<EOF;
+На берегу пустынных волн
+Стоял он, дум великих полн,
+И вдаль глядел. Пред ним широко
+Река неслася; бедный чёлн
+По ней стремился одиноко.
+По мшистым, топким берегам
+Чернели избы здесь и там,
+Приют убогого чухонца;
+И лес, неведомый лучам
+В тумане спрятанного солнца,
+Кругом шумел.
+EOF
+ chop($test);
+ my $io = IO::File->new("< t/russian.txt");
+ is Catmandu::Util::read_io($io) , $test , 'read_io';
+}
+
+{
+ my $test =<<EOF;
+На берегу пустынных волн
+Стоял он, дум великих полн,
+И вдаль глядел. Пред ним широко
+Река неслася; бедный чёлн
+По ней стремился одиноко.
+По мшистым, топким берегам
+Чернели избы здесь и там,
+Приют убогого чухонца;
+И лес, неведомый лучам
+В тумане спрятанного солнца,
+Кругом шумел.
+EOF
+ chop($test);
+
+ my $filename = "$$.txt";
+ ok Catmandu::Util::write_file($filename,$test) ,'write_file';
+ is Catmandu::Util::read_file($filename) , $test , 'read_file';
+ unlink $filename;
+}
+
+{
+ is_deeply Catmandu::Util::read_yaml("t/small.yaml") , { "hello" => "ვეპხის ტყაოსანი შოთა რუსთაველი"} , 'read_yaml';
+}
+
+{
+ is_deeply Catmandu::Util::read_json("t/small.json") , { "hello" => "ვეპხის ტყაოსანი შოთა რუსთაველი"} , 'read_json';
+}
+
+is Catmandu::Util::join_path("/this/..","./is","..","./a/../weird/path","./../../isnt/../it") , "/it" , 'join_path';
+is Catmandu::Util::normalize_path("/this/../is/../a/../weird/path/../../isnt/../it") , "/it" , 'normalize_path';
+is Catmandu::Util::segmented_path("12345678",segment_size =>2,base_path=>"/x") , "/x/12/34/56/78" , 'segmented_path';
+
+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)';
+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)';
+is_deeply [Catmandu::Util::get_data([qw(0 1 2)], '*')] , [qw(0 1 2)] , 'get_data(*)';
+
+{
+ my $data = { foo => 'bar'};
+ Catmandu::Util::set_data($data,'foo','bar2');
+ is_deeply $data , { foo => 'bar2' } , 'set_data 1';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, 0, 'bar');
+ is_deeply $data , [qw(bar 1 2)] , 'set_data 2';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, '$first', 'bar');
+ is_deeply $data , [qw(bar 1 2)] , 'set_data 3';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, '$last', 'bar');
+ is_deeply $data , [qw(0 1 bar)] , 'set_data 4';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, '$prepend', 'bar');
+ is_deeply $data , [qw(bar 0 1 2)] , 'set_data 5';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, '$append', 'bar');
+ is_deeply $data , [qw(0 1 2 bar)] , 'set_data 6';
+}
+
+{
+ my $data = { foo => 'bar'};
+ Catmandu::Util::set_data($data,'foo','bar2');
+ is_deeply $data , { foo => 'bar2' } , 'set_data 1';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, 0, 'bar');
+ is_deeply $data , [qw(bar 1 2)] , 'set_data 2';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, '$first', 'bar');
+ is_deeply $data , [qw(bar 1 2)] , 'set_data 3';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, '$last', 'bar');
+ is_deeply $data , [qw(0 1 bar)] , 'set_data 4';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, '$prepend', 'bar');
+ is_deeply $data , [qw(bar 0 1 2)] , 'set_data 5';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::set_data($data, '$append', 'bar');
+ is_deeply $data , [qw(0 1 2 bar)] , 'set_data 6';
+}
+
+{
+ my $data = { foo => 'bar'};
+ Catmandu::Util::delete_data($data,'foo');
+ is_deeply $data , { } , 'delete_data 1';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::delete_data($data, 0);
+ is_deeply $data , [qw(1 2)] , 'delete_data 2';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::delete_data($data, '$first');
+ is_deeply $data , [qw(1 2)] , 'delete_data 3';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::delete_data($data, '$last');
+ is_deeply $data , [qw(0 1)] , 'delete_data 4';
+}
+
+{
+ my $data = [qw(0 1 2)];
+ Catmandu::Util::delete_data($data, '*');
+ is_deeply $data , [] , 'delete_data 5';
+}
+
+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';
+
+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';
+
+is_deeply Catmandu::Util::array_group_by([
+ { color => 'red' , number => 1} ,
+ { color => 'blue' , number => 2} ,
+ { color => 'green' , number => 3} ,
+ { number => 4}
+ ] , 'color') , {
+ red => [{ color => 'red' , number => 1}] ,
+ blue => [{ color => 'blue' , number => 2}] ,
+ green => [{ color => 'green' , number => 3}] ,
+ } , 'array_group_by';
+
+is_deeply Catmandu::Util::array_pluck([ { id => 1 } , { foo => 2 } , { id => 3}] , 'id') , [ 1, undef, 3] , 'array_pluck';
+
+is Catmandu::Util::array_sum([1,2,3,4,5,6,7,8,9,10]) , 55 , 'array_sum';
+
+ok Catmandu::Util::array_includes([{ foo => [ { bar => 1}]}] , {foo => [ { bar => 1}]} ) , 'array_includes';
+
+ok Catmandu::Util::array_any([0,1,2], sub { return 1 if shift == 2}) , 'array_any';
+
+is_deeply Catmandu::Util::array_rest([0,1,2]) , [1,2] , 'array_rest';
+
+is_deeply Catmandu::Util::array_uniq([0,1,2,2,2,2,3,3,2,3]) , [0,1,2,3] , 'array_uniq';
+
+is Catmandu::Util::capitalize("école") , "École" , 'capitalize';
+
+is Catmandu::Util::human_number(64354) , "64,354" , 'human_number';
+
+is Catmandu::Util::human_byte_size(10005000) , "10.01 MB" , 'human_byte_size';
+
+is Catmandu::Util::human_content_type('application/x-dos_ms_excel') , 'Excel' , 'human_content_type';
+
+is Catmandu::Util::xml_declaration() , qq(<?xml version="1.0" encoding="UTF-8"?>\n) , 'xml_declaration';
+
+is Catmandu::Util::xml_escape("<>'&") , '<>'&' , 'xml_escape';
+
+done_testing 531;
\ No newline at end of file
diff --git a/t/russian.txt b/t/russian.txt
new file mode 100644
index 0000000..cb2bc19
--- /dev/null
+++ b/t/russian.txt
@@ -0,0 +1,11 @@
+На берегу пустынных волн
+Стоял он, дум великих полн,
+И вдаль глядел. Пред ним широко
+Река неслася; бедный чёлн
+По ней стремился одиноко.
+По мшистым, топким берегам
+Чернели избы здесь и там,
+Приют убогого чухонца;
+И лес, неведомый лучам
+В тумане спрятанного солнца,
+Кругом шумел.
\ No newline at end of file
diff --git a/t/small.json b/t/small.json
new file mode 100644
index 0000000..e27d97d
--- /dev/null
+++ b/t/small.json
@@ -0,0 +1 @@
+{"hello":"ვეპხის ტყაოსანი შოთა რუსთაველი"}
diff --git a/t/small.yaml b/t/small.yaml
new file mode 100644
index 0000000..958b95f
--- /dev/null
+++ b/t/small.yaml
@@ -0,0 +1,3 @@
+---
+hello: ვეპხის ტყაოსანი შოთა რუსთაველი
+
--
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