diff perl-5.22.2/regen/feature.pl @ 8045:a16537d2fe07

<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author HackBot
date Sat, 14 May 2016 14:54:38 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/perl-5.22.2/regen/feature.pl	Sat May 14 14:54:38 2016 +0000
@@ -0,0 +1,803 @@
+#!/usr/bin/perl
+# 
+# Regenerate (overwriting only if changed):
+#
+#    lib/feature.pm
+#    feature.h
+#
+# from information hardcoded into this script and from two #defines
+# in perl.h.
+#
+# This script is normally invoked from regen.pl.
+
+BEGIN {
+    require 'regen/regen_lib.pl';
+    push @INC, './lib';
+}
+use strict ;
+
+
+###########################################################################
+# Hand-editable data
+
+# (feature name) => (internal name, used in %^H and macro names)
+my %feature = (
+    say             => 'say',
+    state           => 'state',
+    switch          => 'switch',
+    bitwise         => 'bitwise',
+    evalbytes       => 'evalbytes',
+    postderef       => 'postderef',
+    array_base      => 'arybase',
+    current_sub     => '__SUB__',
+    refaliasing     => 'refaliasing',
+    lexical_subs    => 'lexsubs',
+    postderef_qq    => 'postderef_qq',
+    unicode_eval    => 'unieval',
+    unicode_strings => 'unicode',
+    fc              => 'fc',
+    signatures      => 'signatures',
+);
+
+# NOTE: If a feature is ever enabled in a non-contiguous range of Perl
+#       versions, any code below that uses %BundleRanges will have to
+#       be changed to account.
+
+# 5.odd implies the next 5.even, but an explicit 5.even can override it.
+my %feature_bundle = (
+     all     => [ keys %feature ],
+     default =>	[qw(array_base)],
+    "5.9.5"  =>	[qw(say state switch array_base)],
+    "5.10"   =>	[qw(say state switch array_base)],
+    "5.11"   =>	[qw(say state switch unicode_strings array_base)],
+    "5.13"   =>	[qw(say state switch unicode_strings array_base)],
+    "5.15"   =>	[qw(say state switch unicode_strings unicode_eval
+		    evalbytes current_sub fc)],
+    "5.17"   =>	[qw(say state switch unicode_strings unicode_eval
+		    evalbytes current_sub fc)],
+    "5.19"   =>	[qw(say state switch unicode_strings unicode_eval
+		    evalbytes current_sub fc)],
+    "5.21"   =>	[qw(say state switch unicode_strings unicode_eval
+		    evalbytes current_sub fc)],
+);
+
+# not actually used currently
+my @experimental = qw( lexical_subs );
+
+
+###########################################################################
+# More data generated from the above
+
+for (keys %feature_bundle) {
+    next unless /^5\.(\d*[13579])\z/;
+    $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
+}
+
+my %UniqueBundles; # "say state switch" => 5.10
+my %Aliases;       #  5.12 => 5.11
+for( sort keys %feature_bundle ) {
+    my $value = join(' ', sort @{$feature_bundle{$_}});
+    if (exists $UniqueBundles{$value}) {
+	$Aliases{$_} = $UniqueBundles{$value};
+    }
+    else {
+	$UniqueBundles{$value} = $_;
+    }
+}
+			   # start   end
+my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
+for my $bund (
+    sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
+         values %UniqueBundles
+) {
+    next if $bund =~ /[^\d.]/ and $bund ne 'default';
+    for (@{$feature_bundle{$bund}}) {
+	if (@{$BundleRanges{$_} ||= []} == 2) {
+	    $BundleRanges{$_}[1] = $bund
+	}
+	else {
+	    push @{$BundleRanges{$_}}, $bund;
+	}
+    }
+}
+
+my $HintShift;
+my $HintMask;
+my $Uni8Bit;
+
+open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!";
+while (readline "perl.h") {
+    next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
+    my $is_u8b = $1 =~ 8;
+    /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
+    if ($is_u8b) {
+	$Uni8Bit = $1;
+    }
+    else {
+	my $hex = $HintMask = $1;
+	my $bits = sprintf "%b", oct $1;
+	$bits =~ /^0*1+(0*)\z/
+	 or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
+	$HintShift = length $1;
+	my $bits_needed =
+	    length sprintf "%b", scalar keys %UniqueBundles;
+	$bits =~ /1{$bits_needed}/
+	    or die "Not enough bits (need $bits_needed)"
+		 . " in $bits (binary for $hex):\n\n$_\n ";
+    }
+    if ($Uni8Bit && $HintMask) { last }
+}
+die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
+die "No HINT_UNI_8_BIT defined in perl.h"    unless $Uni8Bit;
+
+close "perl.h";
+
+my @HintedBundles =
+    ('default', grep !/[^\d.]/, sort values %UniqueBundles);
+
+
+###########################################################################
+# Open files to be generated
+
+my ($pm, $h) = map {
+    open_new($_, '>', { by => 'regen/feature.pl' });
+} 'lib/feature.pm', 'feature.h';
+
+
+###########################################################################
+# Generate lib/feature.pm
+
+while (<DATA>) {
+    last if /^FEATURES$/ ;
+    print $pm $_ ;
+}
+
+sub longest {
+    my $long;
+    for(@_) {
+	if (!defined $long or length $long < length) {
+	    $long = $_;
+	}
+    }
+    $long;
+}
+
+print $pm "our %feature = (\n";
+my $width = length longest keys %feature;
+for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
+    print $pm "    $_" . " "x($width-length)
+	    . " => 'feature_$feature{$_}',\n";
+}
+print $pm ");\n\n";
+
+print $pm "our %feature_bundle = (\n";
+$width = length longest values %UniqueBundles;
+for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
+          keys %UniqueBundles ) {
+    my $bund = $UniqueBundles{$_};
+    print $pm qq'    "$bund"' . " "x($width-length $bund)
+	    . qq' => [qw($_)],\n';
+}
+print $pm ");\n\n";
+
+for (sort keys %Aliases) {
+    print $pm
+	qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
+};
+
+#print $pm "my \%experimental = (\n";
+#print $pm "    $_ => 1,\n", for @experimental;
+#print $pm ");\n";
+
+print $pm <<EOPM;
+
+our \$hint_shift   = $HintShift;
+our \$hint_mask    = $HintMask;
+our \@hint_bundles = qw( @HintedBundles );
+
+# 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 = $Uni8Bit;
+EOPM
+
+
+while (<DATA>) {
+    last if /^PODTURES$/ ;
+    print $pm $_ ;
+}
+
+select +(select($pm), $~ = 'PODTURES')[0];
+format PODTURES =
+  ^<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
+$::bundle, $::feature
+.
+
+for ('default', sort grep /\.\d[02468]/, keys %feature_bundle) {
+    $::bundle = ":$_";
+    $::feature = join ' ', @{$feature_bundle{$_}};
+    write $pm;
+    print $pm "\n";
+}
+
+while (<DATA>) {
+    print $pm $_ ;
+}
+
+read_only_bottom_close_and_rename($pm);
+
+
+###########################################################################
+# Generate feature.h
+
+print $h <<EOH;
+
+#if defined(PERL_CORE) || defined (PERL_EXT)
+
+#define HINT_FEATURE_SHIFT	$HintShift
+
+EOH
+
+my $count;
+for (@HintedBundles) {
+    (my $key = uc) =~ y/.//d;
+    print $h "#define FEATURE_BUNDLE_$key	", $count++, "\n";
+}
+
+print $h <<'EOH';
+#define FEATURE_BUNDLE_CUSTOM	(HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
+
+#define CURRENT_HINTS \
+    (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
+#define CURRENT_FEATURE_BUNDLE \
+    ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
+
+/* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
+   the HP-UX cc on PA-RISC */
+#define FEATURE_IS_ENABLED(name)				        \
+	((CURRENT_HINTS							 \
+	   & HINT_LOCALIZE_HH)						  \
+	    ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
+/* The longest string we pass in.  */
+EOH
+
+my $longest_internal_feature_name = longest values %feature;
+print $h <<EOL;
+#define MAX_FEATURE_LEN (sizeof("$longest_internal_feature_name")-1)
+
+EOL
+
+for (
+    sort { length $a <=> length $b || $a cmp $b } keys %feature
+) {
+    my($first,$last) =
+	map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
+    my $name = $feature{$_};
+    my $NAME = uc $name;
+    if ($last && $first eq 'DEFAULT') { #  ‘>= DEFAULT’ warns
+	print $h <<EOI;
+#define FEATURE_$NAME\_IS_ENABLED \\
+    ( \\
+	CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
+     || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
+	 FEATURE_IS_ENABLED("$name")) \\
+    )
+
+EOI
+    }
+    elsif ($last) {
+	print $h <<EOH3;
+#define FEATURE_$NAME\_IS_ENABLED \\
+    ( \\
+	(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
+	 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
+     || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
+	 FEATURE_IS_ENABLED("$name")) \\
+    )
+
+EOH3
+    }
+    elsif ($first) {
+	print $h <<EOH4;
+#define FEATURE_$NAME\_IS_ENABLED \\
+    ( \\
+	CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
+     || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
+	 FEATURE_IS_ENABLED("$name")) \\
+    )
+
+EOH4
+    }
+    else {
+	print $h <<EOH5;
+#define FEATURE_$NAME\_IS_ENABLED \\
+    ( \\
+	CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
+	 FEATURE_IS_ENABLED("$name") \\
+    )
+
+EOH5
+    }
+}
+
+print $h <<EOH;
+
+#endif /* PERL_CORE or PERL_EXT */
+
+#ifdef PERL_IN_OP_C
+PERL_STATIC_INLINE void
+S_enable_feature_bundle(pTHX_ SV *ver)
+{
+    SV *comp_ver = sv_newmortal();
+    PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
+	     | (
+EOH
+
+for (reverse @HintedBundles[1..$#HintedBundles]) { # skip default
+    my $numver = $_;
+    if ($numver eq '5.10') { $numver = '5.009005' } # special case
+    else		   { $numver =~ s/\./.0/  } # 5.11 => 5.011
+    (my $macrover = $_) =~ y/.//d;
+    print $h <<"    EOK";
+		  (sv_setnv(comp_ver, $numver),
+		   vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
+			? FEATURE_BUNDLE_$macrover :
+    EOK
+}
+
+print $h <<EOJ;
+			  FEATURE_BUNDLE_DEFAULT
+	       ) << HINT_FEATURE_SHIFT;
+    /* special case */
+    assert(PL_curcop == &PL_compiling);
+    if (FEATURE_UNICODE_IS_ENABLED) PL_hints |=  HINT_UNI_8_BIT;
+    else			    PL_hints &= ~HINT_UNI_8_BIT;
+}
+#endif /* PERL_IN_OP_C */
+EOJ
+
+read_only_bottom_close_and_rename($h);
+
+
+###########################################################################
+# Template for feature.pm
+
+__END__
+package feature;
+
+our $VERSION = '1.40';
+
+FEATURES
+
+# TODO:
+# - think about versioned features (use feature switch => 2)
+
+=head1 NAME
+
+feature - Perl pragma to enable new features
+
+=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 ':5.10'; # loads all features available in perl 5.10
+
+    use v5.10;           # implicitly loads :5.10 feature bundle
+
+=head1 DESCRIPTION
+
+It is usually impossible to add new syntax to Perl without breaking
+some existing programs.  This pragma provides a way to minimize that
+risk. New syntactic constructs, or new semantic meanings to older
+constructs, can be enabled by C<use feature 'foo'>, and will be parsed
+only when the appropriate feature pragma is in scope.  (Nevertheless, the
+C<CORE::> prefix provides access to all Perl keywords, regardless of this
+pragma.)
+
+=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
+from that point to the end of the enclosing block.
+
+    {
+        use feature 'say';
+        say "say is available here";
+    }
+    print "But not here.\n";
+
+=head2 C<no feature>
+
+Features can also be turned off by using C<no feature "foo">.  This too
+has lexical effect.
+
+    use feature 'say';
+    say "say is available here";
+    {
+        no feature 'say';
+        print "But not here.\n";
+    }
+    say "Yet it is here.";
+
+C<no feature> with no features specified will reset to the default group.  To
+disable I<all> features (an unusual request!) use C<no feature ':all'>.
+
+=head1 AVAILABLE FEATURES
+
+=head2 The 'say' feature
+
+C<use feature 'say'> tells the compiler to enable the Perl 6 style
+C<say> function.
+
+See L<perlfunc/say> for details.
+
+This feature is available starting with Perl 5.10.
+
+=head2 The 'state' feature
+
+C<use feature 'state'> tells the compiler to enable C<state>
+variables.
+
+See L<perlsub/"Persistent Private Variables"> for details.
+
+This feature is available starting with Perl 5.10.
+
+=head2 The 'switch' feature
+
+B<WARNING>: Because the L<smartmatch operator|perlop/"Smartmatch Operator"> is
+experimental, Perl will warn when you use this feature, unless you have
+explicitly disabled the warning:
+
+    no warnings "experimental::smartmatch";
+
+C<use feature 'switch'> tells the compiler to enable the Perl 6
+given/when construct.
+
+See L<perlsyn/"Switch Statements"> for details.
+
+This feature is available starting with Perl 5.10.
+
+=head2 The 'unicode_strings' feature
+
+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 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 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
+potentially using Unicode in your program, the
+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>.
+
+=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:
+
+=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 *
+
+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.
+
+=head2 The 'current_sub' feature
+
+This provides the C<__SUB__> token that returns a reference to the current
+subroutine or C<undef> outside of a subroutine.
+
+This feature is available starting with Perl 5.16.
+
+=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 is available under this name starting with Perl 5.16.  In
+previous versions, it was simply on all the time, and this pragma knew
+nothing about it.
+
+=head2 The 'fc' feature
+
+C<use feature 'fc'> tells the compiler to enable the C<fc> function,
+which implements Unicode casefolding.
+
+See L<perlfunc/fc> for details.
+
+This feature is available from Perl 5.16 onwards.
+
+=head2 The 'lexical_subs' feature
+
+B<WARNING>: This feature is still experimental and the implementation may
+change 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::lexical_subs";
+
+This enables 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.
+
+=head2 The 'postderef' and 'postderef_qq' features
+
+B<WARNING>: This feature is still experimental and the implementation may
+change 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::postderef";
+
+The 'postderef' feature allows the use of L<postfix dereference
+syntax|perlref/Postfix Dereference Syntax>.  For example, it will make the
+following two statements equivalent:
+
+  my @x = @{ $h->{a} };
+  my @x = $h->{a}->@*;
+
+The 'postderef_qq' feature extends this, for array and scalar dereference, to
+working inside of double-quotish interpolations.
+
+This feature is available from Perl 5.20 onwards.
+
+=head2 The 'signatures' feature
+
+B<WARNING>: This feature is still experimental and the implementation may
+change 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 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
+
+B<WARNING>: This feature is still experimental and the implementation may
+change 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::bitwise";
+
+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.
+
+=head1 FEATURE BUNDLES
+
+It's possible to load multiple features together, using
+a I<feature bundle>.  The name of a feature bundle is prefixed with
+a colon, to distinguish it from an actual feature.
+
+  use feature ":5.10";
+
+The following feature bundles are available:
+
+  bundle    features included
+  --------- -----------------
+PODTURES
+The C<:default> bundle represents the feature set that is enabled before
+any C<use feature> or C<no feature> declaration.
+
+Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
+no effect.  Feature bundles are guaranteed to be the same for all sub-versions.
+
+  use feature ":5.14.0";    # same as ":5.14"
+  use feature ":5.14.1";    # same as ":5.14"
+
+=head1 IMPLICIT LOADING
+
+Instead of loading feature bundles by name, it is easier to let Perl do
+implicit loading of a feature bundle for you.
+
+There are two ways to load the C<feature> pragma implicitly:
+
+=over 4
+
+=item *
+
+By using the C<-E> switch on the Perl command-line instead of C<-e>.
+That will enable the feature bundle for that version of Perl in the
+main compilation unit (that is, the one-liner that follows C<-E>).
+
+=item *
+
+By explicitly requiring a minimum Perl version number for your program, with
+the C<use VERSION> construct.  That is,
+
+    use v5.10.0;
+
+will do an implicit
+
+    no feature ':all';
+    use feature ':5.10';
+
+and so on.  Note how the trailing sub-version
+is automatically stripped from the
+version.
+
+But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
+
+    use 5.010;
+
+with the same effect.
+
+If the required version is older than Perl 5.10, the ":default" feature
+bundle is automatically loaded instead.
+
+=back
+
+=cut
+
+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;