This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move the B tests to B/t.
[perl5.git] / ext / B / t / 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;