| 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 | experimental::BEGIN@8 |
| 1 | 1 | 1 | 1.47ms | 1.48ms | experimental::BEGIN@4 |
| 1 | 1 | 1 | 604µs | 604µs | experimental::BEGIN@7 |
| 1 | 1 | 1 | 563µs | 900µs | experimental::BEGIN@5 |
| 1 | 1 | 1 | 249µs | 283µs | experimental::BEGIN@3 |
| 75 | 1 | 1 | 5µs | 5µs | experimental::CORE:match (opcode) |
| 1 | 1 | 1 | 5µs | 35µs | experimental::_enable |
| 1 | 1 | 1 | 3µs | 38µs | experimental::import |
| 0 | 0 | 0 | 0s | 0s | experimental::_disable |
| 0 | 0 | 0 | 0s | 0s | experimental::unimport |
| 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 |