summaryrefslogtreecommitdiff
path: root/dist
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2011-12-24 12:46:49 -0800
committerFather Chrysostomos <sprout@cpan.org>2011-12-24 12:46:49 -0800
commita8095af71977bf1ddbbcab6080fad138260be016 (patch)
treef59e72de90ed8a70adf436fa9e2127c81b7e370d /dist
parent2fc860ee1e0255bd8c8515abae2155fa0a2f4ce2 (diff)
downloadperl-a8095af71977bf1ddbbcab6080fad138260be016.tar.gz
Deparse all features with ‘use/no feature’
Diffstat (limited to 'dist')
-rw-r--r--dist/B-Deparse/Deparse.pm34
-rw-r--r--dist/B-Deparse/t/deparse.t17
2 files changed, 33 insertions, 18 deletions
diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 3c1dd08395..57e552f1b0 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -1567,15 +1567,21 @@ my %ignored_hints = (
'strict/vars' => 1,
);
+my %rev_feature;
+
sub declare_hinthash {
my ($from, $to, $indent, $hints) = @_;
- my $doing_features = $^V lt 5.15.6 ||
+ my $doing_features =
($hints & $feature_bundle_mask) == $feature_bundle_mask;
my @decls;
+ my @features;
+ my @unfeatures; # bugs?
for my $key (sort keys %$to) {
next if $ignored_hints{$key};
- next if $key =~ /^feature_/ and not $doing_features;
+ my $is_feature = $key =~ /^feature_/ && $^V ge 5.15.6;
+ next if $is_feature and not $doing_features;
if (!exists $from->{$key} or $from->{$key} ne $to->{$key}) {
+ push(@features, $key), next if $is_feature;
push @decls,
qq(\$^H{) . single_delim("q", "'", $key) . qq(} = )
. (
@@ -1588,13 +1594,31 @@ sub declare_hinthash {
}
for my $key (sort keys %$from) {
next if $ignored_hints{$key};
- next if $key =~ /^feature_/ and not $doing_features;
+ my $is_feature = $key =~ /^feature_/ && $^V ge 5.15.6;
+ next if $is_feature and not $doing_features;
if (!exists $to->{$key}) {
+ push(@unfeatures, $key), next if $is_feature;
push @decls, qq(delete \$^H{'$key'};);
}
}
- @decls or return;
- return join("\n" . (" " x $indent), "BEGIN {", @decls) . "\n}\n";
+ my @ret;
+ if (@features || @unfeatures) {
+ require feature;
+ if (!%rev_feature) { %rev_feature = reverse %feature::feature }
+ }
+ if (@features) {
+ push @ret, "use feature "
+ . join(", ", map "'$rev_feature{$_}'", @features) . ";\n";
+ }
+ if (@unfeatures) {
+ push @ret, "no feature "
+ . join(", ", map "'$rev_feature{$_}'", @unfeatures)
+ . ";\n";
+ }
+ @decls and
+ push @ret,
+ join("\n" . (" " x $indent), "BEGIN {", @decls) . "\n}\n";
+ return @ret;
}
sub hint_pragmas {
diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index f13d6b0472..ee92a7dbe8 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -780,7 +780,7 @@ print /a/p, s/b/c/p;
print /a/l, s/b/c/l;
print /a/u, s/b/c/u;
{
- BEGIN { $^H{'feature_unicode'} = '1'; }
+ use feature 'unicode_strings';
print /a/d, s/b/c/d;
}
{
@@ -819,11 +819,7 @@ my @a;
$a[0] = 1;
####
# feature features without feature
-BEGIN {
- delete $^H{'feature_say'};
- delete $^H{'feature_state'};
- delete $^H{'feature_switch'};
-}
+no feature 'say', 'state', 'switch';
CORE::state $x;
CORE::say $x;
CORE::given ($x) {
@@ -878,10 +874,7 @@ print;
no feature 'unicode_strings';
print;
>>>>
-BEGIN {
- $^H{'feature___SUB__'} = '1';
- $^H{'feature_evalbytes'} = '1';
-}
+use feature 'current_sub', 'evalbytes';
print $_;
no feature;
use feature ':default';
@@ -889,9 +882,7 @@ print $_;
no feature;
use feature ':5.12';
print $_;
-BEGIN {
- delete $^H{'feature_unicode'};
-}
+no feature 'unicode_strings';
print $_;
####
# $#- $#+ $#{%} etc.