1b39c5158Smillertuse strict; 2256a93a4Safresh1use warnings; 3*5486feefSafresh1use Test::More tests => 8; 4b39c5158Smillert 5b39c5158Smillert#sub Pod::Simple::Search::DEBUG () {5}; 6b39c5158Smillert 7b39c5158Smillertuse Pod::Simple::Search; 8b39c5158Smillert 9b39c5158Smillertprint "# ", __FILE__, 10b39c5158Smillert ": Testing limit_glob ...\n"; 11b39c5158Smillert 12b39c5158Smillertmy $x = Pod::Simple::Search->new; 13b39c5158Smillertdie "Couldn't make an object!?" unless ok defined $x; 14b39c5158Smillert 15b39c5158Smillert$x->inc(0); 16b39c5158Smillert$x->shadows(1); 17b39c5158Smillert 18b39c5158Smillertuse File::Spec; 19*5486feefSafresh1use Cwd (); 20*5486feefSafresh1use File::Basename (); 21b39c5158Smillert 22*5486feefSafresh1my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); 23b39c5158Smillert 24*5486feefSafresh1my $here1 = File::Spec->catdir($t_dir, 'testlib1'); 25*5486feefSafresh1my $here2 = File::Spec->catdir($t_dir, 'testlib2'); 26*5486feefSafresh1my $here3 = File::Spec->catdir($t_dir, 'testlib3'); 27b39c5158Smillert 28b39c5158Smillertprint "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; 29b39c5158Smillert 30b39c5158Smillertprint $x->_state_as_string; 31b39c5158Smillert#$x->verbose(12); 32b39c5158Smillert 33b39c5158Smillertuse Pod::Simple; 34b39c5158Smillert*pretty = \&Pod::Simple::BlackBox::pretty; 35b39c5158Smillert 36b39c5158Smillertmy $glob = 'squaa::*'; 37b39c5158Smillertprint "# Limiting to $glob\n"; 38b39c5158Smillert$x->limit_glob($glob); 39b39c5158Smillert 40b39c5158Smillertmy($name2where, $where2name) = $x->survey($here1, $here2, $here3); 41b39c5158Smillert 42b39c5158Smillertmy $p = pretty( $where2name, $name2where )."\n"; 43b39c5158Smillert$p =~ s/, +/,\n/g; 44b39c5158Smillert$p =~ s/^/# /mg; 45b39c5158Smillertprint $p; 46b39c5158Smillert 47*5486feefSafresh1SKIP: { 48*5486feefSafresh1 skip '-- case may or may not be preserved', 2 49*5486feefSafresh1 if $^O eq 'VMS'; 50*5486feefSafresh1 51b39c5158Smillert { 52b39c5158Smillert my $names = join "|", sort keys %$name2where; 53*5486feefSafresh1 is $names, 54b39c5158Smillert "squaa::Glunk|squaa::Vliff|squaa::Wowo"; 55b39c5158Smillert } 56b39c5158Smillert 57b39c5158Smillert { 58b39c5158Smillert my $names = join "|", sort values %$where2name; 59*5486feefSafresh1 is $names, 60b39c5158Smillert "squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo"; 61*5486feefSafresh1 } 62*5486feefSafresh1} 63b39c5158Smillert 64b39c5158Smillertmy %count; 65b39c5158Smillertfor(values %$where2name) { ++$count{$_} }; 66b39c5158Smillert#print pretty(\%count), "\n\n"; 67b39c5158Smillertdelete @count{ grep $count{$_} < 2, keys %count }; 68b39c5158Smillertmy $shadowed = join "|", sort keys %count; 69*5486feefSafresh1is $shadowed, "squaa::Vliff"; 70b39c5158Smillert 71b39c5158Smillertsub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort grep $where2name->{$_} eq $_[0],keys %$where2name; return; } 72b39c5158Smillert 73*5486feefSafresh1is $count{'squaa::Vliff'}, 3; 74b39c5158Smillertthar 'squaa::Vliff'; 75b39c5158Smillert 76b39c5158Smillert 77b39c5158Smillertok ! $name2where->{'squaa'}; # because squaa.pm isn't squaa::* 78b39c5158Smillert 79*5486feefSafresh1like( ($name2where->{'squaa::Vliff'} || 'huh???'), qr/[^\^]testlib1/ ); 80b39c5158Smillert 81*5486feefSafresh1SKIP: { 82*5486feefSafresh1 skip '-- case may or may not be preserved', 1 83*5486feefSafresh1 if $^O eq 'VMS'; 84b39c5158Smillert 85*5486feefSafresh1 like +($name2where->{'squaa::Wowo'} || 'huh???'), 86*5486feefSafresh1 qr/testlib2/; 87*5486feefSafresh1} 88