1BEGIN {
2    if($ENV{PERL_CORE}) {
3        chdir 't';
4        @INC = '../lib';
5    }
6}
7
8use strict;
9use warnings;
10use Pod::Simple::Search;
11use Test;
12BEGIN { plan tests => 15 }
13
14print "# ", __FILE__,
15 ": Testing the scanning of several docroots...\n";
16
17my $x = Pod::Simple::Search->new;
18die "Couldn't make an object!?" unless ok defined $x;
19
20$x->inc(0);
21$x->shadows(1);
22
23use File::Spec;
24use Cwd;
25my $cwd = cwd();
26print "# CWD: $cwd\n";
27
28sub source_path {
29    my $file = shift;
30    if ($ENV{PERL_CORE}) {
31        return "../lib/Pod/Simple/t/$file";
32    } else {
33        return $file;
34    }
35}
36
37my($here1, $here2, $here3);
38
39if(        -e ($here1 = source_path('testlib1'      ))) {
40  die "But where's $here2?"
41    unless -e ($here2 = source_path('testlib2'));
42  die "But where's $here3?"
43    unless -e ($here3 = source_path('testlib3'));
44
45} elsif(   -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1'      ))) {
46  die "But where's $here2?"
47    unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2'));
48  die "But where's $here3?"
49    unless -e ($here3 = File::Spec->catdir($cwd, 't', 'testlib3'));
50
51} else {
52  die "Can't find the test corpora";
53}
54print "# OK, found the test corpora\n#  as $here1\n# and $here2\n# and $here3\n#\n";
55ok 1;
56
57print $x->_state_as_string;
58#$x->verbose(12);
59
60use Pod::Simple;
61*pretty = \&Pod::Simple::BlackBox::pretty;
62
63my($name2where, $where2name) = $x->survey($here1, $here2, $here3);
64
65my $p = pretty( $where2name, $name2where )."\n";
66$p =~ s/, +/,\n/g;
67$p =~ s/^/#  /mg;
68print $p;
69
70my $ascii_order;
71if(     -e ($ascii_order = source_path('ascii_order.pl'))) {
72  #
73} elsif(-e ($ascii_order = File::Spec->catfile($cwd, 't', 'ascii_order.pl'))) {
74  #
75} else {
76  die "Can't find ascii_order.pl";
77}
78
79require $ascii_order;
80
81{
82print "# won't show any shadows, since we're just looking at the name2where keys\n";
83my $names = join "|", sort ascii_order keys %$name2where;
84skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
85     $names,
86     "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
87}
88
89{
90print "# but here we'll see shadowing:\n";
91my $names = join "|", sort ascii_order values %$where2name;
92skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
93     $names,
94     "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";
95
96my %count;
97for(values %$where2name) { ++$count{$_} };
98#print pretty(\%count), "\n\n";
99delete @count{ grep $count{$_} < 2, keys %count };
100my $shadowed = join "|", sort ascii_order keys %count;
101ok $shadowed, "hinkhonk::Glunk|hinkhonk::Vliff|perlthng|squaa::Vliff";
102
103sub thar { print "# Seen $_[0] :\n", map "#  {$_}\n", sort ascii_order grep $where2name->{$_} eq $_[0],keys %$where2name; return; }
104
105ok $count{'perlthng'}, 2;
106thar 'perlthng';
107ok $count{'squaa::Vliff'}, 3;
108thar 'squaa::Vliff';
109}
110
111
112ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/');
113
114ok grep( m/squaa\.pm/, keys %$where2name ), 1;
115
116ok( ($name2where->{'perlthng'}    || 'huh???'), '/[^\^]testlib1/' );
117ok( ($name2where->{'squaa::Vliff'} || 'huh???'), '/[^\^]testlib1/' );
118
119# Some sanity:
120skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0,
121    ($name2where->{'squaa::Wowo'}  || 'huh???'),
122    '/testlib2/';
123
124my $in_pods = $x->find('perlzoned', $here2);
125ok $in_pods, qr{^\Q$here2\E};
126ok $in_pods, qr{perlzoned.pod$};
127
128print "# OK, bye from ", __FILE__, "\n";
129ok 1;
130
131__END__
132
133