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