In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c9ebf02397fb525998acacd7b4ac9a55323b54ab?hp=d5dc70019fa9d6f8c265e0493cfe7dea6cec45a1>
- Log ----------------------------------------------------------------- commit c9ebf02397fb525998acacd7b4ac9a55323b54ab Merge: d333a65 5885666 Author: Nicholas Clark <[email protected]> Date: Mon Mar 19 10:30:34 2012 +0100 Merge the feature and B::Deparse refactoring to blead. commit 58856662e3d8fc062bbb58ba29d28f4d9d29cbba Author: Nicholas Clark <[email protected]> Date: Mon Mar 19 10:29:48 2012 +0100 Note the improvements to B::Deparse and feature in perldelta. M pod/perldelta.pod commit 0c8d50175e8fc59ffe16de8607996905f18a8b28 Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 23:54:10 2012 +0100 In feature.pm, inline current_bundle() into __common(), its only caller. current_bundle() was added after 5.14.0 was released, so has never been in a stable release. Hence it's totally safe to kill it. M lib/feature.pm M regen/feature.pl commit d9ee6ccb5fa3d256d9d020e332ee8ba52706c2ae Author: Nicholas Clark <[email protected]> Date: Mon Feb 27 18:33:08 2012 +0100 In feature.pm, inline normalise_hints() into __common(), its only caller. normalise_hints() was added after 5.14.0 was released, so has never been in a stable release. Hence it's totally safe to kill it. M lib/feature.pm M regen/feature.pl commit d37572645496516ed45536ef36684ba890c8f09b Author: Nicholas Clark <[email protected]> Date: Mon Feb 27 18:24:57 2012 +0100 Merge the code common to feature::import and feature::unimport. M lib/feature.pm M regen/feature.pl commit 36143a0c55b8cfba5c5c2c2b40c5e00bce067bf2 Author: Nicholas Clark <[email protected]> Date: Mon Feb 27 17:57:54 2012 +0100 In feature.pm, use a consistent code style in import() and unimport(). There were a couple of inconsistencies (shift with/without an explicit @_, exists with/without(), !@_ vs @_ == 0) which turn out to date back to before 5.10.0 Also fix an inadvertent use of a single element array slice with a simple array lookup in current_bundle(). M lib/feature.pm M regen/feature.pl commit 1873980aaeb3ef1e5a2e1ef646a831ce8ddc3e11 Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 23:30:30 2012 +0100 In B::Deparse::_features_from_bundle(), don't call feature::current_bundle() Instead, directly access feature's package variables, as B::Deparse already does in 14 other places. (It also has its tentacles firmly into strict and warning's package variables - it's not fussy) feature::current_bundle() was not part of the documented API of feature either, so B::Deparse wasn't clean previously. M dist/B-Deparse/Deparse.pm commit 149758b3fc289aa2e2cbf92de18c3cee9475fe83 Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 11:11:02 2012 +0100 In Deparse, use $feature::hint_mask directly, instead of copying its value. Also, require feature unconditionally. Deparse already directly uses data from feature, switch and warnings, so this isn't a new trend in encapsulation breakage. Previously Deparse copied the value of $feature::hint_mask, and lazily loaded require in 4 places. M dist/B-Deparse/Deparse.pm commit 95c04cdeb56d45fc9abbac71ca13bfc750bc0a21 Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 23:09:02 2012 +0100 In B::Deparse, refactor common code into _features_from_bundle(). M dist/B-Deparse/Deparse.pm commit c63c25b23f61fe3136dbeb1c42bcfda18736c094 Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 22:57:31 2012 +0100 In B::Deparse, refactor the two places that feature::current_bundle() Converge the code, so that it's easy to extract out into a subroutine. M dist/B-Deparse/Deparse.pm commit 9c56cdbdb331493eb1f11fc04da8bd6a069aa77c Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 17:32:08 2012 +0100 Fix regression in deparsing say (etc) under use 5.10.0 Commit 6634bb9d0ed117be introduced a regression, causing this use 5.10.0; say "Perl rules"; to be deparsed as C<CORE::say>, not C<say>, etc. It wasn't actually possible to write tests for this within the t/deparse.t framework until the recent refactoring. M dist/B-Deparse/Deparse.pm M dist/B-Deparse/t/deparse.t commit 8f57bb34632c3884eb14455ddf9dcb86975886af Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 16:44:51 2012 +0100 Add tests for deparsing C<say> under various combinations of pragmas. These mostly codify the current output of B::Deparse, which is not invalid, but might not be considered to be the optimal output. (It's defensive, in that it uses C<no feature;> which will ensure consistent behaviour whatever pragma context the output is evaluated in.) Some are TODO for the cases where B::Deparse is wrongly outputting C<CORE::say> instead of plain C<say> and C<CORE::__SUB__> instead of plain C<__SUB__>. M dist/B-Deparse/t/deparse.t commit 205fef8800760e59c00e57b4e56a9851113e96cb Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 14:00:56 2012 +0100 Avoid deparse.t testing everything under use feature ':5.10' Only use feature ':5.10' in those tests that actually need it. This will let us add tests for deparsing without any features enabled. M dist/B-Deparse/t/deparse.t commit a6087f241d4f8df274ed95db66813909e8eba7cc Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 13:49:18 2012 +0100 Add a 'context' feature to deparse.t, to better test ambient pragmas. Call ambient_pragmas() before each deparse test. This will allow use to remove the constraints of the current default, which is to always run under use feature ":5.10"; M dist/B-Deparse/t/deparse.t commit c4a350e6709d60f02654f36bb02d403e6763ecc1 Author: Nicholas Clark <[email protected]> Date: Tue Feb 28 12:43:02 2012 +0100 In deparse.t, rename %reason to %meta. Whilst skip and todo both have "reason"s, subsequent refactoring will use it for other purposes. M dist/B-Deparse/t/deparse.t commit d333a65555483b42982abcf933ffae2cf0b8a6a9 Author: Nicholas Clark <[email protected]> Date: Mon Mar 19 10:20:42 2012 +0100 Note in perldelta that C<no feature;> now means reset to default. The behaviour was changed with commit 39ec54a59ce332fc. M pod/perldelta.pod ----------------------------------------------------------------------- Summary of changes: dist/B-Deparse/Deparse.pm | 46 ++++++------- dist/B-Deparse/t/deparse.t | 173 ++++++++++++++++++++++++++++++++++++-------- lib/feature.pm | 71 +++++++------------ pod/perldelta.pod | 13 +++- regen/feature.pl | 71 +++++++------------ 5 files changed, 228 insertions(+), 146 deletions(-) diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm index 054b919..eb24214 100644 --- a/dist/B-Deparse/Deparse.pm +++ b/dist/B-Deparse/Deparse.pm @@ -20,10 +20,11 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring CVf_METHOD CVf_LVALUE PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED); -$VERSION = "1.12"; +$VERSION = '1.13'; use strict; use vars qw/$AUTOLOAD/; use warnings (); +require feature; BEGIN { # List version-specific constants here. @@ -1448,7 +1449,13 @@ sub seq_subs { return @text; } -my $feature_bundle_mask = 0x1c000000; +sub _features_from_bundle { + my ($hints, $hh) = @_; + foreach (@{$feature::feature_bundle{@feature::hint_bundles[$hints >> $feature::hint_shift]}}) { + $hh->{$feature::feature{$_}} = 1; + } + return $hh; +} # Notice how subs and formats are inserted between statements here; # also $[ assignments and pragmas. @@ -1504,22 +1511,17 @@ sub pp_nextstate { if ($] >= 5.015006) { # feature bundle hints - my $from = $old_hints & $feature_bundle_mask; - my $to = $ hints & $feature_bundle_mask; + my $from = $old_hints & $feature::hint_mask; + my $to = $ hints & $feature::hint_mask; if ($from != $to) { - require feature; - if ($to == $feature_bundle_mask) { + if ($to == $feature::hint_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()}, - ); + $self->{'hinthash'} + = _features_from_bundle($from, $self->{'hinthash'}); } else { my $bundle = @@ -1593,7 +1595,7 @@ my %rev_feature; sub declare_hinthash { my ($from, $to, $indent, $hints) = @_; my $doing_features = - ($hints & $feature_bundle_mask) == $feature_bundle_mask; + ($hints & $feature::hint_mask) == $feature::hint_mask; my @decls; my @features; my @unfeatures; # bugs? @@ -1624,7 +1626,6 @@ sub declare_hinthash { } my @ret; if (@features || @unfeatures) { - require feature; if (!%rev_feature) { %rev_feature = reverse %feature::feature } } if (@features) { @@ -1683,13 +1684,9 @@ sub keyword { return $name if $name =~ /^CORE::/; # just in case if (exists $feature_keywords{$name}) { my $hh; - my $hints = $self->{hints} & $feature_bundle_mask; - if ($hints && $hints != $feature_bundle_mask) { - require feature; - local $^H = $self->{hints}; - # Shh! Keep quite about this function. It is not to be - # relied upon. - $hh = { map +($_ => 1), feature::current_bundle() }; + my $hints = $self->{hints} & $feature::hint_mask; + if ($hints && $hints != $feature::hint_mask) { + $hh = _features_from_bundle($hints); } elsif ($hints) { $hh = $self->{'hinthash'} } return "CORE::$name" @@ -4546,11 +4543,10 @@ sub re_flags { elsif ($self->{hinthash} and $self->{hinthash}{reflags_charset} || $self->{hinthash}{feature_unicode} - or $self->{hints} & $feature_bundle_mask - && ($self->{hints} & $feature_bundle_mask) - != $feature_bundle_mask + or $self->{hints} & $feature::hint_mask + && ($self->{hints} & $feature::hint_mask) + != $feature::hint_mask && do { - require feature; $self->{hints} & $feature::hint_uni8bit; } ) { diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index cae808c..0fa3cbf 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -11,14 +11,7 @@ BEGIN { use warnings; use strict; -BEGIN { - # BEGIN block is actually a subroutine :-) - return unless $] > 5.009; - require feature; - feature->import(':5.10'); -} use Test::More; -use Config (); my $tests = 17; # not counting those in the __DATA__ section @@ -26,34 +19,23 @@ use B::Deparse; my $deparse = B::Deparse->new(); isa_ok($deparse, 'B::Deparse', 'instantiate a B::Deparse object'); -# Tell B::Deparse about our ambient pragmas -{ my ($hint_bits, $warning_bits, $hinthash); - BEGIN { ($hint_bits, $warning_bits, $hinthash) = ($^H, ${^WARNING_BITS}, \%^H); } - $deparse->ambient_pragmas ( - hint_bits => $hint_bits, - warning_bits => $warning_bits, - '%^H' => $hinthash, - ); -} - $/ = "\n####\n"; while (<DATA>) { chomp; $tests ++; # This code is pinched from the t/lib/common.pl for TODO. # It's not clear how to avoid duplication - # Now tweaked a bit to do skip or todo - my %reason; - foreach my $what (qw(skip todo)) { - s/^#\s*\U$what\E\s*(.*)\n//m and $reason{$what} = $1; + my %meta = (context => ''); + foreach my $what (qw(skip todo context)) { + s/^#\s*\U$what\E\s*(.*)\n//m and $meta{$what} = $1; # If the SKIP reason starts ? then it's taken as a code snippet to # evaluate. This provides the flexibility to have conditional SKIPs - if ($reason{$what} && $reason{$what} =~ s/^\?//) { - my $temp = eval $reason{$what}; + if ($meta{$what} && $meta{$what} =~ s/^\?//) { + my $temp = eval $meta{$what}; if ($@) { - die "# In \U$what\E code reason:\n# $reason{$what}\n$@"; + die "# In \U$what\E code reason:\n# $meta{$what}\n$@"; } - $reason{$what} = $temp; + $meta{$what} = $temp; } } @@ -61,9 +43,9 @@ while (<DATA>) { my $desc = $1; die "Missing name in test $_" unless defined $desc; - if ($reason{skip}) { + if ($meta{skip}) { # Like this to avoid needing a label SKIP: - Test::More->builder->skip($reason{skip}); + Test::More->builder->skip($meta{skip}); next; } @@ -75,7 +57,18 @@ while (<DATA>) { ($input, $expected) = ($_, $_); } - my $coderef = eval "sub {$input}"; + my $coderef = eval "$meta{context};\n" . <<'EOC' . "sub {$input}"; +# Tell B::Deparse about our ambient pragmas +my ($hint_bits, $warning_bits, $hinthash); +BEGIN { + ($hint_bits, $warning_bits, $hinthash) = ($^H, ${^WARNING_BITS}, \%^H); +} +$deparse->ambient_pragmas ( + hint_bits => $hint_bits, + warning_bits => $warning_bits, + '%^H' => $hinthash, +); +EOC if ($@) { is($@, "", "compilation of $desc"); @@ -87,7 +80,7 @@ while (<DATA>) { $regex =~ s/\s+/\\s+/g; $regex = '^\{\s*' . $regex . '\s*\}$'; - local $::TODO = $reason{todo}; + local $::TODO = $meta{todo}; like($deparsed, qr/$regex/, $desc); } } @@ -460,20 +453,109 @@ our @bar; foo { @bar } 1 xor foo(); #### # SKIP ?$] < 5.010 && "say not implemented on this Perl version" +# CONTEXT use feature ':5.10'; # say say 'foo'; #### +# SKIP ?$] < 5.010 && "say not implemented on this Perl version" +# CONTEXT use 5.10.0; +# say in the context of use 5.10.0 +say 'foo'; +#### +# SKIP ?$] < 5.010 && "say not implemented on this Perl version" +# say with use 5.10.0 +use 5.10.0; +say 'foo'; +>>>> +no feature; +use feature ':5.10'; +say 'foo'; +#### +# SKIP ?$] < 5.010 && "say not implemented on this Perl version" +# say with use feature ':5.10'; +use feature ':5.10'; +say 'foo'; +>>>> +use feature 'say', 'state', 'switch'; +say 'foo'; +#### +# SKIP ?$] < 5.010 && "say not implemented on this Perl version" +# CONTEXT use feature ':5.10'; +# say with use 5.10.0 in the context of use feature +use 5.10.0; +say 'foo'; +>>>> +no feature; +use feature ':5.10'; +say 'foo'; +#### +# SKIP ?$] < 5.010 && "say not implemented on this Perl version" +# CONTEXT use 5.10.0; +# say with use feature ':5.10' in the context of use 5.10.0 +use feature ':5.10'; +say 'foo'; +>>>> +say 'foo'; +#### +# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" +# CONTEXT use feature ':5.15'; +# __SUB__ +__SUB__; +#### +# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" +# CONTEXT use 5.15.0; +# __SUB__ in the context of use 5.15.0 +__SUB__; +#### +# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" +# __SUB__ with use 5.15.0 +use 5.15.0; +__SUB__; +>>>> +no feature; +use feature ':5.16'; +__SUB__; +#### +# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" +# __SUB__ with use feature ':5.15'; +use feature ':5.15'; +__SUB__; +>>>> +use feature 'current_sub', 'evalbytes', 'fc', 'say', 'state', 'switch', 'unicode_strings', 'unicode_eval'; +__SUB__; +#### +# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" +# CONTEXT use feature ':5.15'; +# __SUB__ with use 5.15.0 in the context of use feature +use 5.15.0; +__SUB__; +>>>> +no feature; +use feature ':5.16'; +__SUB__; +#### +# SKIP ?$] < 5.015 && "__SUB__ not implemented on this Perl version" +# CONTEXT use 5.15.0; +# __SUB__ with use feature ':5.15' in the context of use 5.15.0 +use feature ':5.15'; +__SUB__; +>>>> +__SUB__; +#### # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" +# CONTEXT use feature ':5.10'; # state vars state $x = 42; #### # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" +# CONTEXT use feature ':5.10'; # state var assignment { my $y = (state $x = 42); } #### # SKIP ?$] < 5.010 && "state vars not implemented on this Perl version" +# CONTEXT use feature ':5.10'; # state vars in anonymous subroutines $a = sub { state $x; @@ -498,6 +580,7 @@ my $c = []; my $d = \[]; #### # SKIP ?$] < 5.010 && "smartmatch and given/when not implemented on this Perl version" +# CONTEXT use feature ':5.10'; # implicit smartmatch in given/when given ('foo') { when ('bar') { continue; } @@ -857,7 +940,6 @@ my @a; $a[0] = 1; #### # feature features without feature -no feature 'say', 'state', 'switch'; CORE::state $x; CORE::say $x; CORE::given ($x) { @@ -888,6 +970,37 @@ CORE::given ($x) { CORE::evalbytes ''; () = CORE::__SUB__; >>>> +CORE::state $x; +CORE::say $x; +CORE::given ($x) { + CORE::when (3) { + continue; + } + CORE::default { + CORE::break; + } +} +CORE::evalbytes ''; +() = CORE::__SUB__; +#### +# (the above test with CONTEXT, and the output is equivalent but different) +# CONTEXT use feature ':5.10'; +# feature features when feature has been disabled by use VERSION +use feature (sprintf(":%vd", $^V)); +use 1; +CORE::state $x; +CORE::say $x; +CORE::given ($x) { + CORE::when (3) { + continue; + } + CORE::default { + CORE::break; + } +} +CORE::evalbytes ''; +() = CORE::__SUB__; +>>>> no feature; use feature ':default'; CORE::state $x; diff --git a/lib/feature.pm b/lib/feature.pm index 58380e9..87b42aa 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -299,50 +299,14 @@ bundle is automatically loaded instead. =cut -sub current_bundle { - my $bundle_number = $^H & $hint_mask; - return if $bundle_number == $hint_mask; - return $feature_bundle{@hint_bundles[$bundle_number >> $hint_shift]}; -} - -sub normalise_hints { - # Delete any keys that may be left over from last time. - delete @^H{ values(%feature) }; - $^H |= $hint_mask; - for (@{+shift}) { - $^H{$feature{$_}} = 1; - $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; - } -} - sub import { my $class = shift; - if (@_ == 0) { + + if (!@_) { croak("No features specified"); } - if (my $features = current_bundle) { - # Features are enabled implicitly via bundle hints. - normalise_hints $features; - } - while (@_) { - my $name = shift(@_); - if (substr($name, 0, 1) eq ":") { - my $v = substr($name, 1); - if (!exists $feature_bundle{$v}) { - $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/; - if (!exists $feature_bundle{$v}) { - unknown_feature_bundle(substr($name, 1)); - } - } - unshift @_, @{$feature_bundle{$v}}; - next; - } - if (!exists $feature{$name}) { - unknown_feature($name); - } - $^H{$feature{$name}} = 1; - $^H |= $hint_uni8bit if $name eq 'unicode_strings'; - } + + __common(1, @_); } sub unimport { @@ -354,11 +318,25 @@ sub unimport { return; } - if (my $features = current_bundle) { + __common(0, @_); +} + + +sub __common { + my $import = shift; + my $bundle_number = $^H & $hint_mask; + my $features = $bundle_number != $hint_mask + && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; + if ($features) { # Features are enabled implicitly via bundle hints. - normalise_hints $features; + # Delete any keys that may be left over from last time. + delete @^H{ values(%feature) }; + $^H |= $hint_mask; + for (@$features) { + $^H{$feature{$_}} = 1; + $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; + } } - while (@_) { my $name = shift; if (substr($name, 0, 1) eq ":") { @@ -372,10 +350,13 @@ sub unimport { unshift @_, @{$feature_bundle{$v}}; next; } - if (!exists($feature{$name})) { + if (!exists $feature{$name}) { unknown_feature($name); } - else { + if ($import) { + $^H{$feature{$name}} = 1; + $^H |= $hint_uni8bit if $name eq 'unicode_strings'; + } else { delete $^H{$feature{$name}}; $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings'; } diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 94528fe..0041461 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -94,7 +94,18 @@ XXX =item * -L<XXX> has been upgraded from version 0.69 to version 0.70. +L<B::Deparse> has been upgrade from version 1.11 to 1.12 + +This fixes a post-v5.14 regression in deparsing C<say> (I<etc>) under +C<use 5.10.0;>. + +=item * + +L<feature> has been upgraded from version 1.26 to 1.27 + +C<no feature;> now means reset to default. + +The code has been refactored to reduce duplication. =back diff --git a/regen/feature.pl b/regen/feature.pl index aaac912..2a8d369 100755 --- a/regen/feature.pl +++ b/regen/feature.pl @@ -583,50 +583,14 @@ bundle is automatically loaded instead. =cut -sub current_bundle { - my $bundle_number = $^H & $hint_mask; - return if $bundle_number == $hint_mask; - return $feature_bundle{@hint_bundles[$bundle_number >> $hint_shift]}; -} - -sub normalise_hints { - # Delete any keys that may be left over from last time. - delete @^H{ values(%feature) }; - $^H |= $hint_mask; - for (@{+shift}) { - $^H{$feature{$_}} = 1; - $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; - } -} - sub import { my $class = shift; - if (@_ == 0) { + + if (!@_) { croak("No features specified"); } - if (my $features = current_bundle) { - # Features are enabled implicitly via bundle hints. - normalise_hints $features; - } - while (@_) { - my $name = shift(@_); - if (substr($name, 0, 1) eq ":") { - my $v = substr($name, 1); - if (!exists $feature_bundle{$v}) { - $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/; - if (!exists $feature_bundle{$v}) { - unknown_feature_bundle(substr($name, 1)); - } - } - unshift @_, @{$feature_bundle{$v}}; - next; - } - if (!exists $feature{$name}) { - unknown_feature($name); - } - $^H{$feature{$name}} = 1; - $^H |= $hint_uni8bit if $name eq 'unicode_strings'; - } + + __common(1, @_); } sub unimport { @@ -638,11 +602,25 @@ sub unimport { return; } - if (my $features = current_bundle) { + __common(0, @_); +} + + +sub __common { + my $import = shift; + my $bundle_number = $^H & $hint_mask; + my $features = $bundle_number != $hint_mask + && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}; + if ($features) { # Features are enabled implicitly via bundle hints. - normalise_hints $features; + # Delete any keys that may be left over from last time. + delete @^H{ values(%feature) }; + $^H |= $hint_mask; + for (@$features) { + $^H{$feature{$_}} = 1; + $^H |= $hint_uni8bit if $_ eq 'unicode_strings'; + } } - while (@_) { my $name = shift; if (substr($name, 0, 1) eq ":") { @@ -656,10 +634,13 @@ sub unimport { unshift @_, @{$feature_bundle{$v}}; next; } - if (!exists($feature{$name})) { + if (!exists $feature{$name}) { unknown_feature($name); } - else { + if ($import) { + $^H{$feature{$name}} = 1; + $^H |= $hint_uni8bit if $name eq 'unicode_strings'; + } else { delete $^H{$feature{$name}}; $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings'; } -- Perl5 Master Repository
