Filename | /home/leont/perl5/perlbrew/perls/perl-5.32.0/lib/5.32.0/experimental.pm |
Statements | Executed 103 statements in 2.71ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.63ms | 3.09ms | BEGIN@8 | experimental::
1 | 1 | 1 | 1.47ms | 1.48ms | BEGIN@4 | experimental::
1 | 1 | 1 | 604µs | 604µs | BEGIN@7 | experimental::
1 | 1 | 1 | 563µs | 900µs | BEGIN@5 | experimental::
1 | 1 | 1 | 249µs | 283µs | BEGIN@3 | experimental::
75 | 1 | 1 | 5µs | 5µs | CORE:match (opcode) | experimental::
1 | 1 | 1 | 5µs | 35µs | _enable | experimental::
1 | 1 | 1 | 3µs | 38µs | import | experimental::
0 | 0 | 0 | 0s | 0s | _disable | experimental::
0 | 0 | 0 | 0s | 0s | unimport | experimental::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package experimental; | ||||
2 | 1 | 200ns | $experimental::VERSION = '0.020'; | ||
3 | 2 | 152µs | 2 | 285µs | # spent 283µs (249+34) within experimental::BEGIN@3 which was called:
# once (249µs+34µs) by main::BEGIN@3 at line 3 # spent 283µs making 1 call to experimental::BEGIN@3
# spent 2µs making 1 call to strict::import |
4 | 2 | 1.42ms | 2 | 1.49ms | # spent 1.48ms (1.47+14µs) within experimental::BEGIN@4 which was called:
# once (1.47ms+14µs) by main::BEGIN@3 at line 4 # spent 1.48ms making 1 call to experimental::BEGIN@4
# spent 11µs making 1 call to warnings::import |
5 | 2 | 51µs | 1 | 900µs | # spent 900µs (563+337) within experimental::BEGIN@5 which was called:
# once (563µs+337µs) by main::BEGIN@3 at line 5 # spent 900µs making 1 call to experimental::BEGIN@5 |
6 | |||||
7 | 2 | 596µs | 1 | 604µs | # spent 604µs within experimental::BEGIN@7 which was called:
# once (604µs+0s) by main::BEGIN@3 at line 7 # spent 604µs making 1 call to experimental::BEGIN@7 |
8 | 2 | 353µs | 2 | 3.12ms | # spent 3.09ms (2.63+453µs) within experimental::BEGIN@8 which was called:
# once (2.63ms+453µs) by main::BEGIN@3 at line 8 # spent 3.09ms making 1 call to experimental::BEGIN@8
# spent 30µs making 1 call to Exporter::import |
9 | |||||
10 | 76 | 71µs | 75 | 5µs | my %warnings = map { $_ => 1 } grep { /^experimental::/ } keys %warnings::Offsets; # spent 5µs making 75 calls to experimental::CORE:match, avg 68ns/call |
11 | 1 | 4µs | my %features = map { $_ => 1 } $] > 5.015006 ? keys %feature::feature : do { | ||
12 | my @features; | ||||
13 | if ($] >= 5.010) { | ||||
14 | push @features, qw/switch say state/; | ||||
15 | push @features, 'unicode_strings' if $] > 5.011002; | ||||
16 | } | ||||
17 | @features; | ||||
18 | }; | ||||
19 | |||||
20 | 1 | 3µs | my %min_version = ( | ||
21 | array_base => '5', | ||||
22 | autoderef => '5.14.0', | ||||
23 | bitwise => '5.22.0', | ||||
24 | const_attr => '5.22.0', | ||||
25 | current_sub => '5.16.0', | ||||
26 | declared_refs => '5.26.0', | ||||
27 | evalbytes => '5.16.0', | ||||
28 | fc => '5.16.0', | ||||
29 | lexical_topic => '5.10.0', | ||||
30 | lexical_subs => '5.18.0', | ||||
31 | postderef => '5.20.0', | ||||
32 | postderef_qq => '5.20.0', | ||||
33 | refaliasing => '5.22.0', | ||||
34 | regex_sets => '5.18.0', | ||||
35 | say => '5.10.0', | ||||
36 | smartmatch => '5.10.0', | ||||
37 | signatures => '5.20.0', | ||||
38 | state => '5.10.0', | ||||
39 | switch => '5.10.0', | ||||
40 | unicode_eval => '5.16.0', | ||||
41 | unicode_strings => '5.12.0', | ||||
42 | ); | ||||
43 | 1 | 400ns | my %max_version = ( | ||
44 | autoderef => '5.23.1', | ||||
45 | lexical_topic => '5.23.4', | ||||
46 | ); | ||||
47 | |||||
48 | 1 | 35µs | 21 | 17µs | $_ = version->new($_) for values %min_version; # spent 17µs making 21 calls to version::new, avg 819ns/call |
49 | 1 | 5µs | 2 | 2µs | $_ = version->new($_) for values %max_version; # spent 2µs making 2 calls to version::new, avg 750ns/call |
50 | |||||
51 | 1 | 900ns | my %additional = ( | ||
52 | postderef => ['postderef_qq'], | ||||
53 | switch => ['smartmatch'], | ||||
54 | declared_refs => ['refaliasing'], | ||||
55 | ); | ||||
56 | |||||
57 | # spent 35µs (5+30) within experimental::_enable which was called:
# once (5µs+30µs) by experimental::import at line 89 | ||||
58 | 1 | 200ns | my $pragma = shift; | ||
59 | 1 | 2µs | if ($warnings{"experimental::$pragma"}) { | ||
60 | 1 | 800ns | 1 | 6µs | warnings->unimport("experimental::$pragma"); # spent 6µs making 1 call to warnings::unimport |
61 | 1 | 1µs | 1 | 24µs | feature->import($pragma) if exists $features{$pragma}; # spent 24µs making 1 call to feature::import |
62 | 1 | 200ns | _enable(@{ $additional{$pragma} }) if $additional{$pragma}; | ||
63 | } | ||||
64 | elsif ($features{$pragma}) { | ||||
65 | feature->import($pragma); | ||||
66 | _enable(@{ $additional{$pragma} }) if $additional{$pragma}; | ||||
67 | } | ||||
68 | elsif (not exists $min_version{$pragma}) { | ||||
69 | croak "Can't enable unknown feature $pragma"; | ||||
70 | } | ||||
71 | elsif ($] < $min_version{$pragma}) { | ||||
72 | my $stable = $min_version{$pragma}; | ||||
73 | if ($stable->{version}[1] % 2) { | ||||
74 | $stable = version->new( | ||||
75 | "5.".($stable->{version}[1]+1).'.0' | ||||
76 | ); | ||||
77 | } | ||||
78 | croak "Need perl $stable or later for feature $pragma"; | ||||
79 | } | ||||
80 | elsif ($] >= ($max_version{$pragma} || 7)) { | ||||
81 | croak "Experimental feature $pragma has been removed from perl in version $max_version{$pragma}"; | ||||
82 | } | ||||
83 | } | ||||
84 | |||||
85 | # spent 38µs (3+35) within experimental::import which was called:
# once (3µs+35µs) by main::BEGIN@3 at line 3 of /home/leont/Code/cpan/experimental/test.pl | ||||
86 | 1 | 500ns | my ($self, @pragmas) = @_; | ||
87 | |||||
88 | 1 | 300ns | for my $pragma (@pragmas) { | ||
89 | 1 | 700ns | 1 | 35µs | _enable($pragma); # spent 35µs making 1 call to experimental::_enable |
90 | } | ||||
91 | 1 | 1µs | return; | ||
92 | } | ||||
93 | |||||
94 | sub _disable { | ||||
95 | my $pragma = shift; | ||||
96 | if ($warnings{"experimental::$pragma"}) { | ||||
97 | warnings->import("experimental::$pragma"); | ||||
98 | feature->unimport($pragma) if exists $features{$pragma}; | ||||
99 | _disable(@{ $additional{$pragma} }) if $additional{$pragma}; | ||||
100 | } | ||||
101 | elsif ($features{$pragma}) { | ||||
102 | feature->unimport($pragma); | ||||
103 | _disable(@{ $additional{$pragma} }) if $additional{$pragma}; | ||||
104 | } | ||||
105 | elsif (not exists $min_version{$pragma}) { | ||||
106 | carp "Can't disable unknown feature $pragma, ignoring"; | ||||
107 | } | ||||
108 | } | ||||
109 | |||||
110 | sub unimport { | ||||
111 | my ($self, @pragmas) = @_; | ||||
112 | |||||
113 | for my $pragma (@pragmas) { | ||||
114 | _disable($pragma); | ||||
115 | } | ||||
116 | return; | ||||
117 | } | ||||
118 | |||||
119 | 1 | 10µs | 1; | ||
120 | |||||
121 | #ABSTRACT: Experimental features made easy | ||||
122 | |||||
123 | __END__ | ||||
# spent 5µs within experimental::CORE:match which was called 75 times, avg 68ns/call:
# 75 times (5µs+0s) by main::BEGIN@3 at line 10, avg 68ns/call |