1use strict;
2use warnings;
3use Pod::Simple::Search;
4use Test::More tests => 8;
5
6print "# ", __FILE__,
7 ": Testing limit_glob ...\n";
8
9my $x = Pod::Simple::Search->new;
10die "Couldn't make an object!?" unless ok defined $x;
11
12$x->inc(0);
13$x->shadows(1);
14
15use File::Spec;
16use Cwd ();
17use File::Basename ();
18
19my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__));
20
21my $here1 = File::Spec->catdir($t_dir, 'testlib1');
22my $here2 = File::Spec->catdir($t_dir, 'testlib2');
23my $here3 = File::Spec->catdir($t_dir, 'testlib3');
24
25print "# OK, found the test corpora\n#  as $here1\n# and $here2\n# and $here3\n#\n";
26
27print $x->_state_as_string;
28#$x->verbose(12);
29
30use Pod::Simple;
31*pretty = \&Pod::Simple::BlackBox::pretty;
32
33my $glob = 'squaa*';
34print "# Limiting to $glob\n";
35$x->limit_glob($glob);
36
37my($name2where, $where2name) = $x->survey($here1, $here2, $here3);
38
39my $p = pretty( $where2name, $name2where )."\n";
40$p =~ s/, +/,\n/g;
41$p =~ s/^/#  /mg;
42print $p;
43
44SKIP: {
45    skip '-- case may or may not be preserved', 2
46        if $^O eq 'VMS';
47
48    {
49        my $names = join "|", sort keys %$name2where;
50        is $names,
51            "squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo";
52    }
53
54    {
55        my $names = join "|", sort values %$where2name;
56        is $names,
57            "squaa|squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo";
58    }
59}
60
61my %count;
62for(values %$where2name) { ++$count{$_} };
63#print pretty(\%count), "\n\n";
64delete @count{ grep $count{$_} < 2, keys %count };
65my $shadowed = join "|", sort keys %count;
66ok $shadowed, "squaa::Vliff";
67
68sub thar { print "# Seen $_[0] :\n", map "#  {$_}\n", sort grep $where2name->{$_} eq $_[0],keys %$where2name; return; }
69
70is $count{'squaa::Vliff'}, 3;
71thar 'squaa::Vliff';
72
73
74ok   $name2where->{'squaa'};  # because squaa.pm IS squaa*
75
76like( ($name2where->{'squaa::Vliff'} || 'huh???'), qr/[^\^]testlib1/ );
77
78SKIP: {
79    skip '-- case may or may not be preserved', 1
80        if $^O eq 'VMS';
81
82    like +($name2where->{'squaa::Wowo'}  || 'huh???'),
83        qr/testlib2/;
84}
85