1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
#!perl -T
use strict;
use warnings;
use Test::More tests => 8;
BEGIN { use_ok("Sub::Exporter"); }
BEGIN {
package Thing;
BEGIN { main::use_ok("Sub::Exporter::Util", 'merge_col'); }
use Sub::Exporter -setup => {
collectors => [ qw(defaults etc) ],
exports => {
merge_col(
defaults => {
stack => sub { my @x = @_; sub { return @x } },
kcats => \'_kcats_gen',
},
empty => {
bogus => sub { my @x = @_; sub { return @x } },
klame => sub { my @x = @_; sub { return @x } },
},
etc => {
other => sub { my @x = @_; sub { return @x } },
},
),
plain => sub { my @x = @_; sub { return @x } },
},
};
sub _kcats_gen {
my @x = @_;
sub { return reverse @x }
}
}
package Test::SubExporter::MERGE::0;
my %col;
BEGIN {
Thing->import(
defaults => ($col{defaults} = { x => 10 }),
etc => ($col{etc} = { home => "Kansas" }),
stack => { x => 20, y => 30 },
kcats => { y => 3 },
bogus => undef,
klame => { bar => 99 },
other => undef,
plain => { foo => 10 },
);
}
my %tests = (
stack => [ 'Thing', 'stack', { x => 20, y => 30 }, \%col ],
kcats => [ \%col, { x => 10, y => 3 }, 'kcats', 'Thing' ],
bogus => [ 'Thing', 'bogus', {}, \%col ],
klame => [ 'Thing', 'klame', { bar => 99 }, \%col ],
other => [ 'Thing', 'other', { home => "Kansas" }, \%col ],
plain => [ 'Thing', 'plain', { foo => 10 }, \%col ],
);
while (my ($name, $expected) = each %tests) {
main::is_deeply(
[ __PACKAGE__->$name ],
$expected,
"$name returned proper value",
);
}
|
