← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/Tie/Array.pm
StatementsExecuted 11 statements in 1.11ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11126µs26µsTie::Array::::BEGIN@3 Tie::Array::BEGIN@3
11112µs62µsTie::Array::::BEGIN@5 Tie::Array::BEGIN@5
11112µs49µsTie::StdArray::::BEGIN@86Tie::StdArray::BEGIN@86
11110µs30µsTie::Array::::BEGIN@4 Tie::Array::BEGIN@4
0000s0sTie::Array::::CLEAR Tie::Array::CLEAR
0000s0sTie::Array::::DELETE Tie::Array::DELETE
0000s0sTie::Array::::DESTROY Tie::Array::DESTROY
0000s0sTie::Array::::EXISTS Tie::Array::EXISTS
0000s0sTie::Array::::EXTEND Tie::Array::EXTEND
0000s0sTie::Array::::POP Tie::Array::POP
0000s0sTie::Array::::PUSH Tie::Array::PUSH
0000s0sTie::Array::::SHIFT Tie::Array::SHIFT
0000s0sTie::Array::::SPLICE Tie::Array::SPLICE
0000s0sTie::Array::::UNSHIFT Tie::Array::UNSHIFT
0000s0sTie::StdArray::::CLEARTie::StdArray::CLEAR
0000s0sTie::StdArray::::DELETETie::StdArray::DELETE
0000s0sTie::StdArray::::EXISTSTie::StdArray::EXISTS
0000s0sTie::StdArray::::FETCHTie::StdArray::FETCH
0000s0sTie::StdArray::::FETCHSIZETie::StdArray::FETCHSIZE
0000s0sTie::StdArray::::POPTie::StdArray::POP
0000s0sTie::StdArray::::PUSHTie::StdArray::PUSH
0000s0sTie::StdArray::::SHIFTTie::StdArray::SHIFT
0000s0sTie::StdArray::::SPLICETie::StdArray::SPLICE
0000s0sTie::StdArray::::STORETie::StdArray::STORE
0000s0sTie::StdArray::::STORESIZETie::StdArray::STORESIZE
0000s0sTie::StdArray::::TIEARRAYTie::StdArray::TIEARRAY
0000s0sTie::StdArray::::UNSHIFTTie::StdArray::UNSHIFT
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Tie::Array;
2
3262µs126µs
# spent 26µs within Tie::Array::BEGIN@3 which was called: # once (26µs+0s) by Env::Array::BEGIN@123 at line 3
use 5.006_001;
# spent 26µs making 1 call to Tie::Array::BEGIN@3
4230µs250µs
# spent 30µs (10+20) within Tie::Array::BEGIN@4 which was called: # once (10µs+20µs) by Env::Array::BEGIN@123 at line 4
use strict;
# spent 30µs making 1 call to Tie::Array::BEGIN@4 # spent 20µs making 1 call to strict::import
52608µs2112µs
# spent 62µs (12+50) within Tie::Array::BEGIN@5 which was called: # once (12µs+50µs) by Env::Array::BEGIN@123 at line 5
use Carp;
# spent 62µs making 1 call to Tie::Array::BEGIN@5 # spent 50µs making 1 call to Exporter::import
611µsour $VERSION = '1.05';
7
8# Pod documentation after __END__ below.
9
10sub DESTROY { }
11sub EXTEND { }
12sub UNSHIFT { scalar shift->SPLICE(0,0,@_) }
13sub SHIFT { shift->SPLICE(0,1) }
14sub CLEAR { shift->STORESIZE(0) }
15
16sub PUSH
17{
18 my $obj = shift;
19 my $i = $obj->FETCHSIZE;
20 $obj->STORE($i++, shift) while (@_);
21}
22
23sub POP
24{
25 my $obj = shift;
26 my $newsize = $obj->FETCHSIZE - 1;
27 my $val;
28 if ($newsize >= 0)
29 {
30 $val = $obj->FETCH($newsize);
31 $obj->STORESIZE($newsize);
32 }
33 $val;
34}
35
36sub SPLICE {
37 my $obj = shift;
38 my $sz = $obj->FETCHSIZE;
39 my $off = (@_) ? shift : 0;
40 $off += $sz if ($off < 0);
41 my $len = (@_) ? shift : $sz - $off;
42 $len += $sz - $off if $len < 0;
43 my @result;
44 for (my $i = 0; $i < $len; $i++) {
45 push(@result,$obj->FETCH($off+$i));
46 }
47 $off = $sz if $off > $sz;
48 $len -= $off + $len - $sz if $off + $len > $sz;
49 if (@_ > $len) {
50 # Move items up to make room
51 my $d = @_ - $len;
52 my $e = $off+$len;
53 $obj->EXTEND($sz+$d);
54 for (my $i=$sz-1; $i >= $e; $i--) {
55 my $val = $obj->FETCH($i);
56 $obj->STORE($i+$d,$val);
57 }
58 }
59 elsif (@_ < $len) {
60 # Move items down to close the gap
61 my $d = $len - @_;
62 my $e = $off+$len;
63 for (my $i=$off+$len; $i < $sz; $i++) {
64 my $val = $obj->FETCH($i);
65 $obj->STORE($i-$d,$val);
66 }
67 $obj->STORESIZE($sz-$d);
68 }
69 for (my $i=0; $i < @_; $i++) {
70 $obj->STORE($off+$i,$_[$i]);
71 }
72 return wantarray ? @result : pop @result;
73}
74
75sub EXISTS {
76 my $pkg = ref $_[0];
77 croak "$pkg doesn't define an EXISTS method";
78}
79
80sub DELETE {
81 my $pkg = ref $_[0];
82 croak "$pkg doesn't define a DELETE method";
83}
84
85package Tie::StdArray;
862397µs285µs
# spent 49µs (12+37) within Tie::StdArray::BEGIN@86 which was called: # once (12µs+37µs) by Env::Array::BEGIN@123 at line 86
use vars qw(@ISA);
# spent 49µs making 1 call to Tie::StdArray::BEGIN@86 # spent 37µs making 1 call to vars::import
8719µs@ISA = 'Tie::Array';
88
89sub TIEARRAY { bless [], $_[0] }
90sub FETCHSIZE { scalar @{$_[0]} }
91sub STORESIZE { $#{$_[0]} = $_[1]-1 }
92sub STORE { $_[0]->[$_[1]] = $_[2] }
93sub FETCH { $_[0]->[$_[1]] }
94sub CLEAR { @{$_[0]} = () }
95sub POP { pop(@{$_[0]}) }
96sub PUSH { my $o = shift; push(@$o,@_) }
97sub SHIFT { shift(@{$_[0]}) }
98sub UNSHIFT { my $o = shift; unshift(@$o,@_) }
99sub EXISTS { exists $_[0]->[$_[1]] }
100sub DELETE { delete $_[0]->[$_[1]] }
101
102sub SPLICE
103{
104 my $ob = shift;
105 my $sz = $ob->FETCHSIZE;
106 my $off = @_ ? shift : 0;
107 $off += $sz if $off < 0;
108 my $len = @_ ? shift : $sz-$off;
109 return splice(@$ob,$off,$len,@_);
110}
111
11215µs1;
113
114__END__