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