Made additional-pragma logic recursive
Leon Timmermans
10 years ago
| 15 | 15 | array_base => 5, |
| 16 | 16 | ); |
| 17 | 17 | |
| 18 | my %additional_features = ( | |
| 18 | my %additional = ( | |
| 19 | 19 | postderef => ['postderef_qq'], |
| 20 | 20 | ); |
| 21 | ||
| 22 | sub _enable { | |
| 23 | my $pragma = shift; | |
| 24 | if ($warnings{"experimental::$pragma"}) { | |
| 25 | warnings->unimport("experimental::$pragma"); | |
| 26 | feature->import($pragma) if exists $features{$pragma}; | |
| 27 | _enable(@{ $additional{$pragma} }) if $additional{$pragma}; | |
| 28 | } | |
| 29 | elsif ($features{$pragma}) { | |
| 30 | feature->import($pragma); | |
| 31 | _enable(@{ $additional{$pragma} }) if $additional{$pragma}; | |
| 32 | } | |
| 33 | elsif (not $grandfathered{$pragma}) { | |
| 34 | croak "Can't enable unknown feature $pragma"; | |
| 35 | } | |
| 36 | elsif ($grandfathered{$pragma} > $]) { | |
| 37 | croak "Need perl $grandfathered{$pragma} for feature $pragma"; | |
| 38 | } | |
| 39 | } | |
| 21 | 40 | |
| 22 | 41 | sub import { |
| 23 | 42 | my ($self, @pragmas) = @_; |
| 24 | 43 | |
| 25 | 44 | for my $pragma (@pragmas) { |
| 26 | if ($warnings{"experimental::$pragma"}) { | |
| 27 | warnings->unimport("experimental::$pragma"); | |
| 28 | my @features = grep { $features{$_} } $pragma, @{ $additional_features{$pragma} || [] }; | |
| 29 | feature->import(@features) if @features; | |
| 30 | } | |
| 31 | elsif ($features{$pragma}) { | |
| 32 | feature->import($pragma); | |
| 33 | feature->import(@{ $additional_features{$pragma} }) if $additional_features{$pragma}; | |
| 34 | } | |
| 35 | elsif (not $grandfathered{$pragma}) { | |
| 36 | croak "Can't enable unknown feature $pragma"; | |
| 37 | } | |
| 38 | elsif ($grandfathered{$pragma} > $]) { | |
| 39 | croak "Need perl $grandfathered{$pragma} for feature $pragma"; | |
| 40 | } | |
| 45 | _enable($pragma); | |
| 41 | 46 | } |
| 42 | 47 | return; |
| 48 | } | |
| 49 | ||
| 50 | sub _disable { | |
| 51 | my $pragma = shift; | |
| 52 | if ($warnings{"experimental::$pragma"}) { | |
| 53 | warnings->import("experimental::$pragma"); | |
| 54 | feature->unimport($pragma) if exists $features{$pragma}; | |
| 55 | _disable(@{ $additional{$pragma} }) if $additional{$pragma}; | |
| 56 | } | |
| 57 | elsif ($features{$pragma}) { | |
| 58 | feature->unimport($pragma); | |
| 59 | _disable(@{ $additional{$pragma} }) if $additional{$pragma}; | |
| 60 | } | |
| 61 | elsif (not $grandfathered{$pragma}) { | |
| 62 | carp "Can't disable unknown feature $pragma, ignoring"; | |
| 63 | } | |
| 43 | 64 | } |
| 44 | 65 | |
| 45 | 66 | sub unimport { |
| 46 | 67 | my ($self, @pragmas) = @_; |
| 47 | 68 | |
| 48 | 69 | for my $pragma (@pragmas) { |
| 49 | if ($warnings{"experimental::$pragma"}) { | |
| 50 | warnings->import("experimental::$pragma"); | |
| 51 | feature->unimport(grep { $features{$_} } $pragma, @{ $additional_features{$pragma} || [] }); | |
| 52 | } | |
| 53 | elsif ($features{$pragma}) { | |
| 54 | feature->unimport($pragma); | |
| 55 | feature->unimport(@{ $additional_features{$pragma} }) if $additional_features{$pragma}; | |
| 56 | } | |
| 57 | elsif (not $grandfathered{$pragma}) { | |
| 58 | carp "Can't disable unknown feature $pragma, ignoring"; | |
| 59 | } | |
| 70 | _disable($pragma); | |
| 60 | 71 | } |
| 61 | 72 | return; |
| 62 | 73 | } |