# -*- buffer-read-only: t -*-
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file is built by regen/feature.pl.
# Any changes made here will be lost!

package feature;

our $VERSION = '1.32';

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__',
lexical_subs => 'feature_lexsubs',
unicode_eval => 'feature_unieval',
unicode_strings => 'feature_unicode',
);

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 lexical_subs say state switch unicode_eval unicode_strings)],
"default" => [qw(array_base)],
);

$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.9.5"} = $feature_bundle{"5.10"};

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.
# See HINT_UNI_8_BIT in perl.h.
our $hint_uni8bit = 0x00000800;

# TODO:
# - think about versioned features (use feature switch => 2)

sub import {
my $class = shift;

if (!@_) {
croak("No features specified");
}

__common(1, @_);
}

sub unimport {
my $class = shift;

# A bare C<no feature> should reset to the default bundle
if (!@_) {
$^H &= ~($hint_uni8bit|$hint_mask);
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 ":") {
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);
}
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';
}
}
}

sub unknown_feature {
my $feature = shift;
croak(sprintf('Feature "%s" is not supported by Perl %vd',
$feature, $^V));
}

sub unknown_feature_bundle {
my $feature = shift;
croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
$feature, $^V));
}

sub croak {
require Carp;
Carp::croak(@_);
}

1;

# ex: set ro: