From 0bb01b05aacbaf29e0a910c8f0bc3ab2eb39f8a0 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sat, 24 Dec 2011 06:47:41 -0800 Subject: [PATCH] =?utf8?q?Deparse=20implicit=20with=20=E2=80=98use=20featu?= =?utf8?q?re=E2=80=99?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit When a version declaration has been seen, it’s not possible to deparse the code perfectly correctly, but using ‘no feature; use feature "5.14"’ is a reasonable tradeoff. See also commit 1c74777c25. This necessitated sorting %^H keys that are output to keep tests pass- ing. Previously they were relying on phases of the moon. --- dist/B-Deparse/Deparse.pm | 62 +++++++++++++++++++++++++++++++++++++--------- dist/B-Deparse/t/deparse.t | 38 ++++++++++++++++++++++------ lib/feature.pm | 8 +++--- regen/feature.pl | 8 +++--- 4 files changed, 88 insertions(+), 28 deletions(-) diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index b78ef67..3c1dd08 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -1427,6 +1427,8 @@ sub seq_subs { return @text; } +my $feature_bundle_mask = 0x1c000000; + # Notice how subs and formats are inserted between statements here; # also $[ assignments and pragmas. sub pp_nextstate { @@ -1468,18 +1470,52 @@ sub pp_nextstate { } my $hints = $] < 5.008009 ? $op->private : $op->hints; + my $old_hints = $self->{'hints'}; if ($self->{'hints'} != $hints) { push @text, declare_hints($self->{'hints'}, $hints); $self->{'hints'} = $hints; } - if ($] > 5.009 && - @text != push @text, declare_hinthash( - $self->{'hinthash'}, $op->hints_hash->HASH, - $self->{indent_size} - ) - ) { - $self->{'hinthash'} = $op->hints_hash->HASH; + my $newhh; + if ($] > 5.009) { + $newhh = $op->hints_hash->HASH; + } + + if ($] >= 5.015006) { + # feature bundle hints + my $from = $old_hints & $feature_bundle_mask; + my $to = $ hints & $feature_bundle_mask; + if ($from != $to) { + require feature; + if ($to == $feature_bundle_mask) { + if ($self->{'hinthash'}) { + delete $self->{'hinthash'}{$_} + for grep /^feature_/, keys %{$self->{'hinthash'}}; + } + else { $self->{'hinthash'} = {} } + local $^H = $from; + %{$self->{'hinthash'}} = ( + %{$self->{'hinthash'}}, + map +($feature::feature{$_} => 1), + @{feature::current_bundle()}, + ); + } + else { + my $bundle = + $feature::hint_bundles[$to >> $feature::hint_shift]; + $bundle =~ s/(\d[13579])\z/$1+1/e; # 5.11 => 5.12 + push @text, "no feature;\n", + "use feature ':$bundle';\n"; + } + } + } + + if ($] > 5.009) { + push @text, declare_hinthash( + $self->{'hinthash'}, $newhh, + $self->{indent_size}, $self->{hints}, + ); + $self->{'hinthash'} = $newhh; } # This should go after of any branches that add statements, to @@ -1532,10 +1568,13 @@ my %ignored_hints = ( ); sub declare_hinthash { - my ($from, $to, $indent) = @_; + my ($from, $to, $indent, $hints) = @_; + my $doing_features = $^V lt 5.15.6 || + ($hints & $feature_bundle_mask) == $feature_bundle_mask; my @decls; - for my $key (keys %$to) { + for my $key (sort keys %$to) { next if $ignored_hints{$key}; + next if $key =~ /^feature_/ and not $doing_features; if (!exists $from->{$key} or $from->{$key} ne $to->{$key}) { push @decls, qq(\$^H{) . single_delim("q", "'", $key) . qq(} = ) @@ -1547,8 +1586,9 @@ sub declare_hinthash { . qq(;); } } - for my $key (keys %$from) { + for my $key (sort keys %$from) { next if $ignored_hints{$key}; + next if $key =~ /^feature_/ and not $doing_features; if (!exists $to->{$key}) { push @decls, qq(delete \$^H{'$key'};); } @@ -1583,8 +1623,6 @@ my %feature_keywords = ( __SUB__ => '__SUB__', ); -my $feature_bundle_mask = 0x1c000000; - sub keyword { my $self = shift; my $name = shift; diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index 92917fd..f13d6b0 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -784,8 +784,8 @@ print /a/u, s/b/c/u; print /a/d, s/b/c/d; } { - BEGIN { $^H{'reflags_charset'} = '2'; - $^H{'reflags'} = '0'; } + BEGIN { $^H{'reflags'} = '0'; + $^H{'reflags_charset'} = '2'; } print /a/d, s/b/c/d; } #### @@ -853,12 +853,8 @@ CORE::given ($x) { CORE::evalbytes ''; () = CORE::__SUB__; >>>> -BEGIN { - $^H{'feature___SUB__'} = '1'; - $^H{'feature_unieval'} = '1'; - $^H{'feature_unicode'} = '1'; - $^H{'feature_evalbytes'} = '1'; -} +no feature; +use feature ':default'; CORE::state $x; CORE::say $x; CORE::given ($x) { @@ -872,6 +868,32 @@ CORE::given ($x) { CORE::evalbytes ''; () = CORE::__SUB__; #### +# Feature hints +use feature 'current_sub', 'evalbytes'; +print; +use 1; +print; +use 5.014; +print; +no feature 'unicode_strings'; +print; +>>>> +BEGIN { + $^H{'feature___SUB__'} = '1'; + $^H{'feature_evalbytes'} = '1'; +} +print $_; +no feature; +use feature ':default'; +print $_; +no feature; +use feature ':5.12'; +print $_; +BEGIN { + delete $^H{'feature_unicode'}; +} +print $_; +#### # $#- $#+ $#{%} etc. my @x; @x = ($#{`}, $#{~}, $#{!}, $#{@}, $#{$}, $#{%}, $#{^}, $#{&}, $#{*}); diff --git a/lib/feature.pm b/lib/feature.pm index ff1dd6d..8dfb7aa 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -7,7 +7,7 @@ package feature; our $VERSION = '1.25'; -my %feature = ( +our %feature = ( say => 'feature_say', state => 'feature_state', switch => 'feature_switch', @@ -31,9 +31,9 @@ $feature_bundle{"5.14"} = $feature_bundle{"5.11"}; $feature_bundle{"5.16"} = $feature_bundle{"5.15"}; $feature_bundle{"5.9.5"} = $feature_bundle{"5.10"}; -my $hint_shift = 26; -my $hint_mask = 0x1c000000; -my @hint_bundles = qw( default 5.10 5.11 5.15 ); +our $hint_shift = 26; +our $hint_mask = 0x1c000000; +our @hint_bundles = qw( default 5.10 5.11 5.15 ); # This gets set (for now) in $^H as well as in %^H, # for runtime speed of the uc/lc/ucfirst/lcfirst functions. diff --git a/regen/feature.pl b/regen/feature.pl index cea90fb..a10ceb8 100755 --- a/regen/feature.pl +++ b/regen/feature.pl @@ -136,7 +136,7 @@ sub longest { $long; } -print $pm "my %feature = (\n"; +print $pm "our %feature = (\n"; my $width = length longest keys %feature; for(sort { length $a <=> length $b } keys %feature) { print $pm " $_" . " "x($width-length) @@ -161,9 +161,9 @@ for (sort keys %Aliases) { print $pm <