← 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:22:38 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 {
111135µs my $class = shift;
12 my ($package, %args) = @_;
13 if ($package && (my $existing = $mocked{$package})) {
14 return $existing;
15 }
16
17 croak "Cannot mock $package" if $package && $package eq $class;
18118µ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
23 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
2912µs TRACE("Creating MockModule object for $package");
# spent 2µs making 1 call to Test::MockModule::TRACE
30 my $self = bless {
31 _package => $package,
32 _mocked => {},
33 }, $class;
34 $mocked{$package} = $self;
3511µs weaken $mocked{$package};
# spent 1µs making 1 call to Scalar::Util::weaken
36 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 {
40214µs my $self = shift;
4111.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 {
501391µs my $self = shift;
51
52 while (my ($name, $value) = splice @_, 0, 2) {
53 my $code = sub { };
5411µ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
601500ns TRACE("$name: $code");
# spent 500ns making 1 call to Test::MockModule::TRACE
6115µs croak "Invalid subroutine name: $name" unless _valid_subname($name);
# spent 5µs making 1 call to Test::MockModule::_valid_subname
6215µs my $sub_name = _full_name($self, $name);
# spent 5µs making 1 call to Test::MockModule::_full_name
63 if (!$self->{_mocked}{$name}) {
641600ns TRACE("Storing existing $sub_name");
# spent 600ns making 1 call to Test::MockModule::TRACE
65 $self->{_mocked}{$name} = 1;
66147µs $self->{_orig}{$name} = defined &{$sub_name} ? \&$sub_name
# spent 47µs making 1 call to UNIVERSAL::can
67 : $self->{_package}->can($name);
68 }
691600ns TRACE("Installing mocked $sub_name");
# spent 600ns making 1 call to Test::MockModule::TRACE
70115µ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 {
831047µs my $self = shift;
84
85 for my $name (@_) {
86120µs croak "Invalid subroutine name: $name" unless _valid_subname($name);
# spent 20µs making 1 call to Test::MockModule::_valid_subname
87
88113µs my $sub_name = _full_name($self, $name);
# spent 13µs making 1 call to Test::MockModule::_full_name
89 unless ($self->{_mocked}{$name}) {
90 carp $sub_name . " was not mocked";
91 next;
92 }
93
9414µs TRACE("Restoring original $sub_name");
# spent 4µs making 1 call to Test::MockModule::TRACE
9511.22ms _replace_sub($sub_name, $self->{_orig}{$name});
# spent 1.22ms making 1 call to Test::MockModule::_replace_sub
96 delete $self->{_mocked}{$name};
97 delete $self->{_orig}{$name};
98 }
99 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 {
103324µs my $self = shift;
104 foreach (keys %{$self->{_mocked}}) {
10511.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 {
116425µs my ($self, $sub_name) = @_;
117 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 {
129211.24ms my ($sub_name, $coderef) = @_;
130 # from Test::MockObject
131 local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /redefined/ };
132 if (defined $coderef) {
133 *{$sub_name} = $coderef;
134 } else {
13512µs TRACE("removing subroutine: $sub_name");
# spent 2µs making 1 call to Test::MockModule::TRACE
136110µs my ($package, $sub) = $sub_name =~ /(.*::)(.*)/;
# spent 10µs making 1 call to Test::MockModule::CORE:match
137 my %symbols = %{$package};
138
139 # save a copy of all non-code slots
140 my %slot;
141 foreach (qw(ARRAY FORMAT HASH IO SCALAR)) {
142 next unless defined(my $elem = *{$symbols{$sub}}{$_});
143 $slot{$_} = $elem;
144 }
145
146 # clear the symbol table entry for the subroutine
147 undef *$sub_name;
148
149 # restore everything except the code slot
150 return unless keys %slot;
151 foreach (keys %slot) {
152 *$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