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