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