3022b3653bbb995d5f946622f4b2e8a7c569887f
[perl.git] / ext / Pod-Simple / t / search20.t
1 BEGIN {
2     if($ENV{PERL_CORE}) {
3         chdir 't';
4         @INC = '../lib';
5     }
6 }
7
8 use strict;
9 use Pod::Simple::Search;
10 use Test;
11 BEGIN { plan tests => 7 }
12
13 print "# ", __FILE__,
14  ": Testing the scanning of several (well, two) docroots...\n";
15
16 my $x = Pod::Simple::Search->new;
17 die "Couldn't make an object!?" unless ok defined $x;
18
19 $x->inc(0);
20
21 $x->callback(sub {
22   print "#  ", join("  ", map "{$_}", @_), "\n";
23   return;
24 });
25
26 use File::Spec;
27 use Cwd;
28 my $cwd = cwd();
29 print "# CWD: $cwd\n";
30
31 sub source_path {
32     my $file = shift;
33     if ($ENV{PERL_CORE}) {
34         my $updir = File::Spec->updir;
35         my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't');
36         return File::Spec->catdir ($dir, $file);
37     } else {
38         return $file;
39     }
40 }
41
42 my($here1, $here2);
43 if(        -e ($here1 = source_path('testlib1'))) {
44   die "But where's $here2?"
45     unless -e ($here2 = source_path('testlib2'));
46 } elsif(   -e ($here1 = File::Spec->catdir($cwd, 't', 'testlib1'      ))) {
47   die "But where's $here2?"
48     unless -e ($here2 = File::Spec->catdir($cwd, 't', 'testlib2'));
49 } else {
50   die "Can't find the test corpora";
51 }
52 print "# OK, found the test corpora\n#  as $here1\n# and $here2\n";
53 ok 1;
54
55 print $x->_state_as_string;
56 #$x->verbose(12);
57
58 use Pod::Simple;
59 *pretty = \&Pod::Simple::BlackBox::pretty;
60
61 print "# OK, starting run...\n# [[\n";
62 my($name2where, $where2name) = $x->survey($here1, $here2);
63 print "# ]]\n#OK, run done.\n";
64
65 my $p = pretty( $where2name, $name2where )."\n";
66 $p =~ s/, +/,\n/g;
67 $p =~ s/^/#  /mg;
68 print $p;
69
70 {
71 my $names = join "|", sort values %$where2name;
72 skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0, 
73      $names, 
74      "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
75 }
76
77 {
78 my $names = join "|", sort keys %$name2where;
79 skip $^O eq 'VMS' ? '-- case may or may not be preserved' : 0, 
80      $names, 
81      "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik";
82 }
83
84 ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/');
85
86 ok grep( m/squaa\.pm/, keys %$where2name ), 1;
87
88 ok 1;
89
90 __END__
91