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; |
c5f0f3aa |
16 | use Test::More tests => 5; |
ccc418af |
17 | |
c5f0f3aa |
18 | BEGIN { use_ok( 'B' ); } |
ccc418af |
19 | |
08c6f5ec |
20 | |
87a42246 |
21 | package Testing::Symtable; |
22 | use vars qw($This @That %wibble $moo %moo); |
23 | my $not_a_sym = 'moo'; |
ccc418af |
24 | |
87a42246 |
25 | sub moo { 42 } |
26 | sub car { 23 } |
ccc418af |
27 | |
f70490b9 |
28 | |
87a42246 |
29 | package Testing::Symtable::Foo; |
30 | sub yarrow { "Hock" } |
f70490b9 |
31 | |
87a42246 |
32 | package Testing::Symtable::Bar; |
33 | sub hock { "yarrow" } |
9b86dfa2 |
34 | |
87a42246 |
35 | package main; |
36 | use vars qw(%Subs); |
37 | local %Subs = (); |
38 | B::walksymtable(\%Testing::Symtable::, 'find_syms', sub { $_[0] =~ /Foo/ }, |
39 | 'Testing::Symtable::'); |
ccc418af |
40 | |
87a42246 |
41 | sub B::GV::find_syms { |
42 | my($symbol) = @_; |
de3f1649 |
43 | |
87a42246 |
44 | $main::Subs{$symbol->STASH->NAME . '::' . $symbol->NAME}++; |
cfe9256d |
45 | } |
ccc418af |
46 | |
87a42246 |
47 | my @syms = map { 'Testing::Symtable::'.$_ } qw(This That wibble moo car |
48 | BEGIN); |
49 | push @syms, "Testing::Symtable::Foo::yarrow"; |
ccc418af |
50 | |
87a42246 |
51 | # Make sure we hit all the expected symbols. |
c5f0f3aa |
52 | ok( join('', sort @syms) eq join('', sort keys %Subs), 'all symbols found' ); |
1e1dbab6 |
53 | |
87a42246 |
54 | # Make sure we only hit them each once. |
c5f0f3aa |
55 | ok( (!grep $_ != 1, values %Subs), '...and found once' ); |
56 | |
57 | # Tests for MAGIC / MOREMAGIC |
58 | ok( B::svref_2object(\$.)->MAGIC->TYPE eq "\0", '$. has \0 magic' ); |
59 | { |
60 | my $e = ''; |
61 | local $SIG{__DIE__} = sub { $e = $_[0] }; |
62 | # Used to dump core, bug #16828 |
63 | eval { B::svref_2object(\$.)->MAGIC->MOREMAGIC->TYPE; }; |
64 | like( $e, qr/Can't call method "TYPE" on an undefined value/, |
65 | '$. has no more magic' ); |
66 | } |