package feature;
-our $VERSION = '1.27';
+our $VERSION = '1.69';
our %feature = (
- fc => 'feature_fc',
- say => 'feature_say',
- state => 'feature_state',
- switch => 'feature_switch',
- evalbytes => 'feature_evalbytes',
- array_base => 'feature_arybase',
- current_sub => 'feature___SUB__',
- unicode_eval => 'feature_unieval',
- unicode_strings => 'feature_unicode',
+ fc => 'feature_fc',
+ isa => 'feature_isa',
+ say => 'feature_say',
+ try => 'feature_try',
+ defer => 'feature_defer',
+ state => 'feature_state',
+ switch => 'feature_switch',
+ bitwise => 'feature_bitwise',
+ indirect => 'feature_indirect',
+ evalbytes => 'feature_evalbytes',
+ signatures => 'feature_signatures',
+ current_sub => 'feature___SUB__',
+ refaliasing => 'feature_refaliasing',
+ postderef_qq => 'feature_postderef_qq',
+ unicode_eval => 'feature_unieval',
+ declared_refs => 'feature_myref',
+ unicode_strings => 'feature_unicode',
+ multidimensional => 'feature_multidimensional',
+ bareword_filehandles => 'feature_bareword_filehandles',
);
our %feature_bundle = (
- "5.10" => [qw(array_base say state switch)],
- "5.11" => [qw(array_base say state switch unicode_strings)],
- "5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
- "all" => [qw(array_base current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
- "default" => [qw(array_base)],
+ "5.10" => [qw(bareword_filehandles indirect multidimensional say state switch)],
+ "5.11" => [qw(bareword_filehandles indirect multidimensional say state switch unicode_strings)],
+ "5.15" => [qw(bareword_filehandles current_sub evalbytes fc indirect multidimensional say state switch unicode_eval unicode_strings)],
+ "5.23" => [qw(bareword_filehandles current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)],
+ "5.27" => [qw(bareword_filehandles bitwise current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)],
+ "5.35" => [qw(bitwise current_sub evalbytes fc postderef_qq say state unicode_eval unicode_strings)],
+ "all" => [qw(bareword_filehandles bitwise current_sub declared_refs defer evalbytes fc indirect isa multidimensional postderef_qq refaliasing say signatures state switch try unicode_eval unicode_strings)],
+ "default" => [qw(bareword_filehandles indirect multidimensional)],
);
$feature_bundle{"5.12"} = $feature_bundle{"5.11"};
$feature_bundle{"5.13"} = $feature_bundle{"5.11"};
$feature_bundle{"5.14"} = $feature_bundle{"5.11"};
$feature_bundle{"5.16"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.17"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.18"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.19"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.20"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.21"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.22"} = $feature_bundle{"5.15"};
+$feature_bundle{"5.24"} = $feature_bundle{"5.23"};
+$feature_bundle{"5.25"} = $feature_bundle{"5.23"};
+$feature_bundle{"5.26"} = $feature_bundle{"5.23"};
+$feature_bundle{"5.28"} = $feature_bundle{"5.27"};
+$feature_bundle{"5.29"} = $feature_bundle{"5.27"};
+$feature_bundle{"5.30"} = $feature_bundle{"5.27"};
+$feature_bundle{"5.31"} = $feature_bundle{"5.27"};
+$feature_bundle{"5.32"} = $feature_bundle{"5.27"};
+$feature_bundle{"5.33"} = $feature_bundle{"5.27"};
+$feature_bundle{"5.34"} = $feature_bundle{"5.27"};
+$feature_bundle{"5.36"} = $feature_bundle{"5.35"};
$feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
+my %noops = (
+ postderef => 1,
+ lexical_subs => 1,
+);
+my %removed = (
+ array_base => 1,
+);
our $hint_shift = 26;
-our $hint_mask = 0x1c000000;
-our @hint_bundles = qw( default 5.10 5.11 5.15 );
+our $hint_mask = 0x3c000000;
+our @hint_bundles = qw( default 5.10 5.11 5.15 5.23 5.27 5.35 );
# This gets set (for now) in $^H as well as in %^H,
# for runtime speed of the uc/lc/ucfirst/lcfirst functions.
=head1 SYNOPSIS
- use feature qw(say switch);
- given ($foo) {
- when (1) { say "\$foo == 1" }
- when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
- when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
- when ($_ > 100) { say "\$foo > 100" }
- default { say "None of the above" }
- }
+ use feature qw(fc say);
- use feature ':5.10'; # loads all features available in perl 5.10
+ # Without the "use feature" above, this code would not be able to find
+ # the built-ins "say" or "fc":
+ say "The case-folded version of $x is: " . fc $x;
+
+
+ # set features to match the :5.10 bundle, which may turn off or on
+ # multiple features (see below)
+ use feature ':5.10';
- use v5.10; # implicitly loads :5.10 feature bundle
+
+ # implicitly loads :5.10 feature bundle
+ use v5.10;
=head1 DESCRIPTION
=head2 Lexical effect
Like other pragmas (C<use strict>, for example), features have a lexical
-effect. C<use feature qw(foo)> will only make the feature "foo" available
+effect. C<use feature qw(foo)> will only make the feature "foo" available
from that point to the end of the enclosing block.
{
=head2 The 'say' feature
-C<use feature 'say'> tells the compiler to enable the Perl 6 style
+C<use feature 'say'> tells the compiler to enable the Raku-inspired
C<say> function.
See L<perlfunc/say> for details.
=head2 The 'switch' feature
-C<use feature 'switch'> tells the compiler to enable the Perl 6
+B<WARNING>: This feature is still experimental and the implementation may
+change or be removed in future versions of Perl. For this reason, Perl will
+warn when you use the feature, unless you have explicitly disabled the warning:
+
+ no warnings "experimental::smartmatch";
+
+C<use feature 'switch'> tells the compiler to enable the Raku
given/when construct.
See L<perlsyn/"Switch Statements"> for details.
=head2 The 'unicode_strings' feature
-C<use feature 'unicode_strings'> tells the compiler to use Unicode semantics
+C<use feature 'unicode_strings'> tells the compiler to use Unicode rules
in all string operations executed within its scope (unless they are also
within the scope of either C<use locale> or C<use bytes>). The same applies
to all regular expressions compiled within the scope, even if executed outside
-it.
+it. It does not change the internal representation of strings, but only how
+they are interpreted.
C<no feature 'unicode_strings'> tells the compiler to use the traditional
-Perl semantics wherein the native character set semantics is used unless it is
+Perl rules wherein the native character set rules is used unless it is
clear to Perl that Unicode is desired. This can lead to some surprises
when the behavior suddenly changes. (See
L<perlunicode/The "Unicode Bug"> for details.) For this reason, if you are
C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
This feature is available starting with Perl 5.12; was almost fully
-implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>.
+implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>;
+was extended further in Perl 5.26 to cover L<the range
+operator|perlop/Range Operators>; and was extended again in Perl 5.28 to
+cover L<special-cased whitespace splitting|perlfunc/split>.
=head2 The 'unicode_eval' and 'evalbytes' features
-Under the C<unicode_eval> feature, Perl's C<eval> function, when passed a
-string, will evaluate it as a string of characters, ignoring any
-C<use utf8> declarations. C<use utf8> exists to declare the encoding of
-the script, which only makes sense for a stream of bytes, not a string of
-characters. Source filters are forbidden, as they also really only make
-sense on strings of bytes. Any attempt to activate a source filter will
-result in an error.
-
-The C<evalbytes> feature enables the C<evalbytes> keyword, which evaluates
-the argument passed to it as a string of bytes. It dies if the string
-contains any characters outside the 8-bit range. Source filters work
-within C<evalbytes>: they apply to the contents of the string being
-evaluated.
-
-Together, these two features are intended to replace the historical C<eval>
-function, which has (at least) two bugs in it, that cannot easily be fixed
-without breaking existing programs:
+Together, these two features are intended to replace the legacy string
+C<eval> function, which behaves problematically in some instances. They are
+available starting with Perl 5.16, and are enabled by default by a
+S<C<use 5.16>> or higher declaration.
-=over
-
-=item *
-
-C<eval> behaves differently depending on the internal encoding of the
-string, sometimes treating its argument as a string of bytes, and sometimes
-as a string of characters.
-
-=item *
+C<unicode_eval> changes the behavior of plain string C<eval> to work more
+consistently, especially in the Unicode world. Certain (mis)behaviors
+couldn't be changed without breaking some things that had come to rely on
+them, so the feature can be enabled and disabled. Details are at
+L<perlfunc/Under the "unicode_eval" feature>.
-Source filters activated within C<eval> leak out into whichever I<file>
-scope is currently being compiled. To give an example with the CPAN module
-L<Semi::Semicolons>:
-
- BEGIN { eval "use Semi::Semicolons; # not filtered here " }
- # filtered here!
-
-C<evalbytes> fixes that to work the way one would expect:
-
- use feature "evalbytes";
- BEGIN { evalbytes "use Semi::Semicolons; # filtered " }
- # not filtered
-
-=back
-
-These two features are available starting with Perl 5.16.
+C<evalbytes> is like string C<eval>, but it treats its argument as a byte
+string. Details are at L<perlfunc/evalbytes EXPR>. Without a
+S<C<use feature 'evalbytes'>> nor a S<C<use v5.16>> (or higher) declaration in
+the current scope, you can still access it by instead writing
+C<CORE::evalbytes>.
=head2 The 'current_sub' feature
=head2 The 'array_base' feature
-This feature supports the legacy C<$[> variable. See L<perlvar/$[> and
-L<arybase>. It is on by default but disabled under C<use v5.16> (see
-L</IMPLICIT LOADING>, below).
+This feature supported the legacy C<$[> variable. See L<perlvar/$[>.
+It was on by default but disabled under C<use v5.16> (see
+L</IMPLICIT LOADING>, below) and unavailable since perl 5.30.
This feature is available under this name starting with Perl 5.16. In
previous versions, it was simply on all the time, and this pragma knew
This feature is available from Perl 5.16 onwards.
+=head2 The 'lexical_subs' feature
+
+In Perl versions prior to 5.26, this feature enabled
+declaration of subroutines via C<my sub foo>, C<state sub foo>
+and C<our sub foo> syntax. See L<perlsub/Lexical Subroutines> for details.
+
+This feature is available from Perl 5.18 onwards. From Perl 5.18 to 5.24,
+it was classed as experimental, and Perl emitted a warning for its
+usage, except when explicitly disabled:
+
+ no warnings "experimental::lexical_subs";
+
+As of Perl 5.26, use of this feature no longer triggers a warning, though
+the C<experimental::lexical_subs> warning category still exists (for
+compatibility with code that disables it). In addition, this syntax is
+not only no longer experimental, but it is enabled for all Perl code,
+regardless of what feature declarations are in scope.
+
+=head2 The 'postderef' and 'postderef_qq' features
+
+The 'postderef_qq' feature extends the applicability of L<postfix
+dereference syntax|perlref/Postfix Dereference Syntax> so that postfix array
+and scalar dereference are available in double-quotish interpolations. For
+example, it makes the following two statements equivalent:
+
+ my $s = "[@{ $h->{a} }]";
+ my $s = "[$h->{a}->@*]";
+
+This feature is available from Perl 5.20 onwards. In Perl 5.20 and 5.22, it
+was classed as experimental, and Perl emitted a warning for its
+usage, except when explicitly disabled:
+
+ no warnings "experimental::postderef";
+
+As of Perl 5.24, use of this feature no longer triggers a warning, though
+the C<experimental::postderef> warning category still exists (for
+compatibility with code that disables it).
+
+The 'postderef' feature was used in Perl 5.20 and Perl 5.22 to enable
+postfix dereference syntax outside double-quotish interpolations. In those
+versions, using it triggered the C<experimental::postderef> warning in the
+same way as the 'postderef_qq' feature did. As of Perl 5.24, this syntax is
+not only no longer experimental, but it is enabled for all Perl code,
+regardless of what feature declarations are in scope.
+
+=head2 The 'signatures' feature
+
+B<WARNING>: This feature is still experimental and the implementation may
+change or be removed in future versions of Perl. For this reason, Perl will
+warn when you use the feature, unless you have explicitly disabled the warning:
+
+ no warnings "experimental::signatures";
+
+This enables unpacking of subroutine arguments into lexical variables
+by syntax such as
+
+ sub foo ($left, $right) {
+ return $left + $right;
+ }
+
+See L<perlsub/Signatures> for details.
+
+This feature is available from Perl 5.20 onwards.
+
+=head2 The 'refaliasing' feature
+
+B<WARNING>: This feature is still experimental and the implementation may
+change or be removed in future versions of Perl. For this reason, Perl will
+warn when you use the feature, unless you have explicitly disabled the warning:
+
+ no warnings "experimental::refaliasing";
+
+This enables aliasing via assignment to references:
+
+ \$a = \$b; # $a and $b now point to the same scalar
+ \@a = \@b; # to the same array
+ \%a = \%b;
+ \&a = \&b;
+ foreach \%hash (@array_of_hash_refs) {
+ ...
+ }
+
+See L<perlref/Assigning to References> for details.
+
+This feature is available from Perl 5.22 onwards.
+
+=head2 The 'bitwise' feature
+
+This makes the four standard bitwise operators (C<& | ^ ~>) treat their
+operands consistently as numbers, and introduces four new dotted operators
+(C<&. |. ^. ~.>) that treat their operands consistently as strings. The
+same applies to the assignment variants (C<&= |= ^= &.= |.= ^.=>).
+
+See L<perlop/Bitwise String Operators> for details.
+
+This feature is available from Perl 5.22 onwards. Starting in Perl 5.28,
+C<use v5.28> will enable the feature. Before 5.28, it was still
+experimental and would emit a warning in the "experimental::bitwise"
+category.
+
+=head2 The 'declared_refs' feature
+
+B<WARNING>: This feature is still experimental and the implementation may
+change or be removed in future versions of Perl. For this reason, Perl will
+warn when you use the feature, unless you have explicitly disabled the warning:
+
+ no warnings "experimental::declared_refs";
+
+This allows a reference to a variable to be declared with C<my>, C<state>,
+our C<our>, or localized with C<local>. It is intended mainly for use in
+conjunction with the "refaliasing" feature. See L<perlref/Declaring a
+Reference to a Variable> for examples.
+
+This feature is available from Perl 5.26 onwards.
+
+=head2 The 'isa' feature
+
+This allows the use of the C<isa> infix operator, which tests whether the
+scalar given by the left operand is an object of the class given by the
+right operand. See L<perlop/Class Instance Operator> for more details.
+
+This feature is available from Perl 5.32 onwards. From Perl 5.32 to 5.34,
+it was classed as experimental, and Perl emitted a warning for its usage,
+except when explicitly disabled:
+
+ no warnings "experimental::isa";
+
+As of Perl 5.36, use of this feature no longer triggers a warning (though the
+C<experimental::isa> warning category stilll exists for compatibility with
+code that disables it).
+
+=head2 The 'indirect' feature
+
+This feature allows the use of L<indirect object
+syntax|perlobj/Indirect Object Syntax> for method calls, e.g. C<new
+Foo 1, 2;>. It is enabled by default, but can be turned off to
+disallow indirect object syntax.
+
+This feature is available under this name from Perl 5.32 onwards. In
+previous versions, it was simply on all the time. To disallow (or
+warn on) indirect object syntax on older Perls, see the L<indirect>
+CPAN module.
+
+=head2 The 'multidimensional' feature
+
+This feature enables multidimensional array emulation, a perl 4 (or
+earlier) feature that was used to emulate multidimensional arrays with
+hashes. This works by converting code like C<< $foo{$x, $y} >> into
+C<< $foo{join($;, $x, $y)} >>. It is enabled by default, but can be
+turned off to disable multidimensional array emulation.
+
+When this feature is disabled the syntax that is normally replaced
+will report a compilation error.
+
+This feature is available under this name from Perl 5.34 onwards. In
+previous versions, it was simply on all the time.
+
+You can use the L<multidimensional> module on CPAN to disable
+multidimensional array emulation for older versions of Perl.
+
+=head2 The 'bareword_filehandles' feature.
+
+This feature enables bareword filehandles for builtin functions
+operations, a generally discouraged practice. It is enabled by
+default, but can be turned off to disable bareword filehandles, except
+for the exceptions listed below.
+
+The perl built-in filehandles C<STDIN>, C<STDOUT>, C<STDERR>, C<DATA>,
+C<ARGV>, C<ARGVOUT> and the special C<_> are always enabled.
+
+This behavior was always present in versions before Perl 5.34. In Perl 5.34,
+it was made controllable with the C<feature> pragma, but was on by default.
+It is not present in the C<:5.36> feature bundle, so C<use v5.36> disables
+this feature.
+
+You can use the L<bareword::filehandles> module on CPAN to disable
+bareword filehandles for older versions of perl.
+
+=head2 The 'try' feature.
+
+B<WARNING>: This feature is still experimental and the implementation may
+change or be removed in future versions of Perl. For this reason, Perl will
+warn when you use the feature, unless you have explicitly disabled the warning:
+
+ no warnings "experimental::try";
+
+This feature enables the C<try> and C<catch> syntax, which allows exception
+handling, where exceptions thrown from the body of the block introduced with
+C<try> are caught by executing the body of the C<catch> block.
+
+For more information, see L<perlsyn/"Try Catch Exception Handling">.
+
+=head2 The 'defer' feature
+
+This feature enables the C<defer> block syntax, which allows a block of code
+to be deferred until when the flow of control leaves the block which contained
+it. For more details, see L<perlsyn/defer>.
+
=head1 FEATURE BUNDLES
It's possible to load multiple features together, using
bundle features included
--------- -----------------
- :default array_base
-
- :5.10 say state switch array_base
-
- :5.12 say state switch unicode_strings array_base
-
- :5.14 say state switch unicode_strings array_base
-
- :5.16 say state switch unicode_strings
- unicode_eval evalbytes current_sub fc
+ :default indirect multidimensional
+ bareword_filehandles
+
+ :5.10 bareword_filehandles indirect
+ multidimensional say state switch
+
+ :5.12 bareword_filehandles indirect
+ multidimensional say state switch
+ unicode_strings
+
+ :5.14 bareword_filehandles indirect
+ multidimensional say state switch
+ unicode_strings
+
+ :5.16 bareword_filehandles current_sub evalbytes
+ fc indirect multidimensional say state
+ switch unicode_eval unicode_strings
+
+ :5.18 bareword_filehandles current_sub evalbytes
+ fc indirect multidimensional say state
+ switch unicode_eval unicode_strings
+
+ :5.20 bareword_filehandles current_sub evalbytes
+ fc indirect multidimensional say state
+ switch unicode_eval unicode_strings
+
+ :5.22 bareword_filehandles current_sub evalbytes
+ fc indirect multidimensional say state
+ switch unicode_eval unicode_strings
+
+ :5.24 bareword_filehandles current_sub evalbytes
+ fc indirect multidimensional postderef_qq
+ say state switch unicode_eval
+ unicode_strings
+
+ :5.26 bareword_filehandles current_sub evalbytes
+ fc indirect multidimensional postderef_qq
+ say state switch unicode_eval
+ unicode_strings
+
+ :5.28 bareword_filehandles bitwise current_sub
+ evalbytes fc indirect multidimensional
+ postderef_qq say state switch unicode_eval
+ unicode_strings
+
+ :5.30 bareword_filehandles bitwise current_sub
+ evalbytes fc indirect multidimensional
+ postderef_qq say state switch unicode_eval
+ unicode_strings
+
+ :5.32 bareword_filehandles bitwise current_sub
+ evalbytes fc indirect multidimensional
+ postderef_qq say state switch unicode_eval
+ unicode_strings
+
+ :5.34 bareword_filehandles bitwise current_sub
+ evalbytes fc indirect multidimensional
+ postderef_qq say state switch unicode_eval
+ unicode_strings
+
+ :5.36 bitwise current_sub evalbytes fc
+ postderef_qq say state unicode_eval
+ unicode_strings
The C<:default> bundle represents the feature set that is enabled before
any C<use feature> or C<no feature> declaration.
If the required version is older than Perl 5.10, the ":default" feature
bundle is automatically loaded instead.
+Unlike C<use feature ":5.12">, saying C<use v5.12> (or any higher version)
+also does the equivalent of C<use strict>; see L<perlfunc/use> for details.
+
=back
-=cut
+=head1 CHECKING FEATURES
-sub current_bundle {
- my $bundle_number = $^H & $hint_mask;
- return if $bundle_number == $hint_mask;
- return $feature_bundle{@hint_bundles[$bundle_number >> $hint_shift]};
-}
+C<feature> provides some simple APIs to check which features are enabled.
-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';
- }
-}
+These functions cannot be imported and must be called by their fully
+qualified names. If you don't otherwise need to set a feature you will
+need to ensure C<feature> is loaded with:
+
+ use feature ();
+
+=over
+
+=item feature_enabled($feature)
+
+=item feature_enabled($feature, $depth)
+
+ package MyStandardEnforcer;
+ use feature ();
+ use Carp "croak";
+ sub import {
+ croak "disable indirect!" if feature::feature_enabled("indirect");
+ }
+
+Test whether a named feature is enabled at a given level in the call
+stack, returning a true value if it is. C<$depth> defaults to 1,
+which checks the scope that called the scope calling
+feature::feature_enabled().
+
+croaks for an unknown feature name.
+
+=item features_enabled()
+
+=item features_enabled($depth)
+
+ package ReportEnabledFeatures;
+ use feature "say";
+ sub import {
+ say STDERR join " ", feature::features_enabled();
+ }
+
+Returns a list of the features enabled at a given level in the call
+stack. C<$depth> defaults to 1, which checks the scope that called
+the scope calling feature::features_enabled().
+
+=item feature_bundle()
+
+=item feature_bundle($depth)
+
+Returns the feature bundle, if any, selected at a given level in the
+call stack. C<$depth> defaults to 1, which checks the scope that called
+the scope calling feature::feature_bundle().
+
+Returns an undefined value if no feature bundle is selected in the
+scope.
+
+The bundle name returned will be for the earliest bundle matching the
+selected bundle, so:
+
+ use feature ();
+ use v5.12;
+ BEGIN { print feature::feature_bundle(0); }
+
+will print C<5.11>.
+
+This returns internal state, at this point C<use v5.12;> sets the
+feature bundle, but C< use feature ":5.12"; > does not set the feature
+bundle. This may change in a future release of perl.
+
+=back
+
+=cut
sub import {
- my $class = shift;
- if (@_ == 0) {
+ shift;
+
+ 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 {
- my $class = shift;
-
- if (my $features = current_bundle) {
- # Features are enabled implicitly via bundle hints.
- normalise_hints $features;
- }
+ shift;
# A bare C<no feature> should reset to the default bundle
if (!@_) {
return;
}
+ __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.
+ # 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 ":") {
unshift @_, @{$feature_bundle{$v}};
next;
}
- if (!exists($feature{$name})) {
+ if (!exists $feature{$name}) {
+ if (exists $noops{$name}) {
+ next;
+ }
+ if (!$import && exists $removed{$name}) {
+ next;
+ }
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';
}
Carp::croak(@_);
}
+sub features_enabled {
+ my ($depth) = @_;
+
+ $depth //= 1;
+ my @frame = caller($depth+1)
+ or return;
+ my ($hints, $hinthash) = @frame[8, 10];
+
+ my $bundle_number = $hints & $hint_mask;
+ if ($bundle_number != $hint_mask) {
+ return $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]}->@*;
+ }
+ else {
+ my @features;
+ for my $feature (sort keys %feature) {
+ if ($hinthash->{$feature{$feature}}) {
+ push @features, $feature;
+ }
+ }
+ return @features;
+ }
+}
+
+sub feature_enabled {
+ my ($feature, $depth) = @_;
+
+ $depth //= 1;
+ my @frame = caller($depth+1)
+ or return;
+ my ($hints, $hinthash) = @frame[8, 10];
+
+ my $hint_feature = $feature{$feature}
+ or croak "Unknown feature $feature";
+ my $bundle_number = $hints & $hint_mask;
+ if ($bundle_number != $hint_mask) {
+ my $bundle = $hint_bundles[$bundle_number >> $hint_shift];
+ for my $bundle_feature ($feature_bundle{$bundle}->@*) {
+ return 1 if $bundle_feature eq $feature;
+ }
+ return 0;
+ }
+ else {
+ return $hinthash->{$hint_feature} // 0;
+ }
+}
+
+sub feature_bundle {
+ my $depth = shift;
+
+ $depth //= 1;
+ my @frame = caller($depth+1)
+ or return;
+ my $bundle_number = $frame[8] & $hint_mask;
+ if ($bundle_number != $hint_mask) {
+ return $hint_bundles[$bundle_number >> $hint_shift];
+ }
+ else {
+ return undef;
+ }
+}
+
1;
# ex: set ro:
https://perl5.git.perl.org / perl5.git / blobdiff