|
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);
|
|
179
|
9 use Scalar::Util qw(reftype);
|
|
168
|
10
|
|
|
11 __PACKAGE__->PassThroughArgs;
|
|
|
12
|
|
|
13 test equals => sub {
|
|
194
|
14 assert( equals(1,1) );
|
|
|
15 assert( !equals(1,2) );
|
|
|
16
|
|
|
17 {
|
|
|
18 my $warns = 0;
|
|
|
19 local $SIG{__WARN__} = sub { $warns++ };
|
|
|
20
|
|
|
21 assert( !equals("1","2") );
|
|
|
22 assert( equals("sfds","zxcvgfd") );
|
|
|
23 assert( $warns == 2);
|
|
|
24 }
|
|
|
25
|
|
|
26 assert( equals(undef,undef) );
|
|
|
27 assert( !equals(1,undef) );
|
|
|
28 assert( !equals(undef,"zcx") );
|
|
168
|
29 };
|
|
|
30
|
|
|
31 test equals_s => sub {
|
|
194
|
32 assert( equals_s(1,1) );
|
|
|
33 assert( !equals_s(1,2) );
|
|
|
34
|
|
|
35 assert( !equals_s("1","2") );
|
|
|
36 assert( !equals_s("sfds","zxcvgfd") );
|
|
|
37
|
|
|
38 assert( equals_s(undef,undef) );
|
|
|
39 assert( !equals_s(1,undef) );
|
|
|
40 assert( !equals_s(undef,"zcx") );
|
|
|
41
|
|
|
42 assert( equals_s("qwerty","qwerty") );
|
|
168
|
43 };
|
|
|
44
|
|
|
45 test hash => sub {
|
|
194
|
46
|
|
|
47 my %a = (
|
|
|
48 a => 'a',
|
|
|
49 b => 'b',
|
|
|
50 c => 'c'
|
|
|
51 );
|
|
|
52
|
|
|
53 my %b = (
|
|
|
54 a => 'a',
|
|
|
55 c => 'z',
|
|
|
56 x => 'x',
|
|
|
57 );
|
|
|
58
|
|
|
59 my %diff = (
|
|
|
60 '-b' => 1,
|
|
|
61 '+c' => 'z',
|
|
|
62 '+x' => 'x'
|
|
|
63 );
|
|
|
64
|
|
|
65
|
|
|
66 assert( ! hashCompare(\%a,\%b) );
|
|
|
67 assert( hashCompare(\%a,\%a) );
|
|
|
68
|
|
|
69 my $res = hashDiff(\%a,\%b);
|
|
|
70
|
|
|
71 assert( ! hashCompare({},$res) );
|
|
|
72 assert( hashCompare($res,\%diff) );
|
|
|
73
|
|
|
74 assert( hashCompare( \%b, hashMerge(\%a,\%diff) ) );
|
|
|
75
|
|
168
|
76 };
|
|
|
77
|
|
175
|
78 test clone => sub {
|
|
194
|
79
|
|
|
80 my $a;
|
|
|
81
|
|
|
82 my $b = clone($a);
|
|
|
83
|
|
|
84 assert(not defined $b);
|
|
|
85
|
|
|
86 my $lp = { a => '1', rx => qr/abc$/ };
|
|
|
87 $lp->{b} = $lp;
|
|
|
88
|
|
|
89 my $c = clone($lp);
|
|
|
90
|
|
|
91 assert($c);
|
|
|
92 assert($c->{b});
|
|
|
93 assert($c->{b} == $c);
|
|
|
94 assert(reftype $c->{rx} eq 'REGEXP');
|
|
|
95
|
|
174
|
96 };
|
|
|
97
|
|
194
|
98 test hashParse => sub {
|
|
|
99 my $res = hashParse("a = test a\nb = test b\nc c=test c");
|
|
|
100
|
|
|
101 assert($res->{a} eq "test a");
|
|
|
102 assert($res->{b} eq "test b");
|
|
|
103 assert($res->{"c c"} eq "test c");
|
|
|
104
|
|
|
105 $res = hashParse("a:b, c: d",qr/\s*:\s*/,qr/\s*,\s*/);
|
|
|
106
|
|
|
107 assert($res->{a} eq "b");
|
|
|
108 assert($res->{c} eq "d");
|
|
176
|
109 };
|
|
|
110
|
|
180
|
111 1;
|
