1use strict;
2use warnings;
3use Test::More tests => 13;
4
5use Pod::Simple::Search;
6
7print "# ", __FILE__,
8 ": Testing the scanning of several docroots...\n";
9
10my $x = Pod::Simple::Search->new;
11die "Couldn't make an object!?" unless ok defined $x;
12
13$x->inc(0);
14$x->shadows(1);
15
16use File::Spec;
17use Cwd ();
18use File::Basename ();
19
20my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__));
21
22my $here1 = File::Spec->catdir($t_dir, 'testlib1');
23my $here2 = File::Spec->catdir($t_dir, 'testlib2');
24my $here3 = File::Spec->catdir($t_dir, 'testlib3');
25
26print "# OK, found the test corpora\n#  as $here1\n# and $here2\n# and $here3\n#\n";
27
28print $x->_state_as_string;
29#$x->verbose(12);
30
31use Pod::Simple;
32*pretty = \&Pod::Simple::BlackBox::pretty;
33
34my($name2where, $where2name) = $x->survey($here1, $here2, $here3);
35
36my $p = pretty( $where2name, $name2where )."\n";
37$p =~ s/, +/,\n/g;
38$p =~ s/^/#  /mg;
39print $p;
40
41require File::Spec->catfile($t_dir, 'ascii_order.pl');
42
43SKIP: {
44    skip '-- case may or may not be preserved', 2
45        if $^O eq 'VMS';
46
47    {
48        print "# won't show any shadows, since we're just looking at the name2where keys\n";
49        my $names = join "|", sort ascii_order keys %$name2where;
50
51        is $names,
52            "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
53    }
54
55    {
56        print "# but here we'll see shadowing:\n";
57        my $names = join "|", sort ascii_order values %$where2name;
58        is $names,
59            "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Glunk|hinkhonk::Vliff|hinkhonk::Vliff|perlflif|perlthng|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo|zikzik";
60    }
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 ascii_order keys %count;
69is $shadowed, "hinkhonk::Glunk|hinkhonk::Vliff|perlthng|squaa::Vliff";
70
71sub thar { print "# Seen $_[0] :\n", map "#  {$_}\n", sort ascii_order grep $where2name->{$_} eq $_[0],keys %$where2name; return; }
72
73is $count{'perlthng'}, 2;
74thar 'perlthng';
75is $count{'squaa::Vliff'}, 3;
76thar 'squaa::Vliff';
77}
78
79
80like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/);
81
82is grep( m/squaa\.pm/, keys %$where2name ), 1;
83
84like( ($name2where->{'perlthng'}    || 'huh???'), qr/[^\^]testlib1/ );
85like( ($name2where->{'squaa::Vliff'} || 'huh???'), qr/[^\^]testlib1/ );
86
87SKIP: {
88    skip '-- case may or may not be preserved', 1
89        if $^O eq 'VMS';
90
91    # Some sanity:
92    like
93        +($name2where->{'squaa::Wowo'}  || 'huh???'),
94        qr/testlib2/;
95}
96
97my $in_pods = $x->find('perlzoned', $here2);
98like $in_pods, qr{^\Q$here2\E};
99like $in_pods, qr{perlzoned.pod$};
100