regen/feature.pl

   1 #!/usr/bin/perl
   2 #
   3 # Regenerate (overwriting only if changed):
   4 #
   5 #    lib/feature.pm
   6 #    feature.h
   7 #
   8 # from information hardcoded into this script and from two #defines
   9 # in perl.h.
  10 #
  11 # This script is normally invoked from regen.pl.
  12
  13 BEGIN {
  14     require 'regen/regen_lib.pl';
  15     push @INC, './lib';
  16 }
  17 use strict ;
  18
  19
  20 ###########################################################################
  21 # Hand-editable data
  22
  23 # (feature name) => (internal name, used in %^H and macro names)
  24 my %feature = (
  25     say             => 'say',
  26     state           => 'state',
  27     switch          => 'switch',
  28     evalbytes       => 'evalbytes',
  29     postderef       => 'postderef',
  30     array_base      => 'arybase',
  31     current_sub     => '__SUB__',
  32     lexical_subs    => 'lexsubs',
  33     postderef_qq    => 'postderef_qq',
  34     unicode_eval    => 'unieval',
  35     unicode_strings => 'unicode',
  36     fc              => 'fc',
  37     signatures      => 'signatures',
  38 );
  39
  40 # NOTE: If a feature is ever enabled in a non-contiguous range of Perl
  41 #       versions, any code below that uses %BundleRanges will have to
  42 #       be changed to account.
  43
  44 # 5.odd implies the next 5.even, but an explicit 5.even can override it.
  45 my %feature_bundle = (
  46      all     => [ keys %feature ],
  47      default => [qw(array_base)],
  48     "5.9.5"  => [qw(say state switch array_base)],
  49     "5.10"   => [qw(say state switch array_base)],
  50     "5.11"   => [qw(say state switch unicode_strings array_base)],
  51     "5.13"   => [qw(say state switch unicode_strings array_base)],
  52     "5.15"   => [qw(say state switch unicode_strings unicode_eval
  53                     evalbytes current_sub fc)],
  54     "5.17"   => [qw(say state switch unicode_strings unicode_eval
  55                     evalbytes current_sub fc)],
  56     "5.19"   => [qw(say state switch unicode_strings unicode_eval
  57                     evalbytes current_sub fc)],
  58     "5.21"   => [qw(say state switch unicode_strings unicode_eval
  59                     evalbytes current_sub fc)],
  60 );
  61
  62 # not actually used currently
  63 my @experimental = qw( lexical_subs );
  64
  65
  66 ###########################################################################
  67 # More data generated from the above
  68
  69 for (keys %feature_bundle) {
  70     next unless /^5\.(\d*[13579])\z/;
  71     $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
  72 }
  73
  74 my %UniqueBundles; # "say state switch" => 5.10
  75 my %Aliases;       #  5.12 => 5.11
  76 for( sort keys %feature_bundle ) {
  77     my $value = join(' ', sort @{$feature_bundle{$_}});
  78     if (exists $UniqueBundles{$value}) {
  79         $Aliases{$_} = $UniqueBundles{$value};
  80     }
  81     else {
  82         $UniqueBundles{$value} = $_;
  83     }
  84 }
  85                            # start   end
  86 my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
  87 for my $bund (
  88     sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
  89          values %UniqueBundles
  90 ) {
  91     next if $bund =~ /[^\d.]/ and $bund ne 'default';
  92     for (@{$feature_bundle{$bund}}) {
  93         if (@{$BundleRanges{$_} ||= []} == 2) {
  94             $BundleRanges{$_}[1] = $bund
  95         }
  96         else {
  97             push @{$BundleRanges{$_}}, $bund;
  98         }
  99     }
 100 }
 101
 102 my $HintShift;
 103 my $HintMask;
 104 my $Uni8Bit;
 105
 106 open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!";
 107 while (readline "perl.h") {
 108     next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
 109     my $is_u8b = $1 =~ 8;
 110     /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
 111     if ($is_u8b) {
 112         $Uni8Bit = $1;
 113     }
 114     else {
 115         my $hex = $HintMask = $1;
 116         my $bits = sprintf "%b", oct $1;
 117         $bits =~ /^0*1+(0*)\z/
 118          or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
 119         $HintShift = length $1;
 120         my $bits_needed =
 121             length sprintf "%b", scalar keys %UniqueBundles;
 122         $bits =~ /1{$bits_needed}/
 123             or die "Not enough bits (need $bits_needed)"
 124                  . " in $bits (binary for $hex):\n\n$_\n ";
 125     }
 126     if ($Uni8Bit && $HintMask) { last }
 127 }
 128 die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
 129 die "No HINT_UNI_8_BIT defined in perl.h"    unless $Uni8Bit;
 130
 131 close "perl.h";
 132
 133 my @HintedBundles =
 134     ('default', grep !/[^\d.]/, sort values %UniqueBundles);
 135
 136
 137 ###########################################################################
 138 # Open files to be generated
 139
 140 my ($pm, $h) = map {
 141     open_new($_, '>', { by => 'regen/feature.pl' });
 142 } 'lib/feature.pm', 'feature.h';
 143
 144
 145 ###########################################################################
 146 # Generate lib/feature.pm
 147
 148 while (<DATA>) {
 149     last if /^FEATURES$/ ;
 150     print $pm $_ ;
 151 }
 152
 153 sub longest {
 154     my $long;
 155     for(@_) {
 156         if (!defined $long or length $long < length) {
 157             $long = $_;
 158         }
 159     }
 160     $long;
 161 }
 162
 163 print $pm "our %feature = (\n";
 164 my $width = length longest keys %feature;
 165 for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
 166     print $pm "    $_" . " "x($width-length)
 167             . " => 'feature_$feature{$_}',\n";
 168 }
 169 print $pm ");\n\n";
 170
 171 print $pm "our %feature_bundle = (\n";
 172 $width = length longest values %UniqueBundles;
 173 for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
 174           keys %UniqueBundles ) {
 175     my $bund = $UniqueBundles{$_};
 176     print $pm qq'    "$bund"' . " "x($width-length $bund)
 177             . qq' => [qw($_)],\n';
 178 }
 179 print $pm ");\n\n";
 180
 181 for (sort keys %Aliases) {
 182     print $pm
 183         qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
 184 };
 185
 186 #print $pm "my \%experimental = (\n";
 187 #print $pm "    $_ => 1,\n", for @experimental;
 188 #print $pm ");\n";
 189
 190 print $pm <<EOPM;
 191
 192 our \$hint_shift   = $HintShift;
 193 our \$hint_mask    = $HintMask;
 194 our \@hint_bundles = qw( @HintedBundles );
 195
 196 # This gets set (for now) in \$^H as well as in %^H,
 197 # for runtime speed of the uc/lc/ucfirst/lcfirst functions.
 198 # See HINT_UNI_8_BIT in perl.h.
 199 our \$hint_uni8bit = $Uni8Bit;
 200 EOPM
 201
 202
 203 while (<DATA>) {
 204     last if /^PODTURES$/ ;
 205     print $pm $_ ;
 206 }
 207
 208 select +(select($pm), $~ = 'PODTURES')[0];
 209 format PODTURES =
 210   ^<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
 211 $::bundle, $::feature
 212 .
 213
 214 for ('default', sort grep /\.\d[02468]/, keys %feature_bundle) {
 215     $::bundle = ":$_";
 216     $::feature = join ' ', @{$feature_bundle{$_}};
 217     write $pm;
 218     print $pm "\n";
 219 }
 220
 221 while (<DATA>) {
 222     print $pm $_ ;
 223 }
 224
 225 read_only_bottom_close_and_rename($pm);
 226
 227
 228 ###########################################################################
 229 # Generate feature.h
 230
 231 print $h <<EOH;
 232
 233 #if defined(PERL_CORE) || defined (PERL_EXT)
 234
 235 #define HINT_FEATURE_SHIFT      $HintShift
 236
 237 EOH
 238
 239 my $count;
 240 for (@HintedBundles) {
 241     (my $key = uc) =~ y/.//d;
 242     print $h "#define FEATURE_BUNDLE_$key       ", $count++, "\n";
 243 }
 244
 245 print $h <<'EOH';
 246 #define FEATURE_BUNDLE_CUSTOM   (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
 247
 248 #define CURRENT_HINTS \
 249     (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
 250 #define CURRENT_FEATURE_BUNDLE \
 251     ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
 252
 253 /* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
 254    the HP-UX cc on PA-RISC */
 255 #define FEATURE_IS_ENABLED(name)                                        \
 256         ((CURRENT_HINTS                                                  \
 257            & HINT_LOCALIZE_HH)                                            \
 258             ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
 259 /* The longest string we pass in.  */
 260 EOH
 261
 262 my $longest_internal_feature_name = longest values %feature;
 263 print $h <<EOL;
 264 #define MAX_FEATURE_LEN (sizeof("$longest_internal_feature_name")-1)
 265
 266 EOL
 267
 268 for (
 269     sort { length $a <=> length $b || $a cmp $b } keys %feature
 270 ) {
 271     my($first,$last) =
 272         map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
 273     my $name = $feature{$_};
 274     my $NAME = uc $name;
 275     if ($last && $first eq 'DEFAULT') { #  ‘>= DEFAULT’ warns
 276         print $h <<EOI;
 277 #define FEATURE_$NAME\_IS_ENABLED \\
 278     ( \\
 279         CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
 280      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
 281          FEATURE_IS_ENABLED("$name")) \\
 282     )
 283
 284 EOI
 285     }
 286     elsif ($last) {
 287         print $h <<EOH3;
 288 #define FEATURE_$NAME\_IS_ENABLED \\
 289     ( \\
 290         (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
 291          CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
 292      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
 293          FEATURE_IS_ENABLED("$name")) \\
 294     )
 295
 296 EOH3
 297     }
 298     elsif ($first) {
 299         print $h <<EOH4;
 300 #define FEATURE_$NAME\_IS_ENABLED \\
 301     ( \\
 302         CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
 303      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
 304          FEATURE_IS_ENABLED("$name")) \\
 305     )
 306
 307 EOH4
 308     }
 309     else {
 310         print $h <<EOH5;
 311 #define FEATURE_$NAME\_IS_ENABLED \\
 312     ( \\
 313         CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
 314          FEATURE_IS_ENABLED("$name") \\
 315     )
 316
 317 EOH5
 318     }
 319 }
 320
 321 print $h <<EOH;
 322
 323 #endif /* PERL_CORE or PERL_EXT */
 324
 325 #ifdef PERL_IN_OP_C
 326 PERL_STATIC_INLINE void
 327 S_enable_feature_bundle(pTHX_ SV *ver)
 328 {
 329     SV *comp_ver = sv_newmortal();
 330     PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
 331              | (
 332 EOH
 333
 334 for (reverse @HintedBundles[1..$#HintedBundles]) { # skip default
 335     my $numver = $_;
 336     if ($numver eq '5.10') { $numver = '5.009005' } # special case
 337     else                   { $numver =~ s/\./.0/  } # 5.11 => 5.011
 338     (my $macrover = $_) =~ y/.//d;
 339     print $h <<"    EOK";
 340                   (sv_setnv(comp_ver, $numver),
 341                    vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
 342                         ? FEATURE_BUNDLE_$macrover :
 343     EOK
 344 }
 345
 346 print $h <<EOJ;
 347                           FEATURE_BUNDLE_DEFAULT
 348                ) << HINT_FEATURE_SHIFT;
 349     /* special case */
 350     assert(PL_curcop == &PL_compiling);
 351     if (FEATURE_UNICODE_IS_ENABLED) PL_hints |=  HINT_UNI_8_BIT;
 352     else                            PL_hints &= ~HINT_UNI_8_BIT;
 353 }
 354 #endif /* PERL_IN_OP_C */
 355 EOJ
 356
 357 read_only_bottom_close_and_rename($h);
 358
 359
 360 ###########################################################################
 361 # Template for feature.pm
 362
 363 __END__
 364 package feature;
 365
 366 our $VERSION = '1.37';
 367
 368 FEATURES
 369
 370 # TODO:
 371 # - think about versioned features (use feature switch => 2)
 372
 373 =head1 NAME
 374
 375 feature - Perl pragma to enable new features
 376
 377 =head1 SYNOPSIS
 378
 379     use feature qw(say switch);
 380     given ($foo) {
 381         when (1)          { say "\$foo == 1" }
 382         when ([2,3])      { say "\$foo == 2 || \$foo == 3" }
 383         when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
 384         when ($_ > 100)   { say "\$foo > 100" }
 385         default           { say "None of the above" }
 386     }
 387
 388     use feature ':5.10'; # loads all features available in perl 5.10
 389
 390     use v5.10;           # implicitly loads :5.10 feature bundle
 391
 392 =head1 DESCRIPTION
 393
 394 It is usually impossible to add new syntax to Perl without breaking
 395 some existing programs.  This pragma provides a way to minimize that
 396 risk. New syntactic constructs, or new semantic meanings to older
 397 constructs, can be enabled by C<use feature 'foo'>, and will be parsed
 398 only when the appropriate feature pragma is in scope.  (Nevertheless, the
 399 C<CORE::> prefix provides access to all Perl keywords, regardless of this
 400 pragma.)
 401
 402 =head2 Lexical effect
 403
 404 Like other pragmas (C<use strict>, for example), features have a lexical
 405 effect.  C<use feature qw(foo)> will only make the feature "foo" available
 406 from that point to the end of the enclosing block.
 407
 408     {
 409         use feature 'say';
 410         say "say is available here";
 411     }
 412     print "But not here.\n";
 413
 414 =head2 C<no feature>
 415
 416 Features can also be turned off by using C<no feature "foo">.  This too
 417 has lexical effect.
 418
 419     use feature 'say';
 420     say "say is available here";
 421     {
 422         no feature 'say';
 423         print "But not here.\n";
 424     }
 425     say "Yet it is here.";
 426
 427 C<no feature> with no features specified will reset to the default group.  To
 428 disable I<all> features (an unusual request!) use C<no feature ':all'>.
 429
 430 =head1 AVAILABLE FEATURES
 431
 432 =head2 The 'say' feature
 433
 434 C<use feature 'say'> tells the compiler to enable the Perl 6 style
 435 C<say> function.
 436
 437 See L<perlfunc/say> for details.
 438
 439 This feature is available starting with Perl 5.10.
 440
 441 =head2 The 'state' feature
 442
 443 C<use feature 'state'> tells the compiler to enable C<state>
 444 variables.
 445
 446 See L<perlsub/"Persistent Private Variables"> for details.
 447
 448 This feature is available starting with Perl 5.10.
 449
 450 =head2 The 'switch' feature
 451
 452 C<use feature 'switch'> tells the compiler to enable the Perl 6
 453 given/when construct.
 454
 455 See L<perlsyn/"Switch Statements"> for details.
 456
 457 This feature is available starting with Perl 5.10.
 458
 459 =head2 The 'unicode_strings' feature
 460
 461 C<use feature 'unicode_strings'> tells the compiler to use Unicode rules
 462 in all string operations executed within its scope (unless they are also
 463 within the scope of either C<use locale> or C<use bytes>).  The same applies
 464 to all regular expressions compiled within the scope, even if executed outside
 465 it.  It does not change the internal representation of strings, but only how
 466 they are interpreted.
 467
 468 C<no feature 'unicode_strings'> tells the compiler to use the traditional
 469 Perl rules wherein the native character set rules is used unless it is
 470 clear to Perl that Unicode is desired.  This can lead to some surprises
 471 when the behavior suddenly changes.  (See
 472 L<perlunicode/The "Unicode Bug"> for details.)  For this reason, if you are
 473 potentially using Unicode in your program, the
 474 C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
 475
 476 This feature is available starting with Perl 5.12; was almost fully
 477 implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>.
 478
 479 =head2 The 'unicode_eval' and 'evalbytes' features
 480
 481 Under the C<unicode_eval> feature, Perl's C<eval> function, when passed a
 482 string, will evaluate it as a string of characters, ignoring any
 483 C<use utf8> declarations.  C<use utf8> exists to declare the encoding of
 484 the script, which only makes sense for a stream of bytes, not a string of
 485 characters.  Source filters are forbidden, as they also really only make
 486 sense on strings of bytes.  Any attempt to activate a source filter will
 487 result in an error.
 488
 489 The C<evalbytes> feature enables the C<evalbytes> keyword, which evaluates
 490 the argument passed to it as a string of bytes.  It dies if the string
 491 contains any characters outside the 8-bit range.  Source filters work
 492 within C<evalbytes>: they apply to the contents of the string being
 493 evaluated.
 494
 495 Together, these two features are intended to replace the historical C<eval>
 496 function, which has (at least) two bugs in it, that cannot easily be fixed
 497 without breaking existing programs:
 498
 499 =over
 500
 501 =item *
 502
 503 C<eval> behaves differently depending on the internal encoding of the
 504 string, sometimes treating its argument as a string of bytes, and sometimes
 505 as a string of characters.
 506
 507 =item *
 508
 509 Source filters activated within C<eval> leak out into whichever I<file>
 510 scope is currently being compiled.  To give an example with the CPAN module
 511 L<Semi::Semicolons>:
 512
 513     BEGIN { eval "use Semi::Semicolons;  # not filtered here " }
 514     # filtered here!
 515
 516 C<evalbytes> fixes that to work the way one would expect:
 517
 518     use feature "evalbytes";
 519     BEGIN { evalbytes "use Semi::Semicolons;  # filtered " }
 520     # not filtered
 521
 522 =back
 523
 524 These two features are available starting with Perl 5.16.
 525
 526 =head2 The 'current_sub' feature
 527
 528 This provides the C<__SUB__> token that returns a reference to the current
 529 subroutine or C<undef> outside of a subroutine.
 530
 531 This feature is available starting with Perl 5.16.
 532
 533 =head2 The 'array_base' feature
 534
 535 This feature supports the legacy C<$[> variable.  See L<perlvar/$[> and
 536 L<arybase>.  It is on by default but disabled under C<use v5.16> (see
 537 L</IMPLICIT LOADING>, below).
 538
 539 This feature is available under this name starting with Perl 5.16.  In
 540 previous versions, it was simply on all the time, and this pragma knew
 541 nothing about it.
 542
 543 =head2 The 'fc' feature
 544
 545 C<use feature 'fc'> tells the compiler to enable the C<fc> function,
 546 which implements Unicode casefolding.
 547
 548 See L<perlfunc/fc> for details.
 549
 550 This feature is available from Perl 5.16 onwards.
 551
 552 =head2 The 'lexical_subs' feature
 553
 554 B<WARNING>: This feature is still experimental and the implementation may
 555 change in future versions of Perl.  For this reason, Perl will
 556 warn when you use the feature, unless you have explicitly disabled the
 557 warning:
 558
 559     no warnings "experimental::lexical_subs";
 560
 561 This enables declaration of subroutines via C<my sub foo>, C<state sub foo>
 562 and C<our sub foo> syntax.  See L<perlsub/Lexical Subroutines> for details.
 563
 564 This feature is available from Perl 5.18 onwards.
 565
 566 =head2 The 'signatures' feature
 567
 568 B<WARNING>: This feature is still experimental and the implementation may
 569 change in future versions of Perl.  For this reason, Perl will
 570 warn when you use the feature, unless you have explicitly disabled the
 571 warning:
 572
 573     no warnings "experimental::signatures";
 574
 575 This enables unpacking of subroutine arguments into lexical variables
 576 by syntax such as
 577
 578     sub foo ($left, $right) {
 579         return $left + $right;
 580     }
 581
 582 See L<perlsub/Signatures> for details.
 583
 584 This feature is available from Perl 5.20 onwards.
 585
 586 =head1 FEATURE BUNDLES
 587
 588 It's possible to load multiple features together, using
 589 a I<feature bundle>.  The name of a feature bundle is prefixed with
 590 a colon, to distinguish it from an actual feature.
 591
 592   use feature ":5.10";
 593
 594 The following feature bundles are available:
 595
 596   bundle    features included
 597   --------- -----------------
 598 PODTURES
 599 The C<:default> bundle represents the feature set that is enabled before
 600 any C<use feature> or C<no feature> declaration.
 601
 602 Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
 603 no effect.  Feature bundles are guaranteed to be the same for all sub-versions.
 604
 605   use feature ":5.14.0";    # same as ":5.14"
 606   use feature ":5.14.1";    # same as ":5.14"
 607
 608 =head1 IMPLICIT LOADING
 609
 610 Instead of loading feature bundles by name, it is easier to let Perl do
 611 implicit loading of a feature bundle for you.
 612
 613 There are two ways to load the C<feature> pragma implicitly:
 614
 615 =over 4
 616
 617 =item *
 618
 619 By using the C<-E> switch on the Perl command-line instead of C<-e>.
 620 That will enable the feature bundle for that version of Perl in the
 621 main compilation unit (that is, the one-liner that follows C<-E>).
 622
 623 =item *
 624
 625 By explicitly requiring a minimum Perl version number for your program, with
 626 the C<use VERSION> construct.  That is,
 627
 628     use v5.10.0;
 629
 630 will do an implicit
 631
 632     no feature ':all';
 633     use feature ':5.10';
 634
 635 and so on.  Note how the trailing sub-version
 636 is automatically stripped from the
 637 version.
 638
 639 But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
 640
 641     use 5.010;
 642
 643 with the same effect.
 644
 645 If the required version is older than Perl 5.10, the ":default" feature
 646 bundle is automatically loaded instead.
 647
 648 =back
 649
 650 =cut
 651
 652 sub import {
 653     my $class = shift;
 654
 655     if (!@_) {
 656         croak("No features specified");
 657     }
 658
 659     __common(1, @_);
 660 }
 661
 662 sub unimport {
 663     my $class = shift;
 664
 665     # A bare C<no feature> should reset to the default bundle
 666     if (!@_) {
 667         $^H &= ~($hint_uni8bit|$hint_mask);
 668         return;
 669     }
 670
 671     __common(0, @_);
 672 }
 673
 674
 675 sub __common {
 676     my $import = shift;
 677     my $bundle_number = $^H & $hint_mask;
 678     my $features = $bundle_number != $hint_mask
 679         && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
 680     if ($features) {
 681         # Features are enabled implicitly via bundle hints.
 682         # Delete any keys that may be left over from last time.
 683         delete @^H{ values(%feature) };
 684         $^H |= $hint_mask;
 685         for (@$features) {
 686             $^H{$feature{$_}} = 1;
 687             $^H |= $hint_uni8bit if $_ eq 'unicode_strings';
 688         }
 689     }
 690     while (@_) {
 691         my $name = shift;
 692         if (substr($name, 0, 1) eq ":") {
 693             my $v = substr($name, 1);
 694             if (!exists $feature_bundle{$v}) {
 695                 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
 696                 if (!exists $feature_bundle{$v}) {
 697                     unknown_feature_bundle(substr($name, 1));
 698                 }
 699             }
 700             unshift @_, @{$feature_bundle{$v}};
 701             next;
 702         }
 703         if (!exists $feature{$name}) {
 704             unknown_feature($name);
 705         }
 706         if ($import) {
 707             $^H{$feature{$name}} = 1;
 708             $^H |= $hint_uni8bit if $name eq 'unicode_strings';
 709         } else {
 710             delete $^H{$feature{$name}};
 711             $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
 712         }
 713     }
 714 }
 715
 716 sub unknown_feature {
 717     my $feature = shift;
 718     croak(sprintf('Feature "%s" is not supported by Perl %vd',
 719             $feature, $^V));
 720 }
 721
 722 sub unknown_feature_bundle {
 723     my $feature = shift;
 724     croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
 725             $feature, $^V));
 726 }
 727
 728 sub croak {
 729     require Carp;
 730     Carp::croak(@_);
 731 }
 732
 733 1;