← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:24:09 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Test/MockModule.pm
StatementsExecuted 88 statements in 2.47ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
2211.22ms1.23msTest::MockModule::::_replace_subTest::MockModule::_replace_sub
11162µs1.32msTest::MockModule::::unmockTest::MockModule::unmock
11151µs126µsTest::MockModule::::mockTest::MockModule::mock
11130µs51µsTest::MockModule::::newTest::MockModule::new
43128µs28µsTest::MockModule::::CORE:matchTest::MockModule::CORE:match (opcode)
11124µs1.34msTest::MockModule::::unmock_allTest::MockModule::unmock_all
22119µs19µsTest::MockModule::::_full_nameTest::MockModule::_full_name
11117µs1.36msTest::MockModule::::DESTROYTest::MockModule::DESTROY
22116µs25µsTest::MockModule::::_valid_subnameTest::MockModule::_valid_subname
11114µs30µsTest::MockModule::::BEGIN@3Test::MockModule::BEGIN@3
66110µs10µsTest::MockModule::::TRACETest::MockModule::TRACE
1119µs37µsTest::MockModule::::BEGIN@4Test::MockModule::BEGIN@4
1119µs18µsTest::MockModule::::_valid_packageTest::MockModule::_valid_package
1117µs36µsTest::MockModule::::BEGIN@5Test::MockModule::BEGIN@5
1117µs39µsTest::MockModule::::BEGIN@6Test::MockModule::BEGIN@6
0000s0sTest::MockModule::::DUMPTest::MockModule::DUMP
0000s0sTest::MockModule::::__ANON__[:131]Test::MockModule::__ANON__[:131]
0000s0sTest::MockModule::::__ANON__[:53]Test::MockModule::__ANON__[:53]
0000s0sTest::MockModule::::__ANON__[:57]Test::MockModule::__ANON__[:57]
0000s0sTest::MockModule::::get_packageTest::MockModule::get_package
0000s0sTest::MockModule::::is_mockedTest::MockModule::is_mocked
0000s0sTest::MockModule::::originalTest::MockModule::original
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# $Id: MockModule.pm,v 1.7 2005/03/24 22:23:38 simonflack Exp $
2package Test::MockModule;
3322µs245µs
# spent 30µs (14+16) within Test::MockModule::BEGIN@3 which was called: # once (14µs+16µs) by main::BEGIN@23 at line 3
use strict qw/subs vars/;
# spent 30µs making 1 call to Test::MockModule::BEGIN@3 # spent 16µs making 1 call to strict::import
4323µs264µs
# spent 37µs (9+27) within Test::MockModule::BEGIN@4 which was called: # once (9µs+27µs) by main::BEGIN@23 at line 4
use vars qw/$VERSION/;
# spent 37µs making 1 call to Test::MockModule::BEGIN@4 # spent 27µs making 1 call to vars::import
5318µs265µs
# spent 36µs (7+29) within Test::MockModule::BEGIN@5 which was called: # once (7µs+29µs) by main::BEGIN@23 at line 5
use Scalar::Util qw/reftype weaken/;
# spent 36µs making 1 call to Test::MockModule::BEGIN@5 # spent 29µs making 1 call to Exporter::import
63854µs272µs
# spent 39µs (7+32) within Test::MockModule::BEGIN@6 which was called: # once (7µs+32µs) by main::BEGIN@23 at line 6
use Carp;
# spent 39µs making 1 call to Test::MockModule::BEGIN@6 # spent 32µs making 1 call to Exporter::import
71500ns$VERSION = '0.05';#sprintf'%d.%02d', q$Revision: 1.7 $ =~ /: (\d+)\.(\d+)/;
8
91100nsmy %mocked;
10
# spent 51µs (30+21) within Test::MockModule::new which was called: # once (30µs+21µs) by main::RUNTIME at line 50 of xt/tapper-mcp-scheduler-with-db-longrun.t
sub new {
1111µs my $class = shift;
1212µs my ($package, %args) = @_;
1311µs if ($package && (my $existing = $mocked{$package})) {
14 return $existing;
15 }
16
171700ns croak "Cannot mock $package" if $package && $package eq $class;
1813µs118µs unless (_valid_package($package)) {
# spent 18µs making 1 call to Test::MockModule::_valid_package
19 $package = 'undef' unless defined $package;
20 croak "Invalid package name $package";
21 }
22
2316µs unless ($args{no_auto} || ${"$package\::VERSION"}) {
24 (my $load_package = "$package.pm") =~ s{::}{/}g;
25 TRACE("$package is empty, loading $load_package");
26 require $load_package;
27 }
28
2913µs12µs TRACE("Creating MockModule object for $package");
# spent 2µs making 1 call to Test::MockModule::TRACE
3015µs my $self = bless {
31 _package => $package,
32 _mocked => {},
33 }, $class;
3411µs $mocked{$package} = $self;
3514µs11µs weaken $mocked{$package};
# spent 1µs making 1 call to Scalar::Util::weaken
3618µs return $self;
37}
38
39
# spent 1.36ms (17µs+1.34) within Test::MockModule::DESTROY which was called: # once (17µs+1.34ms) by main::NULL at line 0 of xt/tapper-mcp-scheduler-with-db-longrun.t
sub DESTROY {
4011µs my $self = shift;
41113µs11.34ms $self->unmock_all;
# spent 1.34ms making 1 call to Test::MockModule::unmock_all
42}
43
44sub get_package {
45 my $self = shift;
46 return $self->{_package};
47}
48
49
# spent 126µs (51+75) within Test::MockModule::mock which was called: # once (51µs+75µs) by main::RUNTIME at line 51 of xt/tapper-mcp-scheduler-with-db-longrun.t
sub mock {
501500ns my $self = shift;
51
5218µs while (my ($name, $value) = splice @_, 0, 2) {
5312µs my $code = sub { };
5419µs11µs if (ref $value && reftype $value eq 'CODE') {
# spent 1µs making 1 call to Scalar::Util::reftype
55 $code = $value;
56 } elsif (defined $value) {
57 $code = sub {$value};
58 }
59
6012µs1500ns TRACE("$name: $code");
# spent 500ns making 1 call to Test::MockModule::TRACE
6112µs15µs croak "Invalid subroutine name: $name" unless _valid_subname($name);
# spent 5µs making 1 call to Test::MockModule::_valid_subname
6212µs15µs my $sub_name = _full_name($self, $name);
# spent 5µs making 1 call to Test::MockModule::_full_name
6311µs if (!$self->{_mocked}{$name}) {
6412µs1600ns TRACE("Storing existing $sub_name");
# spent 600ns making 1 call to Test::MockModule::TRACE
6511µs $self->{_mocked}{$name} = 1;
66156µs147µs $self->{_orig}{$name} = defined &{$sub_name} ? \&$sub_name
# spent 47µs making 1 call to UNIVERSAL::can
67 : $self->{_package}->can($name);
68 }
6912µs1600ns TRACE("Installing mocked $sub_name");
# spent 600ns making 1 call to Test::MockModule::TRACE
7012µs115µs _replace_sub($sub_name, $code);
# spent 15µs making 1 call to Test::MockModule::_replace_sub
71 }
72}
73
74sub original {
75 my $self = shift;
76 my ($name) = @_;
77 return carp _full_name($self, $name) . " is not mocked"
78 unless $self->{_mocked}{$name};
79 return $self->{_orig}{$name};
80}
81
82
# spent 1.32ms (62µs+1.26) within Test::MockModule::unmock which was called: # once (62µs+1.26ms) by Test::MockModule::unmock_all at line 105
sub unmock {
8311µs my $self = shift;
84
8512µs for my $name (@_) {
8615µs120µs croak "Invalid subroutine name: $name" unless _valid_subname($name);
# spent 20µs making 1 call to Test::MockModule::_valid_subname
87
8815µs113µs my $sub_name = _full_name($self, $name);
# spent 13µs making 1 call to Test::MockModule::_full_name
8912µs unless ($self->{_mocked}{$name}) {
90 carp $sub_name . " was not mocked";
91 next;
92 }
93
9417µs14µs TRACE("Restoring original $sub_name");
# spent 4µs making 1 call to Test::MockModule::TRACE
9517µs11.22ms _replace_sub($sub_name, $self->{_orig}{$name});
# spent 1.22ms making 1 call to Test::MockModule::_replace_sub
9614µs delete $self->{_mocked}{$name};
9715µs delete $self->{_orig}{$name};
98 }
9919µs return $self;
100}
101
102
# spent 1.34ms (24µs+1.32) within Test::MockModule::unmock_all which was called: # once (24µs+1.32ms) by Test::MockModule::DESTROY at line 41
sub unmock_all {
10311µs my $self = shift;
104117µs foreach (keys %{$self->{_mocked}}) {
10517µs11.32ms $self->unmock($_);
# spent 1.32ms making 1 call to Test::MockModule::unmock
106 }
107}
108
109sub is_mocked {
110 my $self = shift;
111 my ($name) = shift;
112 return $self->{_mocked}{$name};
113}
114
115
# spent 19µs within Test::MockModule::_full_name which was called 2 times, avg 9µs/call: # once (13µs+0s) by Test::MockModule::unmock at line 88 # once (5µs+0s) by Test::MockModule::mock at line 62
sub _full_name {
11623µs my ($self, $sub_name) = @_;
117222µs sprintf "%s::%s", $self->{_package}, $sub_name;
118}
119
120
# spent 18µs (9+8) within Test::MockModule::_valid_package which was called: # once (9µs+8µs) by Test::MockModule::new at line 18
sub _valid_package {
121119µs18µs defined($_[0]) && $_[0] =~ /^[a-z_]\w*(?:::\w+)*$/i;
# spent 8µs making 1 call to Test::MockModule::CORE:match
122}
123
124
# spent 25µs (16+10) within Test::MockModule::_valid_subname which was called 2 times, avg 13µs/call: # once (12µs+8µs) by Test::MockModule::unmock at line 86 # once (4µs+2µs) by Test::MockModule::mock at line 61
sub _valid_subname {
125231µs210µs $_[0] =~ /^[a-z_]\w*$/i;
# spent 10µs making 2 calls to Test::MockModule::CORE:match, avg 5µs/call
126}
127
128
# spent 1.23ms (1.22+12µs) within Test::MockModule::_replace_sub which was called 2 times, avg 617µs/call: # once (1.21ms+12µs) by Test::MockModule::unmock at line 95 # once (15µs+0s) by Test::MockModule::mock at line 70
sub _replace_sub {
12923µs my ($sub_name, $coderef) = @_;
130 # from Test::MockObject
131216µs local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /redefined/ };
132229µs if (defined $coderef) {
133 *{$sub_name} = $coderef;
134 } else {
13515µs12µs TRACE("removing subroutine: $sub_name");
# spent 2µs making 1 call to Test::MockModule::TRACE
136120µs110µs my ($package, $sub) = $sub_name =~ /(.*::)(.*)/;
# spent 10µs making 1 call to Test::MockModule::CORE:match
1371971µs my %symbols = %{$package};
138
139 # save a copy of all non-code slots
1401900ns my %slot;
14116µs foreach (qw(ARRAY FORMAT HASH IO SCALAR)) {
142513µs next unless defined(my $elem = *{$symbols{$sub}}{$_});
14315µs $slot{$_} = $elem;
144 }
145
146 # clear the symbol table entry for the subroutine
14719µs undef *$sub_name;
148
149 # restore everything except the code slot
15012µs return unless keys %slot;
1511148µs foreach (keys %slot) {
15217µs *$sub_name = $slot{$_};
153 }
154 }
155}
156
157# Log::Trace stubs
158625µs
# spent 10µs within Test::MockModule::TRACE which was called 6 times, avg 2µs/call: # once (4µs+0s) by Test::MockModule::unmock at line 94 # once (2µs+0s) by Test::MockModule::new at line 29 # once (2µs+0s) by Test::MockModule::_replace_sub at line 135 # once (600ns+0s) by Test::MockModule::mock at line 69 # once (600ns+0s) by Test::MockModule::mock at line 64 # once (500ns+0s) by Test::MockModule::mock at line 60
sub TRACE {}
159sub DUMP {}
160
16113µs1;
162
163=pod
164
165=head1 NAME
166
167Test::MockModule - Override subroutines in a module for unit testing
168
169=head1 SYNOPSIS
170
171 use Module::Name;
172 use Test::MockModule;
173
174 {
175 my $module = new Test::MockModule('Module::Name');
176 $module->mock('subroutine', sub { ... });
177 Module::Name::subroutine(@args); # mocked
178 }
179
180 Module::Name::subroutine(@args); # original subroutine
181
182=head1 DESCRIPTION
183
184C<Test::MockModule> lets you temporarily redefine subroutines in other packages
185for the purposes of unit testing.
186
187A C<Test::MockModule> object is set up to mock subroutines for a given
188module. The object remembers the original subroutine so it can be easily
189restored. This happens automatically when all MockModule objects for the given
190module go out of scope, or when you C<unmock()> the subroutine.
191
192=head1 METHODS
193
194=over 4
195
196=item new($package[, %options])
197
198Returns an object that will mock subroutines in the specified C<$package>.
199
200If there is no C<$VERSION> defined in C<$package>, the module will be
201automatically loaded. You can override this behaviour by setting the C<no_auto>
202option:
203
204 my $mock = new Test::MockModule('Module::Name', no_auto => 1);
205
206=item get_package()
207
208Returns the target package name for the mocked subroutines
209
210=item is_mocked($subroutine)
211
212Returns a boolean value indicating whether or not the subroutine is currently
213mocked
214
215=item mock($subroutine =E<gt> \E<amp>coderef)
216
217Temporarily replaces one or more subroutines in the mocked module. A subroutine
218can be mocked with a code reference or a scalar. A scalar will be recast as a
219subroutine that returns the scalar.
220
221The following statements are equivalent:
222
223 $module->mock(purge => 'purged');
224 $module->mock(purge => sub { return 'purged'});
225
226 $module->mock(updated => [localtime()]);
227 $module->mock(updated => sub { return [localtime()]});
228
229However, C<undef> is a special case. If you mock a subroutine with C<undef> it
230will install an empty subroutine
231
232 $module->mock(purge => undef);
233 $module->mock(purge => sub { });
234
235rather than a subroutine that returns C<undef>:
236
237 $module->mock(purge => sub { undef });
238
239You can call C<mock()> for the same subroutine many times, but when you call
240C<unmock()>, the original subroutine is restored (not the last mocked
241instance).
242
243=item original($subroutine)
244
245Returns the original (unmocked) subroutine
246
247=item unmock($subroutine [, ...])
248
249Restores the original C<$subroutine>. You can specify a list of subroutines to
250C<unmock()> in one go.
251
252=item unmock_all()
253
254Restores all the subroutines in the package that were mocked. This is
255automatically called when all C<Test::MockObject> objects for the given package
256go out of scope.
257
258=back
259
260=head1 SEE ALSO
261
262L<Test::MockObject::Extends>
263
264L<Sub::Override>
265
266=head1 AUTHOR
267
268Simon Flack E<lt>simonflk _AT_ cpan.orgE<gt>
269
270=head1 COPYRIGHT
271
272Copyright 2004 Simon Flack E<lt>simonflk _AT_ cpan.orgE<gt>.
273All rights reserved
274
275You may distribute under the terms of either the GNU General Public License or
276the Artistic License, as specified in the Perl README file.
277
278=cut
 
# spent 28µs within Test::MockModule::CORE:match which was called 4 times, avg 7µs/call: # 2 times (10µs+0s) by Test::MockModule::_valid_subname at line 125, avg 5µs/call # once (10µs+0s) by Test::MockModule::_replace_sub at line 136 # once (8µs+0s) by Test::MockModule::_valid_package at line 121
sub Test::MockModule::CORE:match; # opcode