git.maemo.org Git - pkg-perl/blob - deb-src/libpod-simple-perl/libpod-simple-perl-3.07/t/search10.t

   1 BEGIN {
   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
  10 use strict;
  11
  12 #sub Pod::Simple::Search::DEBUG () {5};
  13
  14 use Pod::Simple::Search;
  15 use Test;
  16 BEGIN { plan tests => 7 }
  17
  18 print "# ", __FILE__,
  19  ": Testing the surveying of a single specified docroot...\n";
  20
  21 my $x = Pod::Simple::Search->new;
  22 die "Couldn't make an object!?" unless ok defined $x;
  23
  24 print "# Testing the surveying of the current directory...\n";
  25
  26 $x->inc(0);
  27
  28 use File::Spec;
  29 use Cwd;
  30 my $cwd = cwd();
  31 print "# CWD: $cwd\n";
  32
  33 sub 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
  45 my $here;
  46 if(     -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 }
  53 print "# OK, found the test corpus as $here\n";
  54 ok 1;
  55
  56 print $x->_state_as_string;
  57 #$x->verbose(12);
  58
  59 use Pod::Simple;
  60 *pretty = \&Pod::Simple::BlackBox::pretty;
  61
  62 my($name2where, $where2name) = $x->survey($here);
  63
  64 my $p = pretty( $where2name, $name2where )."\n";
  65 $p =~ s/, +/,\n/g;
  66 $p =~ s/^/#  /mg;
  67 print $p;
  68
  69 {
  70 my $names = join "|", sort values %$where2name;
  71 ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik";
  72 }
  73
  74 {
  75 my $names = join "|", sort keys %$name2where;
  76 ok $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik";
  77 }
  78
  79 ok( ($name2where->{'squaa'} || 'huh???'), '/squaa\.pm$/');
  80
  81 ok grep( m/squaa\.pm/, keys %$where2name ), 1;
  82
  83 ok 1;
  84
  85 __END__
  86