view _test/Test/Lang.pm @ 194:4d0e1962161c

Replaced tabs with spaces IMPL::Web::View - fixed document model, new features (control classes, document constructor parameters)
author cin
date Tue, 10 Apr 2012 20:08:29 +0400
parents d1676be8afcc
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;