|
168
|
1 package Test::Lang;
|
|
|
2 use strict;
|
|
|
3 use warnings;
|
|
|
4
|
|
|
5 use parent qw(IMPL::Test::Unit);
|
|
|
6
|
|
|
7 use IMPL::Test qw(test failed assert);
|
|
174
|
8 use IMPL::lang qw(:hash :compare clone);
|
|
168
|
9
|
|
|
10 __PACKAGE__->PassThroughArgs;
|
|
|
11
|
|
|
12 test equals => sub {
|
|
|
13 assert( equals(1,1) );
|
|
|
14 assert( !equals(1,2) );
|
|
|
15
|
|
|
16 {
|
|
|
17 my $warns = 0;
|
|
|
18 local $SIG{__WARN__} = sub { $warns++ };
|
|
|
19
|
|
|
20 assert( !equals("1","2") );
|
|
|
21 assert( equals("sfds","zxcvgfd") );
|
|
|
22 assert( $warns == 2);
|
|
|
23 }
|
|
|
24
|
|
|
25 assert( equals(undef,undef) );
|
|
|
26 assert( !equals(1,undef) );
|
|
|
27 assert( !equals(undef,"zcx") );
|
|
|
28 };
|
|
|
29
|
|
|
30 test equals_s => sub {
|
|
|
31 assert( equals_s(1,1) );
|
|
|
32 assert( !equals_s(1,2) );
|
|
|
33
|
|
|
34 assert( !equals_s("1","2") );
|
|
|
35 assert( !equals_s("sfds","zxcvgfd") );
|
|
|
36
|
|
|
37 assert( equals_s(undef,undef) );
|
|
|
38 assert( !equals_s(1,undef) );
|
|
|
39 assert( !equals_s(undef,"zcx") );
|
|
|
40
|
|
|
41 assert( equals_s("qwerty","qwerty") );
|
|
|
42 };
|
|
|
43
|
|
|
44 test hash => sub {
|
|
|
45
|
|
|
46 my %a = (
|
|
|
47 a => 'a',
|
|
|
48 b => 'b',
|
|
|
49 c => 'c'
|
|
|
50 );
|
|
|
51
|
|
|
52 my %b = (
|
|
|
53 a => 'a',
|
|
|
54 c => 'z',
|
|
|
55 x => 'x',
|
|
|
56 );
|
|
|
57
|
|
|
58 my %diff = (
|
|
|
59 '-b' => 1,
|
|
|
60 '+c' => 'z',
|
|
|
61 '+x' => 'x'
|
|
|
62 );
|
|
|
63
|
|
|
64
|
|
|
65 assert( ! hashCompare(\%a,\%b) );
|
|
|
66 assert( hashCompare(\%a,\%a) );
|
|
|
67
|
|
|
68 my $res = hashDiff(\%a,\%b);
|
|
|
69
|
|
|
70 assert( ! hashCompare({},$res) );
|
|
|
71 assert( hashCompare($res,\%diff) );
|
|
|
72
|
|
|
73 assert( hashCompare( \%b, hashMerge(\%a,\%diff) ) );
|
|
|
74
|
|
|
75 };
|
|
|
76
|
|
175
|
77 test clone => sub {
|
|
|
78
|
|
|
79 my $a;
|
|
|
80
|
|
|
81 my $b = clone($a);
|
|
|
82
|
|
|
83 assert(not defined $b);
|
|
|
84
|
|
|
85 my $lp = { a => '1' };
|
|
|
86 $lp->{b} = $lp;
|
|
|
87
|
|
|
88 my $c = clone($lp);
|
|
|
89
|
|
|
90 assert($c);
|
|
|
91 assert($c->{b});
|
|
|
92 assert($c->{b} == $c);
|
|
174
|
93
|
|
|
94 };
|
|
|
95
|
|
168
|
96 1; |
