Profile of Test/MockModule.pm

← 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
Statements | Executed 88 statements in 2.47ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
2 | 2 | 1 | 1.22ms | 1.23ms | Test::MockModule::::_replace_subTest::MockModule::_replace_sub
1 | 1 | 1 | 62µs | 1.32ms | Test::MockModule::::unmockTest::MockModule::unmock
1 | 1 | 1 | 51µs | 126µs | Test::MockModule::::mockTest::MockModule::mock
1 | 1 | 1 | 30µs | 51µs | Test::MockModule::::newTest::MockModule::new
4 | 3 | 1 | 28µs | 28µs | Test::MockModule::::CORE:matchTest::MockModule::CORE:match (opcode)
1 | 1 | 1 | 24µs | 1.34ms | Test::MockModule::::unmock_allTest::MockModule::unmock_all
2 | 2 | 1 | 19µs | 19µs | Test::MockModule::::_full_nameTest::MockModule::_full_name
1 | 1 | 1 | 17µs | 1.36ms | Test::MockModule::::DESTROYTest::MockModule::DESTROY
2 | 2 | 1 | 16µs | 25µs | Test::MockModule::::_valid_subnameTest::MockModule::_valid_subname
1 | 1 | 1 | 14µs | 30µs | Test::MockModule::::BEGIN@3Test::MockModule::BEGIN@3
6 | 6 | 1 | 10µs | 10µs | Test::MockModule::::TRACETest::MockModule::TRACE
1 | 1 | 1 | 9µs | 37µs | Test::MockModule::::BEGIN@4Test::MockModule::BEGIN@4
1 | 1 | 1 | 9µs | 18µs | Test::MockModule::::_valid_packageTest::MockModule::_valid_package
1 | 1 | 1 | 7µs | 36µs | Test::MockModule::::BEGIN@5Test::MockModule::BEGIN@5
1 | 1 | 1 | 7µs | 39µs | Test::MockModule::::BEGIN@6Test::MockModule::BEGIN@6
0 | 0 | 0 | 0s | 0s | Test::MockModule::::DUMPTest::MockModule::DUMP
0 | 0 | 0 | 0s | 0s | Test::MockModule::::__ANON__[:131]Test::MockModule::__ANON__[:131]
0 | 0 | 0 | 0s | 0s | Test::MockModule::::__ANON__[:53]Test::MockModule::__ANON__[:53]
0 | 0 | 0 | 0s | 0s | Test::MockModule::::__ANON__[:57]Test::MockModule::__ANON__[:57]
0 | 0 | 0 | 0s | 0s | Test::MockModule::::get_packageTest::MockModule::get_package
0 | 0 | 0 | 0s | 0s | Test::MockModule::::is_mockedTest::MockModule::is_mocked
0 | 0 | 0 | 0s | 0s | Test::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 $
2 |  |  |  |  | package Test::MockModule;
3 | 3 | 22µs | 2 | 45µ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
4 | 3 | 23µs | 2 | 64µ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
5 | 3 | 18µs | 2 | 65µ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
6 | 3 | 854µs | 2 | 72µ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
7 | 1 | 500ns |  |  | $VERSION = '0.05';#sprintf'%d.%02d', q$Revision: 1.7 $ =~ /: (\d+)\.(\d+)/;
8 |  |  |  |  |
9 | 1 | 100ns |  |  | my %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 {
11 | 1 | 1µs |  |  | my $class = shift;
12 | 1 | 2µs |  |  | my ($package, %args) = @_;
13 | 1 | 1µs |  |  | if ($package && (my $existing = $mocked{$package})) {
14 |  |  |  |  | return $existing;
15 |  |  |  |  | }
16 |  |  |  |  |
17 | 1 | 700ns |  |  | croak "Cannot mock $package" if $package && $package eq $class;
18 | 1 | 3µs | 1 | 18µ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 | 1 | 6µ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 |  |  |  |  |
29 | 1 | 3µs | 1 | 2µs | TRACE("Creating MockModule object for $package"); # spent 2µs making 1 call to Test::MockModule::TRACE
30 | 1 | 5µs |  |  | my $self = bless {
31 |  |  |  |  | _package => $package,
32 |  |  |  |  | _mocked => {},
33 |  |  |  |  | }, $class;
34 | 1 | 1µs |  |  | $mocked{$package} = $self;
35 | 1 | 4µs | 1 | 1µs | weaken $mocked{$package}; # spent 1µs making 1 call to Scalar::Util::weaken
36 | 1 | 8µ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 {
40 | 1 | 1µs |  |  | my $self = shift;
41 | 1 | 13µs | 1 | 1.34ms | $self->unmock_all; # spent 1.34ms making 1 call to Test::MockModule::unmock_all
42 |  |  |  |  | }
43 |  |  |  |  |
44 |  |  |  |  | sub 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 {
50 | 1 | 500ns |  |  | my $self = shift;
51 |  |  |  |  |
52 | 1 | 8µs |  |  | while (my ($name, $value) = splice @_, 0, 2) {
53 | 1 | 2µs |  |  | my $code = sub { };
54 | 1 | 9µs | 1 | 1µ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 |  |  |  |  |
60 | 1 | 2µs | 1 | 500ns | TRACE("$name: $code"); # spent 500ns making 1 call to Test::MockModule::TRACE
61 | 1 | 2µs | 1 | 5µs | croak "Invalid subroutine name: $name" unless _valid_subname($name); # spent 5µs making 1 call to Test::MockModule::_valid_subname
62 | 1 | 2µs | 1 | 5µs | my $sub_name = _full_name($self, $name); # spent 5µs making 1 call to Test::MockModule::_full_name
63 | 1 | 1µs |  |  | if (!$self->{_mocked}{$name}) {
64 | 1 | 2µs | 1 | 600ns | TRACE("Storing existing $sub_name"); # spent 600ns making 1 call to Test::MockModule::TRACE
65 | 1 | 1µs |  |  | $self->{_mocked}{$name} = 1;
66 | 1 | 56µs | 1 | 47µs | $self->{_orig}{$name} = defined &{$sub_name} ? \&$sub_name # spent 47µs making 1 call to UNIVERSAL::can
67 |  |  |  |  | : $self->{_package}->can($name);
68 |  |  |  |  | }
69 | 1 | 2µs | 1 | 600ns | TRACE("Installing mocked $sub_name"); # spent 600ns making 1 call to Test::MockModule::TRACE
70 | 1 | 2µs | 1 | 15µs | _replace_sub($sub_name, $code); # spent 15µs making 1 call to Test::MockModule::_replace_sub
71 |  |  |  |  | }
72 |  |  |  |  | }
73 |  |  |  |  |
74 |  |  |  |  | sub 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 {
83 | 1 | 1µs |  |  | my $self = shift;
84 |  |  |  |  |
85 | 1 | 2µs |  |  | for my $name (@_) {
86 | 1 | 5µs | 1 | 20µs | croak "Invalid subroutine name: $name" unless _valid_subname($name); # spent 20µs making 1 call to Test::MockModule::_valid_subname
87 |  |  |  |  |
88 | 1 | 5µs | 1 | 13µs | my $sub_name = _full_name($self, $name); # spent 13µs making 1 call to Test::MockModule::_full_name
89 | 1 | 2µs |  |  | unless ($self->{_mocked}{$name}) {
90 |  |  |  |  | carp $sub_name . " was not mocked";
91 |  |  |  |  | next;
92 |  |  |  |  | }
93 |  |  |  |  |
94 | 1 | 7µs | 1 | 4µs | TRACE("Restoring original $sub_name"); # spent 4µs making 1 call to Test::MockModule::TRACE
95 | 1 | 7µs | 1 | 1.22ms | _replace_sub($sub_name, $self->{_orig}{$name}); # spent 1.22ms making 1 call to Test::MockModule::_replace_sub
96 | 1 | 4µs |  |  | delete $self->{_mocked}{$name};
97 | 1 | 5µs |  |  | delete $self->{_orig}{$name};
98 |  |  |  |  | }
99 | 1 | 9µ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 {
103 | 1 | 1µs |  |  | my $self = shift;
104 | 1 | 17µs |  |  | foreach (keys %{$self->{_mocked}}) {
105 | 1 | 7µs | 1 | 1.32ms | $self->unmock($_); # spent 1.32ms making 1 call to Test::MockModule::unmock
106 |  |  |  |  | }
107 |  |  |  |  | }
108 |  |  |  |  |
109 |  |  |  |  | sub 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 {
116 | 2 | 3µs |  |  | my ($self, $sub_name) = @_;
117 | 2 | 22µ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 {
121 | 1 | 19µs | 1 | 8µ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 {
125 | 2 | 31µs | 2 | 10µ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 {
129 | 2 | 3µs |  |  | my ($sub_name, $coderef) = @_;
130 |  |  |  |  | # from Test::MockObject
131 | 2 | 16µs |  |  | local $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /redefined/ };
132 | 2 | 29µs |  |  | if (defined $coderef) {
133 |  |  |  |  | *{$sub_name} = $coderef;
134 |  |  |  |  | } else {
135 | 1 | 5µs | 1 | 2µs | TRACE("removing subroutine: $sub_name"); # spent 2µs making 1 call to Test::MockModule::TRACE
136 | 1 | 20µs | 1 | 10µs | my ($package, $sub) = $sub_name =~ /(.*::)(.*)/; # spent 10µs making 1 call to Test::MockModule::CORE:match
137 | 1 | 971µs |  |  | my %symbols = %{$package};
138 |  |  |  |  |
139 |  |  |  |  | # save a copy of all non-code slots
140 | 1 | 900ns |  |  | my %slot;
141 | 1 | 6µs |  |  | foreach (qw(ARRAY FORMAT HASH IO SCALAR)) {
142 | 5 | 13µs |  |  | next unless defined(my $elem = *{$symbols{$sub}}{$_});
143 | 1 | 5µs |  |  | $slot{$_} = $elem;
144 |  |  |  |  | }
145 |  |  |  |  |
146 |  |  |  |  | # clear the symbol table entry for the subroutine
147 | 1 | 9µs |  |  | undef *$sub_name;
148 |  |  |  |  |
149 |  |  |  |  | # restore everything except the code slot
150 | 1 | 2µs |  |  | return unless keys %slot;
151 | 1 | 148µs |  |  | foreach (keys %slot) {
152 | 1 | 7µs |  |  | *$sub_name = $slot{$_};
153 |  |  |  |  | }
154 |  |  |  |  | }
155 |  |  |  |  | }
156 |  |  |  |  |
157 |  |  |  |  | # Log::Trace stubs
158 | 6 | 25µ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 {}
159 |  |  |  |  | sub DUMP {}
160 |  |  |  |  |
161 | 1 | 3µs |  |  | 1;
162 |  |  |  |  |
163 |  |  |  |  | =pod
164 |  |  |  |  |
165 |  |  |  |  | =head1 NAME
166 |  |  |  |  |
167 |  |  |  |  | Test::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 |  |  |  |  |
184 |  |  |  |  | C<Test::MockModule> lets you temporarily redefine subroutines in other packages
185 |  |  |  |  | for the purposes of unit testing.
186 |  |  |  |  |
187 |  |  |  |  | A C<Test::MockModule> object is set up to mock subroutines for a given
188 |  |  |  |  | module. The object remembers the original subroutine so it can be easily
189 |  |  |  |  | restored. This happens automatically when all MockModule objects for the given
190 |  |  |  |  | module 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 |  |  |  |  |
198 |  |  |  |  | Returns an object that will mock subroutines in the specified C<$package>.
199 |  |  |  |  |
200 |  |  |  |  | If there is no C<$VERSION> defined in C<$package>, the module will be
201 |  |  |  |  | automatically loaded. You can override this behaviour by setting the C<no_auto>
202 |  |  |  |  | option:
203 |  |  |  |  |
204 |  |  |  |  | my $mock = new Test::MockModule('Module::Name', no_auto => 1);
205 |  |  |  |  |
206 |  |  |  |  | =item get_package()
207 |  |  |  |  |
208 |  |  |  |  | Returns the target package name for the mocked subroutines
209 |  |  |  |  |
210 |  |  |  |  | =item is_mocked($subroutine)
211 |  |  |  |  |
212 |  |  |  |  | Returns a boolean value indicating whether or not the subroutine is currently
213 |  |  |  |  | mocked
214 |  |  |  |  |
215 |  |  |  |  | =item mock($subroutine =E<gt> \E<amp>coderef)
216 |  |  |  |  |
217 |  |  |  |  | Temporarily replaces one or more subroutines in the mocked module. A subroutine
218 |  |  |  |  | can be mocked with a code reference or a scalar. A scalar will be recast as a
219 |  |  |  |  | subroutine that returns the scalar.
220 |  |  |  |  |
221 |  |  |  |  | The 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 |  |  |  |  |
229 |  |  |  |  | However, C<undef> is a special case. If you mock a subroutine with C<undef> it
230 |  |  |  |  | will install an empty subroutine
231 |  |  |  |  |
232 |  |  |  |  | $module->mock(purge => undef);
233 |  |  |  |  | $module->mock(purge => sub { });
234 |  |  |  |  |
235 |  |  |  |  | rather than a subroutine that returns C<undef>:
236 |  |  |  |  |
237 |  |  |  |  | $module->mock(purge => sub { undef });
238 |  |  |  |  |
239 |  |  |  |  | You can call C<mock()> for the same subroutine many times, but when you call
240 |  |  |  |  | C<unmock()>, the original subroutine is restored (not the last mocked
241 |  |  |  |  | instance).
242 |  |  |  |  |
243 |  |  |  |  | =item original($subroutine)
244 |  |  |  |  |
245 |  |  |  |  | Returns the original (unmocked) subroutine
246 |  |  |  |  |
247 |  |  |  |  | =item unmock($subroutine [, ...])
248 |  |  |  |  |
249 |  |  |  |  | Restores the original C<$subroutine>. You can specify a list of subroutines to
250 |  |  |  |  | C<unmock()> in one go.
251 |  |  |  |  |
252 |  |  |  |  | =item unmock_all()
253 |  |  |  |  |
254 |  |  |  |  | Restores all the subroutines in the package that were mocked. This is
255 |  |  |  |  | automatically called when all C<Test::MockObject> objects for the given package
256 |  |  |  |  | go out of scope.
257 |  |  |  |  |
258 |  |  |  |  | =back
259 |  |  |  |  |
260 |  |  |  |  | =head1 SEE ALSO
261 |  |  |  |  |
262 |  |  |  |  | L<Test::MockObject::Extends>
263 |  |  |  |  |
264 |  |  |  |  | L<Sub::Override>
265 |  |  |  |  |
266 |  |  |  |  | =head1 AUTHOR
267 |  |  |  |  |
268 |  |  |  |  | Simon Flack E<lt>simonflk _AT_ cpan.orgE<gt>
269 |  |  |  |  |
270 |  |  |  |  | =head1 COPYRIGHT
271 |  |  |  |  |
272 |  |  |  |  | Copyright 2004 Simon Flack E<lt>simonflk _AT_ cpan.orgE<gt>.
273 |  |  |  |  | All rights reserved
274 |  |  |  |  |
275 |  |  |  |  | You may distribute under the terms of either the GNU General Public License or
276 |  |  |  |  | the 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