1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 if ($^O eq 'MacOS') { 6 @INC = qw(: ::lib ::macos:lib); 7 } else { 8 @INC = '.'; 9 push @INC, '../lib'; 10 } 11} 12 13$| = 1; 14use warnings; 15use strict; 16use Test::More tests => 5; 17 18BEGIN { use_ok( 'B' ); } 19 20 21package Testing::Symtable; 22use vars qw($This @That %wibble $moo %moo); 23my $not_a_sym = 'moo'; 24 25sub moo { 42 } 26sub car { 23 } 27 28 29package Testing::Symtable::Foo; 30sub yarrow { "Hock" } 31 32package Testing::Symtable::Bar; 33sub hock { "yarrow" } 34 35package main; 36use vars qw(%Subs); 37local %Subs = (); 38B::walksymtable(\%Testing::Symtable::, 'find_syms', sub { $_[0] =~ /Foo/ }, 39 'Testing::Symtable::'); 40 41sub B::GV::find_syms { 42 my($symbol) = @_; 43 44 $main::Subs{$symbol->STASH->NAME . '::' . $symbol->NAME}++; 45} 46 47my @syms = map { 'Testing::Symtable::'.$_ } qw(This That wibble moo car 48 BEGIN); 49push @syms, "Testing::Symtable::Foo::yarrow"; 50 51# Make sure we hit all the expected symbols. 52ok( join('', sort @syms) eq join('', sort keys %Subs), 'all symbols found' ); 53 54# Make sure we only hit them each once. 55ok( (!grep $_ != 1, values %Subs), '...and found once' ); 56 57# Tests for MAGIC / MOREMAGIC 58ok( 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} 67