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 return "../lib/Pod/Simple/t/$file"; 37 } else { 38 return $file; 39 } 40} 41 42my $here; 43if( -e ($here = source_path('testlib1'))) { 44 # 45} elsif(-e ($here = File::Spec->catdir($cwd, 't', 'testlib1'))) { 46 # 47} else { 48 die "Can't find the test corpus"; 49} 50print "# OK, found the test corpus as $here\n"; 51ok 1; 52 53print $x->_state_as_string; 54#$x->verbose(12); 55 56use Pod::Simple; 57*pretty = \&Pod::Simple::BlackBox::pretty; 58 59my($name2where, $where2name) = $x->survey($here); 60 61my $p = pretty( $where2name, $name2where )."\n"; 62$p =~ s/, +/,\n/g; 63$p =~ s/^/# /mg; 64print $p; 65 66my $ascii_order; 67if( -e ($ascii_order = source_path('ascii_order.pl'))) { 68 # 69} elsif(-e ($ascii_order = File::Spec->catfile($cwd, 't', 'ascii_order.pl'))) { 70 # 71} else { 72 print STDERR __FILE__, ": ", __LINE__, ": ascii_order='$ascii_order'; curdir=", $cwd, "; ", File::Spec->catfile($cwd, 't', 'ascii_order.pl'), "\n"; 73 die "Can't find ascii_order.pl"; 74} 75 76require $ascii_order; 77 78{ 79my $names = join "|", sort ascii_order values %$where2name; 80ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 81} 82 83{ 84my $names = join "|", sort ascii_order keys %$name2where; 85ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 86} 87 88ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/'); 89 90ok grep( m/squaa\.pm/, keys %$where2name ), 1; 91 92###### Now with recurse(0) 93 94print "# Testing the surveying of a single docroot without recursing...\n"; 95 96$x->recurse(0); 97($name2where, $where2name) = $x->survey($here); 98 99$p = pretty( $where2name, $name2where )."\n"; 100$p =~ s/, +/,\n/g; 101$p =~ s/^/# /mg; 102print $p; 103 104{ 105my $names = join "|", sort ascii_order values %$where2name; 106ok $names, "Blorm|squaa|zikzik"; 107} 108 109{ 110my $names = join "|", sort ascii_order keys %$name2where; 111ok $names, "Blorm|squaa|zikzik"; 112} 113 114ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/'); 115 116ok grep( m/squaa\.pm/, keys %$where2name ), 1; 117 118ok 1; 119 120__END__ 121 122