1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate if ($^O eq 'MacOS') { 6*0Sstevel@tonic-gate @INC = qw(: ::lib ::macos:lib); 7*0Sstevel@tonic-gate } else { 8*0Sstevel@tonic-gate @INC = '.'; 9*0Sstevel@tonic-gate push @INC, '../lib'; 10*0Sstevel@tonic-gate } 11*0Sstevel@tonic-gate} 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gate$| = 1; 14*0Sstevel@tonic-gateuse warnings; 15*0Sstevel@tonic-gateuse strict; 16*0Sstevel@tonic-gateuse Test::More tests => 5; 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gateBEGIN { use_ok( 'B' ); } 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gatepackage Testing::Symtable; 22*0Sstevel@tonic-gateuse vars qw($This @That %wibble $moo %moo); 23*0Sstevel@tonic-gatemy $not_a_sym = 'moo'; 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gatesub moo { 42 } 26*0Sstevel@tonic-gatesub car { 23 } 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gatepackage Testing::Symtable::Foo; 30*0Sstevel@tonic-gatesub yarrow { "Hock" } 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gatepackage Testing::Symtable::Bar; 33*0Sstevel@tonic-gatesub hock { "yarrow" } 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gatepackage main; 36*0Sstevel@tonic-gateuse vars qw(%Subs); 37*0Sstevel@tonic-gatelocal %Subs = (); 38*0Sstevel@tonic-gateB::walksymtable(\%Testing::Symtable::, 'find_syms', sub { $_[0] =~ /Foo/ }, 39*0Sstevel@tonic-gate 'Testing::Symtable::'); 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gatesub B::GV::find_syms { 42*0Sstevel@tonic-gate my($symbol) = @_; 43*0Sstevel@tonic-gate 44*0Sstevel@tonic-gate $main::Subs{$symbol->STASH->NAME . '::' . $symbol->NAME}++; 45*0Sstevel@tonic-gate} 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gatemy @syms = map { 'Testing::Symtable::'.$_ } qw(This That wibble moo car 48*0Sstevel@tonic-gate BEGIN); 49*0Sstevel@tonic-gatepush @syms, "Testing::Symtable::Foo::yarrow"; 50*0Sstevel@tonic-gate 51*0Sstevel@tonic-gate# Make sure we hit all the expected symbols. 52*0Sstevel@tonic-gateok( join('', sort @syms) eq join('', sort keys %Subs), 'all symbols found' ); 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gate# Make sure we only hit them each once. 55*0Sstevel@tonic-gateok( (!grep $_ != 1, values %Subs), '...and found once' ); 56*0Sstevel@tonic-gate 57*0Sstevel@tonic-gate# Tests for MAGIC / MOREMAGIC 58*0Sstevel@tonic-gateok( B::svref_2object(\$.)->MAGIC->TYPE eq "\0", '$. has \0 magic' ); 59*0Sstevel@tonic-gate{ 60*0Sstevel@tonic-gate my $e = ''; 61*0Sstevel@tonic-gate local $SIG{__DIE__} = sub { $e = $_[0] }; 62*0Sstevel@tonic-gate # Used to dump core, bug #16828 63*0Sstevel@tonic-gate eval { B::svref_2object(\$.)->MAGIC->MOREMAGIC->TYPE; }; 64*0Sstevel@tonic-gate like( $e, qr/Can't call method "TYPE" on an undefined value/, 65*0Sstevel@tonic-gate '$. has no more magic' ); 66*0Sstevel@tonic-gate} 67