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
|
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0;
use Attribute::Storage qw( find_vars_with_attr );
{
package Testing;
use Attribute::Storage;
sub Title :ATTR(SCALAR)
{
my $package = shift;
my ( $title ) = @_;
return $title;
}
our $ONE :Title("One") = 1;
our $TWO :Title("Two") = 2;
our $THREE :Title("Three") = 3;
}
my %vars = find_vars_with_attr "Testing", "Title";
is( $vars{'$ONE'}, \$Testing::ONE, 'find_vars_with_attr finds $ONE' );
is( $vars{'$TWO'}, \$Testing::TWO, 'find_vars_with_attr finds $TWO' );
is( $vars{'$THREE'}, \$Testing::THREE, 'find_vars_with_attr finds $THREE' );
# matching
{
my %vars = find_vars_with_attr "Testing", "Title", matching => sub { length == 4 };
ok( defined $vars{'$ONE'}, 'find_vars_with_attr matching CODE finds $ONE' );
ok( !defined $vars{'$THREE'}, 'find_vars_with_attr matching CODE does not find $THREE' );
%vars = find_vars_with_attr "Testing", "Title", matching => qr/^\$...$/;
ok( defined $vars{'$ONE'}, 'find_vars_with_attr matching Regexp finds $ONE' );
ok( !defined $vars{'$THREE'}, 'find_vars_with_attr matching Regexp does not find $THREE' );
}
# filter
{
my %vars = find_vars_with_attr "Testing", "Title", filter => sub {
my ( $varref ) = @_;
return $$varref % 2;
};
ok( defined $vars{'$ONE'}, 'find_vars_with_attr filter finds $ONE' );
ok( !defined $vars{'$TWO'}, 'find_vars_with_attr filter does not find $TWO' );
}
done_testing;
|
