Filename | /opt/perl-5.18.1/lib/site_perl/5.18.1/Typed.pm |
Statements | Executed 15000075 statements in 17.2s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
2000000 | 2 | 1 | 23.1s | 38.4s | __ANON__[:134] | Typed::
1 | 1 | 1 | 7.65ms | 68.4ms | BEGIN@10 | Typed::
1 | 1 | 1 | 3.48ms | 4.20ms | BEGIN@11 | Typed::
1 | 1 | 1 | 1.23ms | 1.29ms | BEGIN@5 | Typed::
1 | 1 | 1 | 358µs | 490µs | BEGIN@14 | Typed::
1 | 1 | 1 | 27µs | 40µs | new | Typed::
1 | 1 | 1 | 21µs | 39µs | has | Typed::
1 | 1 | 1 | 21µs | 845µs | import | Typed::
1 | 1 | 1 | 18µs | 18µs | process_has | Typed::
1 | 1 | 1 | 16µs | 32µs | BEGIN@3 | Typed::
1 | 1 | 1 | 11µs | 75µs | BEGIN@12 | Typed::
1 | 1 | 1 | 10µs | 24µs | BEGIN@148 | Typed::
1 | 1 | 1 | 10µs | 10µs | default | Typed::
1 | 1 | 1 | 10µs | 51µs | BEGIN@8 | Typed::
1 | 1 | 1 | 10µs | 23µs | BEGIN@33 | Typed::
1 | 1 | 1 | 10µs | 23µs | BEGIN@78 | Typed::
1 | 1 | 1 | 8µs | 30µs | BEGIN@4 | Typed::
1 | 1 | 1 | 5µs | 5µs | BEGIN@7 | Typed::
0 | 0 | 0 | 0s | 0s | as | Typed::
0 | 0 | 0 | 0s | 0s | from | Typed::
0 | 0 | 0 | 0s | 0s | subtype | Typed::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Typed; | ||||
2 | |||||
3 | 2 | 35µs | 2 | 49µs | # spent 32µs (16+16) within Typed::BEGIN@3 which was called:
# once (16µs+16µs) by Foo::Typed::BEGIN@103 at line 3 # spent 32µs making 1 call to Typed::BEGIN@3
# spent 16µs making 1 call to strict::import |
4 | 2 | 33µs | 2 | 50µs | # spent 30µs (8+21) within Typed::BEGIN@4 which was called:
# once (8µs+21µs) by Foo::Typed::BEGIN@103 at line 4 # spent 30µs making 1 call to Typed::BEGIN@4
# spent 21µs making 1 call to warnings::import |
5 | 2 | 1.22ms | 2 | 1.34ms | # spent 1.29ms (1.23+56µs) within Typed::BEGIN@5 which was called:
# once (1.23ms+56µs) by Foo::Typed::BEGIN@103 at line 5 # spent 1.29ms making 1 call to Typed::BEGIN@5
# spent 56µs making 1 call to feature::import |
6 | |||||
7 | 2 | 39µs | 1 | 5µs | # spent 5µs within Typed::BEGIN@7 which was called:
# once (5µs+0s) by Foo::Typed::BEGIN@103 at line 7 # spent 5µs making 1 call to Typed::BEGIN@7 |
8 | 2 | 45µs | 2 | 92µs | # spent 51µs (10+41) within Typed::BEGIN@8 which was called:
# once (10µs+41µs) by Foo::Typed::BEGIN@103 at line 8 # spent 51µs making 1 call to Typed::BEGIN@8
# spent 41µs making 1 call to Exporter::import |
9 | |||||
10 | 2 | 171µs | 2 | 71.3ms | # spent 68.4ms (7.65+60.7) within Typed::BEGIN@10 which was called:
# once (7.65ms+60.7ms) by Foo::Typed::BEGIN@103 at line 10 # spent 68.4ms making 1 call to Typed::BEGIN@10
# spent 2.89ms making 1 call to Exporter::Tiny::import |
11 | 2 | 138µs | 1 | 4.20ms | # spent 4.20ms (3.48+718µs) within Typed::BEGIN@11 which was called:
# once (3.48ms+718µs) by Foo::Typed::BEGIN@103 at line 11 # spent 4.20ms making 1 call to Typed::BEGIN@11 |
12 | 2 | 39µs | 2 | 140µs | # spent 75µs (11+64) within Typed::BEGIN@12 which was called:
# once (11µs+64µs) by Foo::Typed::BEGIN@103 at line 12 # spent 75µs making 1 call to Typed::BEGIN@12
# spent 64µs making 1 call to Exporter::Tiny::import |
13 | |||||
14 | 2 | 287µs | 2 | 528µs | # spent 490µs (358+131) within Typed::BEGIN@14 which was called:
# once (358µs+131µs) by Foo::Typed::BEGIN@103 at line 14 # spent 490µs making 1 call to Typed::BEGIN@14
# spent 39µs making 1 call to parent::import |
15 | |||||
16 | 1 | 2µs | our @EXPORT = qw(has new as from subtype); | ||
17 | 1 | 1µs | our @TINY_UTILS = qw(message where inline_as declare coerce); | ||
18 | |||||
19 | 1 | 300ns | our $VERSION = '0.09'; | ||
20 | |||||
21 | # spent 845µs (21+824) within Typed::import which was called:
# once (21µs+824µs) by Foo::Typed::BEGIN@103 at line 103 of fastest.pl | ||||
22 | 1 | 8µs | 1 | 361µs | shift->SUPER::import({ into => scalar(caller(0)) }, @EXPORT ); # spent 361µs making 1 call to Exporter::Tiny::import |
23 | 1 | 8µs | 1 | 463µs | Type::Utils->import({ into => scalar(caller(0)) }, @TINY_UTILS ); # spent 463µs making 1 call to Exporter::Tiny::import |
24 | } | ||||
25 | |||||
26 | # spent 40µs (27+13) within Typed::new which was called:
# once (27µs+13µs) by main::RUNTIME at line 106 of fastest.pl | ||||
27 | 1 | 600ns | my $self = shift; | ||
28 | |||||
29 | 1 | 700ns | my $class = ref($self) || $self; | ||
30 | 1 | 1µs | my $blessed = bless({}, $class); | ||
31 | |||||
32 | 1 | 400ns | my $meta_pkg = __PACKAGE__; | ||
33 | 4 | 384µs | 2 | 37µs | # spent 23µs (10+14) within Typed::BEGIN@33 which was called:
# once (10µs+14µs) by Foo::Typed::BEGIN@103 at line 33 # spent 23µs making 1 call to Typed::BEGIN@33
# spent 14µs making 1 call to strict::unimport |
34 | |||||
35 | 1 | 1µs | if ($meta && $$meta{$class}) { | ||
36 | 1 | 600ns | my $has = $$meta{$class}; | ||
37 | 1 | 2µs | foreach my $name (keys %{ $has }) { | ||
38 | 1 | 500ns | my $opts = $$meta{$class}{$name}; | ||
39 | |||||
40 | 1 | 5µs | 1 | 10µs | __PACKAGE__->default($blessed, $class, $name, $opts, $$opts{lazy}); # spent 10µs making 1 call to Typed::default |
41 | } | ||||
42 | } | ||||
43 | |||||
44 | 1 | 700ns | my %user_vals = @_; | ||
45 | 1 | 1µs | foreach my $k (keys %user_vals) { | ||
46 | $blessed->{$k} = $user_vals{$k}; # TODO: Use the attribute method. | ||||
47 | } | ||||
48 | |||||
49 | 1 | 7µs | 1 | 3µs | my $build = $blessed->can("BUILD"); # spent 3µs making 1 call to UNIVERSAL::can |
50 | 1 | 200ns | if ($build) { | ||
51 | $build->($blessed); | ||||
52 | } | ||||
53 | |||||
54 | 1 | 4µs | return($blessed); | ||
55 | } | ||||
56 | |||||
57 | # spent 10µs within Typed::default which was called:
# once (10µs+0s) by Typed::new at line 40 | ||||
58 | 1 | 300ns | my $meta_pkg = shift; | ||
59 | 1 | 300ns | my $self = shift; | ||
60 | 1 | 400ns | my $package = shift; | ||
61 | 1 | 200ns | my $name = shift; | ||
62 | 1 | 200ns | my $opts = shift; | ||
63 | 1 | 700ns | my $lazy = shift; | ||
64 | |||||
65 | 1 | 200ns | my $default; | ||
66 | 1 | 500ns | unless ($lazy) { | ||
67 | 1 | 400ns | if ($$opts{default}) { | ||
68 | my $type = ref($$opts{default}); | ||||
69 | if ($type && "CODE" eq $type) { | ||||
70 | $default = $$opts{default}->(); | ||||
71 | } | ||||
72 | else { | ||||
73 | $default = $$opts{default}; | ||||
74 | } | ||||
75 | } | ||||
76 | |||||
77 | 1 | 500ns | if ($$opts{builder}) { | ||
78 | 2 | 581µs | 2 | 37µs | # spent 23µs (10+14) within Typed::BEGIN@78 which was called:
# once (10µs+14µs) by Foo::Typed::BEGIN@103 at line 78 # spent 23µs making 1 call to Typed::BEGIN@78
# spent 14µs making 1 call to strict::unimport |
79 | |||||
80 | if ($builder) { | ||||
81 | $default = $builder->($self); | ||||
82 | } | ||||
83 | } | ||||
84 | |||||
85 | 1 | 3µs | $self->{$name} = $default; # TODO: Use the attribute method. | ||
86 | } | ||||
87 | |||||
88 | 1 | 4µs | return($default); | ||
89 | } | ||||
90 | |||||
91 | # Yes, we use a global cache for metadata | ||||
92 | 1 | 400ns | our %meta = ( | ||
93 | ); | ||||
94 | |||||
95 | # spent 18µs within Typed::process_has which was called:
# once (18µs+0s) by Typed::has at line 146 | ||||
96 | 1 | 400ns | my $self = shift; | ||
97 | 1 | 400ns | my $name = shift; | ||
98 | 1 | 300ns | my $package = shift; | ||
99 | |||||
100 | 1 | 1µs | my $isa = $meta{$package}{$name}{isa}; | ||
101 | |||||
102 | 1 | 900ns | my $is = $meta{$package}{$name}{is}; | ||
103 | 1 | 900ns | my $writable = $is && "rw" eq $is; | ||
104 | 1 | 800ns | my $opts = $meta{$package}{$name}; | ||
105 | |||||
106 | # spent 38.4s (23.1+15.3) within Typed::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Typed.pm:134] which was called 2000000 times, avg 19µs/call:
# 1000000 times (21.3s+15.3s) by main::typed at line 108 of fastest.pl, avg 37µs/call
# 1000000 times (1.74s+0s) by main::typed at line 109 of fastest.pl, avg 2µs/call | ||||
107 | 2000000 | 482ms | if (!exists $_[0]->{$name}) { | ||
108 | __PACKAGE__->default($_[0], $package, $name, $opts, 0); | ||||
109 | } | ||||
110 | |||||
111 | # Do we set the value | ||||
112 | 2000000 | 565ms | if (1 == $#_) { | ||
113 | 1000000 | 214ms | if ($writable) { | ||
114 | 1000000 | 105ms | return($_[0]->{$name} = undef) if !defined $_[1]; | ||
115 | |||||
116 | 1000000 | 209ms | if ($isa) { | ||
117 | 1000000 | 3.72s | 1000000 | 761ms | my $package = blessed($_[0]); # spent 761ms making 1000000 calls to Scalar::Util::blessed, avg 761ns/call |
118 | 1000000 | 2.37s | 2000000 | 9.37s | my $type = Types::Standard->get_type($isa) || $meta{subtype}{$package}{$isa}; # spent 8.39s making 1000000 calls to Type::Library::get_type, avg 8µs/call
# spent 985ms making 1000000 calls to Type::Tiny::__ANON__[Type/Tiny.pm:32], avg 985ns/call |
119 | |||||
120 | 1000000 | 1.27s | 1000000 | 706ms | if ($type) { # spent 706ms making 1000000 calls to Type::Tiny::__ANON__[Type/Tiny.pm:32], avg 706ns/call |
121 | 1000000 | 1.13s | 1000000 | 4.50s | my $msg = $type->validate($_[1]); # spent 4.50s making 1000000 calls to Type::Tiny::validate, avg 4µs/call |
122 | 1000000 | 208ms | Carp::croak($msg) if $msg; | ||
123 | } | ||||
124 | } | ||||
125 | |||||
126 | 1000000 | 428ms | $_[0]->{$name} = $_[1]; | ||
127 | } | ||||
128 | else { | ||||
129 | Carp::croak("Attempt to modify read-only attribute: $name"); | ||||
130 | } | ||||
131 | } | ||||
132 | |||||
133 | 2000000 | 6.52s | return($_[0]->{$name}); | ||
134 | 1 | 10µs | }; | ||
135 | |||||
136 | 1 | 5µs | return($attribute); | ||
137 | } | ||||
138 | |||||
139 | # spent 39µs (21+18) within Typed::has which was called:
# once (21µs+18µs) by main::RUNTIME at line 104 of fastest.pl | ||||
140 | 1 | 600ns | my $name = shift; | ||
141 | 1 | 2µs | my %opts = @_; | ||
142 | 1 | 1µs | my $package = caller; | ||
143 | |||||
144 | 1 | 2µs | $meta{$package}{$name} = \%opts; | ||
145 | |||||
146 | 1 | 4µs | 1 | 18µs | my $attribute = __PACKAGE__->process_has($name, $package); # spent 18µs making 1 call to Typed::process_has |
147 | |||||
148 | 4 | 328µs | 2 | 38µs | # spent 24µs (10+14) within Typed::BEGIN@148 which was called:
# once (10µs+14µs) by Foo::Typed::BEGIN@103 at line 148 # spent 24µs making 1 call to Typed::BEGIN@148
# spent 14µs making 1 call to strict::unimport |
149 | } | ||||
150 | |||||
151 | sub as (@) { | ||||
152 | unless (blessed($_[0])) { | ||||
153 | my $type = shift(@_); | ||||
154 | unshift(@_, __PACKAGE__->$type); | ||||
155 | } | ||||
156 | |||||
157 | Type::Utils::as(@_); | ||||
158 | } | ||||
159 | |||||
160 | sub from (@) | ||||
161 | { | ||||
162 | unless (blessed($_[0])) { | ||||
163 | my $type = shift(@_); | ||||
164 | unshift(@_, __PACKAGE__->$type); | ||||
165 | } | ||||
166 | |||||
167 | Type::Utils::from(@_); | ||||
168 | } | ||||
169 | |||||
170 | sub subtype | ||||
171 | { | ||||
172 | my $subtype = Type::Utils::subtype(@_); | ||||
173 | my $package = caller; | ||||
174 | my $name = $_[0]; | ||||
175 | $meta{subtype}{$package}{$name} = $subtype; | ||||
176 | } | ||||
177 | |||||
178 | 1 | 8µs | 1; | ||
179 | |||||
180 | __END__ |