1#!./perl
2
3use strict;
4use warnings;
5use Config; # to determine ivsize
6use Test::More tests => 31;
7use List::Util qw( uniqstr uniqint uniq );
8
9use Tie::Array;
10
11is_deeply( [ uniqstr ],
12           [],
13           'uniqstr of empty list' );
14
15is_deeply( [ uniqstr qw( abc ) ],
16           [qw( abc )],
17           'uniqstr of singleton list' );
18
19is_deeply( [ uniqstr qw( x x x ) ],
20           [qw( x )],
21           'uniqstr of repeated-element list' );
22
23is_deeply( [ uniqstr qw( a b a c ) ],
24           [qw( a b c )],
25           'uniqstr removes subsequent duplicates' );
26
27is_deeply( [ uniqstr qw( 1 1.0 1E0 ) ],
28           [qw( 1 1.0 1E0 )],
29           'uniqstr compares strings' );
30
31{
32    my $warnings = "";
33    local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
34
35    is_deeply( [ uniqstr "", undef ],
36               [ "" ],
37               'uniqstr considers undef and empty-string equivalent' );
38
39    ok( length $warnings, 'uniqstr on undef yields a warning' );
40
41    is_deeply( [ uniqstr undef ],
42               [ "" ],
43               'uniqstr on undef coerces to empty-string' );
44}
45
46SKIP: {
47    skip 'Perl 5.007003 with utf8::encode is required', 3 if $] lt "5.007003";
48    my $warnings = "";
49    local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
50
51    my $cafe = "cafe\x{301}";
52
53    is_deeply( [ uniqstr $cafe ],
54               [ $cafe ],
55               'uniqstr is happy with Unicode strings' );
56
57    SKIP: {
58      skip "utf8::encode not available", 1
59        unless defined &utf8::encode;
60      utf8::encode( my $cafebytes = $cafe );
61
62      is_deeply( [ uniqstr $cafe, $cafebytes ],
63                [ $cafe, $cafebytes ],
64                'uniqstr does not squash bytewise-equal but differently-encoded strings' );
65    }
66
67    is( $warnings, "", 'No warnings are printed when handling Unicode strings' );
68}
69
70is_deeply( [ uniqint ],
71           [],
72           'uniqint of empty list' );
73
74is_deeply( [ uniqint 5, 5 ],
75           [ 5 ],
76           'uniqint of repeated-element list' );
77
78is_deeply( [ uniqint 1, 2, 1, 3 ],
79           [ 1, 2, 3 ],
80           'uniqint removes subsequent duplicates' );
81
82is_deeply( [ uniqint 6.1, 6.2, 6.3 ],
83           [ 6 ],
84           'uniqint compares as and returns integers' );
85
86{
87    my $warnings = "";
88    local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
89
90    is_deeply( [ uniqint 0, undef ],
91               [ 0 ],
92               'uniqint considers undef and zero equivalent' );
93
94    ok( length $warnings, 'uniqint on undef yields a warning' );
95
96    is_deeply( [ uniqint undef ],
97               [ 0 ],
98               'uniqint on undef coerces to zero' );
99}
100
101SKIP: {
102    skip('UVs are not reliable on this perl version', 2) unless $] ge "5.008000";
103
104    my $maxbits = $Config{ivsize} * 8 - 1;
105
106    # An integer guaranteed to be a UV
107    my $uv = 1 << $maxbits;
108    is_deeply( [ uniqint $uv, $uv + 1 ],
109               [ $uv, $uv + 1 ],
110               'uniqint copes with UVs' );
111
112    my $nvuv = 2 ** $maxbits;
113    is_deeply( [ uniqint $nvuv, 0 ],
114               [ int($nvuv), 0 ],
115               'uniqint copes with NVUV dualvars' );
116}
117
118is_deeply( [ uniq () ],
119           [],
120           'uniq of empty list' );
121
122{
123    my $warnings = "";
124    local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
125
126    is_deeply( [ uniq "", undef ],
127               [ "", undef ],
128               'uniq distintinguishes empty-string from undef' );
129
130    is_deeply( [ uniq undef, undef ],
131               [ undef ],
132               'uniq considers duplicate undefs as identical' );
133
134    ok( !length $warnings, 'uniq on undef does not warn' );
135}
136
137is( scalar( uniqstr qw( a b c d a b e ) ), 5, 'uniqstr() in scalar context' );
138
139{
140    package Stringify;
141
142    use overload '""' => sub { return $_[0]->{str} };
143
144    sub new { bless { str => $_[1] }, $_[0] }
145
146    package main;
147
148    my @strs = map { Stringify->new( $_ ) } qw( foo foo bar );
149
150    is_deeply( [ map "$_", uniqstr @strs ],
151               [ map "$_", $strs[0], $strs[2] ],
152               'uniqstr respects stringify overload' );
153}
154
155SKIP: {
156    skip('int overload requires perl version 5.8.0', 1) unless $] ge "5.008000";
157
158    package Googol;
159
160    use overload '""' => sub { "1" . ( "0"x100 ) },
161                 'int' => sub { $_[0] };
162
163    sub new { bless {}, $_[0] }
164
165    package main;
166
167    is_deeply( [ uniqint( Googol->new, Googol->new ) ],
168               [ "1" . ( "0"x100 ) ],
169               'uniqint respects int overload' );
170}
171
172{
173    package DestroyNotifier;
174
175    use overload '""' => sub { "SAME" };
176
177    sub new { bless { var => $_[1] }, $_[0] }
178
179    sub DESTROY { ${ $_[0]->{var} }++ }
180
181    package main;
182
183    my @destroyed = (0) x 3;
184    my @notifiers = map { DestroyNotifier->new( \$destroyed[$_] ) } 0 .. 2;
185
186    my @uniqstr = uniqstr @notifiers;
187    undef @notifiers;
188
189    is_deeply( \@destroyed, [ 0, 1, 1 ],
190               'values filtered by uniqstr() are destroyed' );
191
192    undef @uniqstr;
193    is_deeply( \@destroyed, [ 1, 1, 1 ],
194               'all values destroyed' );
195}
196
197{
198    "a a b" =~ m/(.) (.) (.)/;
199    is_deeply( [ uniqstr $1, $2, $3 ],
200               [qw( a b )],
201               'uniqstr handles magic' );
202}
203
204{
205    my @array;
206    tie @array, 'Tie::StdArray';
207    @array = (
208        ( map { ( 1 .. 10 ) } 0 .. 1 ),
209        ( map { ( 'a' .. 'z' ) } 0 .. 1 )
210    );
211
212    my @u = uniq @array;
213    is_deeply(
214        \@u,
215        [ 1 .. 10, 'a' .. 'z' ],
216        'uniq uniquifies mixed numbers and strings correctly in a tied array'
217    );
218}
219