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