Commit | Line | Data |
---|---|---|
ccc418af | 1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
1b026014 | 5 | if ($^O eq 'MacOS') { |
6 | @INC = qw(: ::lib ::macos:lib); | |
7 | } else { | |
8 | @INC = '.'; | |
9 | push @INC, '../lib'; | |
db5fd395 | 10 | } |
ccc418af | 11 | } |
12 | ||
13 | $| = 1; | |
14 | use warnings; | |
15 | use strict; | |
16 | use Config; | |
17 | ||
87a42246 | 18 | print "1..2\n"; |
ccc418af | 19 | |
20 | my $test = 1; | |
21 | ||
22 | sub ok { print "ok $test\n"; $test++ } | |
23 | ||
87a42246 | 24 | use B; |
ccc418af | 25 | |
08c6f5ec | 26 | |
87a42246 | 27 | package Testing::Symtable; |
28 | use vars qw($This @That %wibble $moo %moo); | |
29 | my $not_a_sym = 'moo'; | |
ccc418af | 30 | |
87a42246 | 31 | sub moo { 42 } |
32 | sub car { 23 } | |
ccc418af | 33 | |
f70490b9 | 34 | |
87a42246 | 35 | package Testing::Symtable::Foo; |
36 | sub yarrow { "Hock" } | |
f70490b9 | 37 | |
87a42246 | 38 | package Testing::Symtable::Bar; |
39 | sub hock { "yarrow" } | |
9b86dfa2 | 40 | |
87a42246 | 41 | package main; |
42 | use vars qw(%Subs); | |
43 | local %Subs = (); | |
44 | B::walksymtable(\%Testing::Symtable::, 'find_syms', sub { $_[0] =~ /Foo/ }, | |
45 | 'Testing::Symtable::'); | |
ccc418af | 46 | |
87a42246 | 47 | sub B::GV::find_syms { |
48 | my($symbol) = @_; | |
de3f1649 | 49 | |
87a42246 | 50 | $main::Subs{$symbol->STASH->NAME . '::' . $symbol->NAME}++; |
cfe9256d | 51 | } |
ccc418af | 52 | |
87a42246 | 53 | my @syms = map { 'Testing::Symtable::'.$_ } qw(This That wibble moo car |
54 | BEGIN); | |
55 | push @syms, "Testing::Symtable::Foo::yarrow"; | |
ccc418af | 56 | |
87a42246 | 57 | # Make sure we hit all the expected symbols. |
58 | print "not " unless join('', sort @syms) eq join('', sort keys %Subs); | |
ccc418af | 59 | ok; |
1e1dbab6 | 60 | |
87a42246 | 61 | # Make sure we only hit them each once. |
62 | print "not " unless !grep $_ != 1, values %Subs; | |
1e1dbab6 | 63 | ok; |