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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0;
use meta;
no warnings qw( meta::experimental );
{
my $metapkg = meta::package->get( "meta" );
my $metaglob = $metapkg->get_glob( "get_package" );
ok( $metaglob, '$metapkg->get_glob on get_package' );
is( $metaglob->basename, "get_package",
'$metaglob->basename' );
$metaglob = meta::for_reference( \*meta );
ok( $metaglob->is_glob, '$metaglob for reference ->is_glob' );
is( $metaglob->basename, "meta",
'$metaglob from for_reference' );
}
# missing
{
my $metapkg = meta::package->get( "meta" );
ok( !defined $metapkg->try_get_glob( "not-a-glob" ),
'try_get_glob yields undef on missing glob' );
like( dies { $metapkg->get_glob( "not-a-glob" ) },
qr/^Package does not contain a glob called "not-a-glob" /,
'get_glob throws on missing glob' );
}
# meta::glob->get method
{
my $metaglob = meta::glob->get( "meta::get_package" );
ok( $metaglob, 'meta:;glob->get on meta::get_package' );
is( $metaglob->basename, "get_package",
'$metaglob->basename' );
}
# missing on methods
{
ok( !defined meta::glob->try_get( "not-a-glob" ),
'meta::glob->try_get yields undef on missing glob' );
like( dies { meta::glob->get( "not-a-glob" ) },
qr/^Symbol table does not contain a glob called "not-a-glob" /,
'meta::glob->get throws on missing glob' );
}
# ->get_or_add
{
ok( !defined meta::glob->try_get( "created-symbol" ),
'created-symbol did not exist' );
my $metaglob = meta::glob->get_or_add( "created-symbol" );
ok( $metaglob, '->get_or_add returned metaglob' );
is( $metaglob->basename, "created-symbol",
'Name of newly-created symbol' );
ok( defined meta::glob->try_get( "created-symbol" ),
'created-symbol now exists' );
}
# ->list_*_globs
{
my $metapkg = meta::package->get( "meta" );
my @metaglobs = $metapkg->list_globs;
# Don't be too sensitive to what globs we found
ok( scalar @metaglobs, 'list_globs returned a list of globs' );
ok( scalar( grep { $_->basename eq "get_package" } @metaglobs ),
'list_globs result included a glob for "get_package"' );
ok( !scalar( grep { $_->basename eq "package::" } @metaglobs ),
'list_globs does not return subpackages' );
my @metaglobs_pkgs = $metapkg->list_subpackage_globs;
ok( scalar( grep { $_->basename eq "package::" } @metaglobs_pkgs ),
'list_subpackage_globs returns subpackages' );
my @metaglobs_all = $metapkg->list_all_globs;
ok( @metaglobs + @metaglobs_pkgs == @metaglobs_all,
'list_all_globs returns a list totalling the prior two' );
}
done_testing;
|
