1BEGIN { 2 if($ENV{PERL_CORE}) { 3 chdir 't'; 4 @INC = '../lib'; 5 } 6} 7 8# Time-stamp: "2004-05-23 22:38:58 ADT" 9 10use strict; 11 12#sub Pod::Simple::Search::DEBUG () {5}; 13 14use Pod::Simple::Search; 15use Test; 16BEGIN { plan tests => 11 } 17 18print "# ", __FILE__, 19 ": Testing the surveying of a single specified docroot...\n"; 20 21my $x = Pod::Simple::Search->new; 22die "Couldn't make an object!?" unless ok defined $x; 23 24print "# Testing the surveying of a single docroot...\n"; 25 26$x->inc(0); 27 28use File::Spec; 29use Cwd; 30my $cwd = cwd(); 31print "# CWD: $cwd\n"; 32 33sub source_path { 34 my $file = shift; 35 if ($ENV{PERL_CORE}) { 36 require File::Spec; 37 my $updir = File::Spec->updir; 38 my $dir = File::Spec->catdir($updir, 'lib', 'Pod', 'Simple', 't'); 39 return File::Spec->catdir ($dir, $file); 40 } else { 41 return $file; 42 } 43} 44 45my $here; 46if( -e ($here = source_path('testlib1'))) { 47 # 48} elsif(-e ($here = File::Spec->catdir($cwd, 't', 'testlib1'))) { 49 # 50} else { 51 die "Can't find the test corpus"; 52} 53print "# OK, found the test corpus as $here\n"; 54ok 1; 55 56print $x->_state_as_string; 57#$x->verbose(12); 58 59use Pod::Simple; 60*pretty = \&Pod::Simple::BlackBox::pretty; 61 62my($name2where, $where2name) = $x->survey($here); 63 64my $p = pretty( $where2name, $name2where )."\n"; 65$p =~ s/, +/,\n/g; 66$p =~ s/^/# /mg; 67print $p; 68 69{ 70my $names = join "|", sort values %$where2name; 71ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 72} 73 74{ 75my $names = join "|", sort keys %$name2where; 76ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 77} 78 79ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/'); 80 81ok grep( m/squaa\.pm/, keys %$where2name ), 1; 82 83###### Now with recurse(0) 84 85print "# Testing the surveying of a single docroot without recursing...\n"; 86 87$x->recurse(0); 88($name2where, $where2name) = $x->survey($here); 89 90$p = pretty( $where2name, $name2where )."\n"; 91$p =~ s/, +/,\n/g; 92$p =~ s/^/# /mg; 93print $p; 94 95{ 96my $names = join "|", sort values %$where2name; 97ok $names, "Blorm|squaa|zikzik"; 98} 99 100{ 101my $names = join "|", sort keys %$name2where; 102ok $names, "Blorm|squaa|zikzik"; 103} 104 105ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/'); 106 107ok grep( m/squaa\.pm/, keys %$where2name ), 1; 108 109ok 1; 110 111__END__ 112 113