Mercurial > pub > Impl
view _test/Test/Lang.pm @ 197:6b1dda998839
Added IMPL::declare, IMPL::require, to simplify module definitions
IMPL::Transform now admires object inheritance while searching for the transformation
Added HTTP some exceptions
IMPL::Web::Application::RestResource almost implemented
author | sergey |
---|---|
date | Thu, 19 Apr 2012 02:10:02 +0400 |
parents | 4d0e1962161c |
children |
line wrap: on
line source
package Test::Lang; use strict; use warnings; use parent qw(IMPL::Test::Unit); use IMPL::Test qw(test failed assert); use IMPL::lang qw(:hash :compare clone); use Scalar::Util qw(reftype); __PACKAGE__->PassThroughArgs; test equals => sub { assert( equals(1,1) ); assert( !equals(1,2) ); { my $warns = 0; local $SIG{__WARN__} = sub { $warns++ }; assert( !equals("1","2") ); assert( equals("sfds","zxcvgfd") ); assert( $warns == 2); } assert( equals(undef,undef) ); assert( !equals(1,undef) ); assert( !equals(undef,"zcx") ); }; test equals_s => sub { assert( equals_s(1,1) ); assert( !equals_s(1,2) ); assert( !equals_s("1","2") ); assert( !equals_s("sfds","zxcvgfd") ); assert( equals_s(undef,undef) ); assert( !equals_s(1,undef) ); assert( !equals_s(undef,"zcx") ); assert( equals_s("qwerty","qwerty") ); }; test hash => sub { my %a = ( a => 'a', b => 'b', c => 'c' ); my %b = ( a => 'a', c => 'z', x => 'x', ); my %diff = ( '-b' => 1, '+c' => 'z', '+x' => 'x' ); assert( ! hashCompare(\%a,\%b) ); assert( hashCompare(\%a,\%a) ); my $res = hashDiff(\%a,\%b); assert( ! hashCompare({},$res) ); assert( hashCompare($res,\%diff) ); assert( hashCompare( \%b, hashMerge(\%a,\%diff) ) ); }; test clone => sub { my $a; my $b = clone($a); assert(not defined $b); my $lp = { a => '1', rx => qr/abc$/ }; $lp->{b} = $lp; my $c = clone($lp); assert($c); assert($c->{b}); assert($c->{b} == $c); assert(reftype $c->{rx} eq 'REGEXP'); }; test hashParse => sub { my $res = hashParse("a = test a\nb = test b\nc c=test c"); assert($res->{a} eq "test a"); assert($res->{b} eq "test b"); assert($res->{"c c"} eq "test c"); $res = hashParse("a:b, c: d",qr/\s*:\s*/,qr/\s*,\s*/); assert($res->{a} eq "b"); assert($res->{c} eq "d"); }; 1;