Deparse all features with ‘use/no feature’
authorFather Chrysostomos <sprout@cpan.org>
Sat, 24 Dec 2011 20:46:49 +0000 (12:46 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 24 Dec 2011 20:46:49 +0000 (12:46 -0800)
dist/B-Deparse/Deparse.pm
dist/B-Deparse/t/deparse.t

index 3c1dd08..57e552f 100644 (file)
@@ -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 {
index f13d6b0..ee92a7d 100644 (file)
@@ -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.