← Back to branch summary

~ubuntu-branches/ubuntu/precise/libexporter-easy-perl/precise

« back to all changes in this revision

Viewing changes to bench

  • Committer: Bazaar Package Importer
  • Author(s): Ben Webb
  • Date: 2011-08-08 19:49:36 UTC
  • Revision ID: james.westby@ubuntu.com-20110808194936-a1pir5c7wrd29hl4
Tags: upstream-0.16
Import upstream version 0.16

Show diffs side-by-side

added added

removed removed

Lines of Context:
bench
 
1
#! /usr/bin/perl
 
2
 
 
3
use strict;
 
4
 
 
5
use lib 'lib';
 
6
 
 
7
use Benchmark qw(cmpthese);
 
8
 
 
9
require Exporter::Easy;
 
10
 
 
11
use vars;
 
12
 
 
13
my $file_bms = {
 
14
        new => '',
 
15
        old => '',
 
16
};
 
17
 
 
18
my $simple_bms = {
 
19
        old_simple => <<'EOM',
 
20
our(@EXPORT) = qw(getservbyname getservbyport getservent getserv);
 
21
our @ISA = ('Exporter');
 
22
EOM
 
23
        new_simple => <<'EOM',
 
24
use Exporter::Easy(
 
25
        EXPORT => [qw(getservbyname getservbyport getservent getserv)],
 
26
);
 
27
EOM
 
28
};
 
29
 
 
30
my $vars_bms = {
 
31
                old_our_vars => <<'EOM',
 
32
our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA);
 
33
@ISA = ('Exporter');
 
34
@EXPORT      = qw(getservbyname getservbyport getservent getserv);
 
35
@EXPORT_OK   = qw( $s_name @s_aliases $s_port $s_proto );
 
36
%EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] );
 
37
our ($s_name, @s_aliases, $s_port, $sx_proto);
 
38
EOM
 
39
        old_use_vars => <<'EOM',
 
40
our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA);
 
41
@ISA = ('Exporter');
 
42
@EXPORT      = qw(getservbyname getservbyport getservent getserv);
 
43
@EXPORT_OK   = qw( $s_name @s_aliases $s_port $s_proto );
 
44
%EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] );
 
45
use vars @EXPORT_OK;
 
46
EOM
 
47
 
 
48
        old_grep_vars => <<'EOM',
 
49
our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA);
 
50
@ISA = ('Exporter');
 
51
@EXPORT      = qw(getservbyname getservbyport getservent getserv);
 
52
@EXPORT_OK   = qw( $s_name @s_aliases $s_port $s_proto );
 
53
%EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] );
 
54
use vars grep /^\$/, @EXPORT_OK;
 
55
EOM
 
56
        new_vars => <<'EOM',
 
57
use Exporter::Easy(
 
58
        EXPORT => [qw(getservbyname getservbyport getservent getserv)],
 
59
        OK => [qw( $s_name @s_aliases $s_port $s_proto )],
 
60
        ALL => 'FIELDS',
 
61
);
 
62
EOM
 
63
};
 
64
 
 
65
my $no_vars_bms = {
 
66
        old_no_vars => <<'EOM',
 
67
our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA);
 
68
@ISA = ('Exporter');
 
69
@EXPORT      = qw(getservbyname getservbyport getservent getserv);
 
70
@EXPORT_OK   = qw( $s_name @s_aliases $s_port $s_proto );
 
71
%EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] );
 
72
EOM
 
73
 
 
74
        new_no_vars => <<'EOM',
 
75
use Exporter::Easy(
 
76
        EXPORT => [qw(getservbyname getservbyport getservent getserv)],
 
77
        OK => [qw( $s_name @s_aliases $s_port $s_proto )],
 
78
        ALL => 'FIELDS',
 
79
        VARS => 0,
 
80
);
 
81
EOM
 
82
};
 
83
 
 
84
 
 
85
my @bms = (
 
86
        $file_bms,
 
87
        $vars_bms,
 
88
        $no_vars_bms,
 
89
        $simple_bms,
 
90
);
 
91
 
 
92
my @comps;
 
93
 
 
94
foreach my $bm (@bms)
 
95
{
 
96
        foreach my $want_files (
 
97
                '',
 
98
#               '_file'
 
99
        )
 
100
        {
 
101
                my %comp;
 
102
                while (my ($name, $code) = (each %$bm))
 
103
                {
 
104
                        $comp{"$name$want_files"} = make_bm("$name$want_files", $code, $want_files);
 
105
                }
 
106
 
 
107
                push(@comps, \%comp);
 
108
        }
 
109
}
 
110
 
 
111
my $time = -2;
 
112
 
 
113
foreach my $bm (@comps)
 
114
{
 
115
        cmpthese($time, $bm);
 
116
}
 
117
 
 
118
sub make_bm
 
119
{
 
120
        my ($name, $code, $want_files) = @_;
 
121
 
 
122
        my @files;
 
123
 
 
124
        if ($want_files)
 
125
        {
 
126
                @files = ('lib/Exporter.pm');
 
127
                if ($name =~ /^new/)
 
128
                {
 
129
                        push(@files, 'lib/Exporter/Easy.pm');
 
130
                }
 
131
                else
 
132
                {
 
133
                }
 
134
        }
 
135
 
 
136
        my @file_code = map { "do '$_';" } @files;
 
137
 
 
138
        my $all_code = join("\n", @file_code, $code);
 
139
 
 
140
        eval $all_code;
 
141
        die "$all_code\n$@" if $@;
 
142
 
 
143
        # print "------------------$name----------------\n$all_code\n\n";
 
144
 
 
145
        return sub {
 
146
                eval $all_code
 
147
        };
 
148
 
 
149
}
 
150