← Back to branch summary

~ubuntu-branches/ubuntu/trusty/libperl5i-perl/trusty-proposed

« back to all changes in this revision

Viewing changes to t/List-Util/reduce.t

  • Committer: Bazaar Package Importer
  • Author(s): Ivan Kohler
  • Date: 2010-05-08 17:42:00 UTC
  • Revision ID: james.westby@ubuntu.com-20100508174200-7ogg0zrimh9gvcuw
Tags: upstream-2.1.1
Import upstream version 2.1.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/List-Util/reduce.t
 
1
#!perl
 
2
 
 
3
use perl5i::latest;
 
4
 
 
5
use Test::More tests => 20;
 
6
 
 
7
my $v = []->reduce( sub { } );
 
8
 
 
9
is( $v, undef, 'no args' );
 
10
 
 
11
$v = [ 756, 3, 7, 4 ]->reduce( sub { $a / $b } );
 
12
is( $v, 9, '4-arg divide' );
 
13
 
 
14
$v = [6]->reduce( sub { $a / $b } );
 
15
is( $v, 6, 'one arg' );
 
16
 
 
17
my @a = map { rand } 0 .. 20;
 
18
$v = @a->reduce( sub { $a < $b ? $a : $b } );
 
19
is( $v, @a->min, 'min' );
 
20
 
 
21
@a = map { pack( "C", int( rand(256) ) ) } 0 .. 20;
 
22
$v = @a->reduce( sub { $a . $b } );
 
23
is( $v, join( "", @a ), 'concat' );
 
24
 
 
25
sub add {
 
26
    my( $aa, $bb ) = @_;
 
27
    return $aa + $bb;
 
28
}
 
29
 
 
30
$v = [ 3, 2, 1 ]->reduce( sub { my $t = "$a $b\n"; 0 + add( $a, $b ) } );
 
31
is( $v, 6, 'call sub' );
 
32
 
 
33
# Check that eval{} inside the block works correctly
 
34
$v = [ 0, 1, 2, 3, 4 ]->reduce(
 
35
    sub {
 
36
        eval { die };
 
37
        $a + $b;
 
38
    }
 
39
);
 
40
is( $v, 10, 'use eval{}' );
 
41
 
 
42
$v = !defined eval {
 
43
    [ 0 .. 4 ]->reduce( sub { die if $b > 2; $a + $b } );
 
44
};
 
45
ok( $v, 'die' );
 
46
 
 
47
sub foobar {
 
48
    [ 0 .. 3 ]->reduce( sub { ( defined(wantarray) && !wantarray ) ? $a + 1 : 0 } );
 
49
}
 
50
($v) = foobar();
 
51
is( $v, 3, 'scalar context' );
 
52
 
 
53
sub add2 { $a + $b }
 
54
 
 
55
$v = [ 1, 2, 3 ]->reduce( \&add2 );
 
56
is( $v, 6, 'sub reference' );
 
57
 
 
58
$v = [ 3, 4, 5 ]->reduce( sub { add2() } );
 
59
is( $v, 12, 'call sub' );
 
60
 
 
61
 
 
62
$v = [ 1, 2, 3 ]->reduce( sub { eval "$a + $b" } );
 
63
is( $v, 6, 'eval string' );
 
64
 
 
65
$a = 8;
 
66
$b = 9;
 
67
$v = [ 1, 2, 3 ]->reduce( sub { $a * $b } );
 
68
is( $a, 8, 'restore $a' );
 
69
is( $b, 9, 'restore $b' );
 
70
 
 
71
 
 
72
# Can we leave the sub with 'return'?
 
73
$v = [ 2, 4, 6 ]->reduce( sub { return $a + $b } );
 
74
is( $v, 12, 'return' );
 
75
 
 
76
# ... even in a loop?
 
77
$v = [ 2, 4, 6 ]->reduce(
 
78
    sub {
 
79
        while(1) { return $a + $b }
 
80
    }
 
81
);
 
82
is( $v, 12, 'return from loop' );
 
83
 
 
84
 
 
85
# Does it work from another package?
 
86
# FIXME: this doesn't work
 
87
#{
 
88
#       package Foo;
 
89
#       $a = $b;
 
90
#       ::is([1..4]->reduce( sub {$a*$b} ), 24, 'other package');
 
91
#}
 
92
 
 
93
 
 
94
# Can we undefine a reduce sub while it's running?
 
95
sub self_immolate { undef &self_immolate; 1 }
 
96
eval { $v = [ 1, 2 ]->reduce( \&self_immolate ) };
 
97
like( $@, qr/^Can't undef active subroutine/, "undef active sub" );
 
98
 
 
99
# Redefining an active sub should not fail, but whether the
 
100
# redefinition takes effect immediately depends on whether we're
 
101
# running the Perl or XS implementation.
 
102
 
 
103
{
 
104
    my $warn;
 
105
    local $SIG{__WARN__} = sub { $warn = shift };
 
106
 
 
107
    sub self_updating {
 
108
        local $^W;
 
109
        *self_updating = sub { 1 };
 
110
        1;
 
111
    }
 
112
    my $l = "line " . ( __LINE__ - 3 ) . ".\n";
 
113
    eval { $v = [ 1, 2 ]->reduce( \&self_updating ) };
 
114
    is( $@, '', 'redefine self' );
 
115
    is( $warn, "Subroutine main::self_updating redefined at $0 $l" );
 
116
}
 
117
 
 
118
{
 
119
    my $failed = 0;
 
120
 
 
121
    sub rec {
 
122
        # No arg means we're being called by reduce()
 
123
        return 1 unless @_;
 
124
 
 
125
        my $n = shift;
 
126
 
 
127
        if( $n < 5 ) {
 
128
            rec( $n + 1 );
 
129
        }
 
130
        else {
 
131
            $v = [ 1, 2 ]->reduce( \&rec );
 
132
        }
 
133
 
 
134
        $failed = 1 if !defined $n;
 
135
    }
 
136
 
 
137
    rec(1);
 
138
    ok( !$failed, 'from active sub' );
 
139
}
 
140