1#!./perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 29;
7use List::Util qw(pairgrep pairfirst pairmap pairs unpairs pairkeys pairvalues);
8use Scalar::Util qw(blessed);
9
10no warnings 'misc'; # avoid "Odd number of elements" warnings most of the time
11
12is_deeply( [ pairgrep { $b % 2 } one => 1, two => 2, three => 3 ],
13           [ one => 1, three => 3 ],
14           'pairgrep list' );
15
16is( scalar( pairgrep { $b & 2 } one => 1, two => 2, three => 3 ),
17    2,
18    'pairgrep scalar' );
19
20is_deeply( [ pairgrep { $a } 0 => "zero", 1 => "one", 2 ],
21           [ 1 => "one", 2 => undef ],
22           'pairgrep pads with undef' );
23
24{
25  use warnings 'misc';
26  my $warnings = "";
27  local $SIG{__WARN__} = sub { $warnings .= $_[0] };
28
29  pairgrep { } one => 1, two => 2;
30  is( $warnings, "", 'even-sized list yields no warnings from pairgrep' );
31
32  pairgrep { } one => 1, two =>;
33  like( $warnings, qr/^Odd number of elements in pairgrep at /,
34        'odd-sized list yields warning from pairgrep' );
35}
36
37{
38  my @kvlist = ( one => 1, two => 2 );
39  pairgrep { $b++ } @kvlist;
40  is_deeply( \@kvlist, [ one => 2, two => 3 ], 'pairgrep aliases elements' );
41}
42
43is_deeply( [ pairfirst { length $a == 5 } one => 1, two => 2, three => 3 ],
44           [ three => 3 ],
45           'pairfirst list' );
46
47is_deeply( [ pairfirst { length $a == 4 } one => 1, two => 2, three => 3 ],
48           [],
49           'pairfirst list empty' );
50
51is( scalar( pairfirst { length $a == 5 } one => 1, two => 2, three => 3 ),
52    1,
53    'pairfirst scalar true' );
54
55ok( !scalar( pairfirst { length $a == 4 } one => 1, two => 2, three => 3 ),
56    'pairfirst scalar false' );
57
58is_deeply( [ pairmap { uc $a => $b } one => 1, two => 2, three => 3 ],
59           [ ONE => 1, TWO => 2, THREE => 3 ],
60           'pairmap list' );
61
62is( scalar( pairmap { qw( a b c ) } one => 1, two => 2 ),
63    6,
64    'pairmap scalar' );
65
66is_deeply( [ pairmap { $a => @$b } one => [1,1,1], two => [2,2,2], three => [3,3,3] ],
67           [ one => 1, 1, 1, two => 2, 2, 2, three => 3, 3, 3 ],
68           'pairmap list returning >2 items' );
69
70is_deeply( [ pairmap { $b } one => 1, two => 2, three => ],
71           [ 1, 2, undef ],
72           'pairmap pads with undef' );
73
74{
75  my @kvlist = ( one => 1, two => 2 );
76  pairmap { $b++ } @kvlist;
77  is_deeply( \@kvlist, [ one => 2, two => 3 ], 'pairmap aliases elements' );
78}
79
80# Calculating a 1000-element list should hopefully cause the stack to move
81# underneath pairmap
82is_deeply( [ pairmap { my @l = (1) x 1000; "$a=$b" } one => 1, two => 2, three => 3 ],
83           [ "one=1", "two=2", "three=3" ],
84           'pairmap copes with stack movement' );
85
86{
87    # do the pairmap and is_deeply as two separate statements to avoid
88    # the stack being extended before pairmap is called
89    my @a = pairmap { $a .. $b }
90                        1 => 3, 4 => 4, 5 => 6, 7 => 1998, 1999 => 2000;
91    my @exp; push @exp, $_ for 1..2000;
92    is_deeply( \@a, \@exp,
93           'pairmap result has more elements than input' );
94}
95
96is_deeply( [ pairs one => 1, two => 2, three => 3 ],
97           [ [ one => 1 ], [ two => 2 ], [ three => 3 ] ],
98           'pairs' );
99
100is_deeply( [ pairs one => 1, two => ],
101           [ [ one => 1 ], [ two => undef ] ],
102           'pairs pads with undef' );
103
104{
105  my @p = pairs one => 1, two => 2;
106  is( $p[0]->key,   "one", 'pairs ->key' );
107  is( $p[0]->value, 1,     'pairs ->value' );
108  is_deeply( $p[0]->TO_JSON,
109             [ one => 1 ],
110             'pairs ->TO_JSON' );
111  ok( !blessed($p[0]->TO_JSON) , 'pairs ->TO_JSON is not blessed' );
112}
113
114is_deeply( [ unpairs [ four => 4 ], [ five => 5 ], [ six => 6 ] ],
115           [ four => 4, five => 5, six => 6 ],
116           'unpairs' );
117
118is_deeply( [ unpairs [ four => 4 ], [ five => ] ],
119           [ four => 4, five => undef ],
120           'unpairs with short item fills in undef' );
121
122is_deeply( [ unpairs [ four => 4 ], [ five => 5, 5 ] ],
123           [ four => 4, five => 5 ],
124           'unpairs with long item truncates' );
125
126is_deeply( [ pairkeys one => 1, two => 2 ],
127           [qw( one two )],
128           'pairkeys' );
129
130is_deeply( [ pairvalues one => 1, two => 2 ],
131           [ 1, 2 ],
132           'pairvalues' );
133
134# pairmap within pairmap
135{
136  my @kvlist = (
137    o1 => [ iA => 'A', iB => 'B' ],
138    o2 => [ iC => 'C', iD => 'D' ],
139  );
140
141  is_deeply( [ pairmap { pairmap { $b } @$b } @kvlist ],
142             [ 'A', 'B', 'C', 'D', ],
143             'pairmap within pairmap' );
144}
145