t/lib/b.t

   1 #!./perl
   2
   3 BEGIN {
   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;
  14 use warnings;
  15 use strict;
  16 use Config;
  17
  18 print "1..2\n";
  19
  20 my $test = 1;
  21
  22 sub ok { print "ok $test\n"; $test++ }
  23
  24 use B;
  25
  26
  27 package Testing::Symtable;
  28 use vars qw($This @That %wibble $moo %moo);
  29 my $not_a_sym = 'moo';
  30
  31 sub moo { 42 }
  32 sub car { 23 }
  33
  34
  35 package Testing::Symtable::Foo;
  36 sub yarrow { "Hock" }
  37
  38 package Testing::Symtable::Bar;
  39 sub hock { "yarrow" }
  40
  41 package main;
  42 use vars qw(%Subs);
  43 local %Subs = ();
  44 B::walksymtable(\%Testing::Symtable::, 'find_syms', sub { $_[0] =~ /Foo/ },
  45                 'Testing::Symtable::');
  46
  47 sub B::GV::find_syms {
  48     my($symbol) = @_;
  49
  50     $main::Subs{$symbol->STASH->NAME . '::' . $symbol->NAME}++;
  51 }
  52
  53 my @syms = map { 'Testing::Symtable::'.$_ } qw(This That wibble moo car
  54                                                BEGIN);
  55 push @syms, "Testing::Symtable::Foo::yarrow";
  56
  57 # Make sure we hit all the expected symbols.
  58 print "not " unless join('', sort @syms) eq join('', sort keys %Subs);
  59 ok;
  60
  61 # Make sure we only hit them each once.
  62 print "not " unless !grep $_ != 1, values %Subs;
  63 ok;