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     bitwise         => 'bitwise',
  29     evalbytes       => 'evalbytes',
  30     current_sub     => '__SUB__',
  31     refaliasing     => 'refaliasing',
  32     postderef_qq    => 'postderef_qq',
  33     unicode_eval    => 'unieval',
  34     declared_refs   => 'myref',
  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()],
  48     "5.9.5"  => [qw(say state switch)],
  49     "5.10"   => [qw(say state switch)],
  50     "5.11"   => [qw(say state switch unicode_strings)],
  51     "5.13"   => [qw(say state switch unicode_strings)],
  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     "5.23"   => [qw(say state switch unicode_strings unicode_eval
  61                     evalbytes current_sub fc postderef_qq)],
  62     "5.25"   => [qw(say state switch unicode_strings unicode_eval
  63                     evalbytes current_sub fc postderef_qq)],
  64     "5.27"   => [qw(say state switch unicode_strings unicode_eval
  65                     evalbytes current_sub fc postderef_qq bitwise)],
  66     "5.29"   => [qw(say state switch unicode_strings unicode_eval
  67                     evalbytes current_sub fc postderef_qq bitwise)],
  68     "5.31"   => [qw(say state switch unicode_strings unicode_eval
  69                     evalbytes current_sub fc postderef_qq bitwise)],
  70 );
  71
  72 my @noops = qw( postderef lexical_subs );
  73 my @removed = qw( array_base );
  74
  75
  76 ###########################################################################
  77 # More data generated from the above
  78
  79 for (keys %feature_bundle) {
  80     next unless /^5\.(\d*[13579])\z/;
  81     $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
  82 }
  83
  84 my %UniqueBundles; # "say state switch" => 5.10
  85 my %Aliases;       #  5.12 => 5.11
  86 for( sort keys %feature_bundle ) {
  87     my $value = join(' ', sort @{$feature_bundle{$_}});
  88     if (exists $UniqueBundles{$value}) {
  89         $Aliases{$_} = $UniqueBundles{$value};
  90     }
  91     else {
  92         $UniqueBundles{$value} = $_;
  93     }
  94 }
  95                            # start   end
  96 my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
  97 for my $bund (
  98     sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
  99          values %UniqueBundles
 100 ) {
 101     next if $bund =~ /[^\d.]/ and $bund ne 'default';
 102     for (@{$feature_bundle{$bund}}) {
 103         if (@{$BundleRanges{$_} ||= []} == 2) {
 104             $BundleRanges{$_}[1] = $bund
 105         }
 106         else {
 107             push @{$BundleRanges{$_}}, $bund;
 108         }
 109     }
 110 }
 111
 112 my $HintShift;
 113 my $HintMask;
 114 my $Uni8Bit;
 115
 116 open "perl.h", "<", "perl.h" or die "$0 cannot open perl.h: $!";
 117 while (readline "perl.h") {
 118     next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
 119     my $is_u8b = $1 =~ 8;
 120     /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
 121     if ($is_u8b) {
 122         $Uni8Bit = $1;
 123     }
 124     else {
 125         my $hex = $HintMask = $1;
 126         my $bits = sprintf "%b", oct $1;
 127         $bits =~ /^0*1+(0*)\z/
 128          or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
 129         $HintShift = length $1;
 130         my $bits_needed =
 131             length sprintf "%b", scalar keys %UniqueBundles;
 132         $bits =~ /1{$bits_needed}/
 133             or die "Not enough bits (need $bits_needed)"
 134                  . " in $bits (binary for $hex):\n\n$_\n ";
 135     }
 136     if ($Uni8Bit && $HintMask) { last }
 137 }
 138 die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
 139 die "No HINT_UNI_8_BIT defined in perl.h"    unless $Uni8Bit;
 140
 141 close "perl.h";
 142
 143 my @HintedBundles =
 144     ('default', grep !/[^\d.]/, sort values %UniqueBundles);
 145
 146
 147 ###########################################################################
 148 # Open files to be generated
 149
 150 my ($pm, $h) = map {
 151     open_new($_, '>', { by => 'regen/feature.pl' });
 152 } 'lib/feature.pm', 'feature.h';
 153
 154
 155 ###########################################################################
 156 # Generate lib/feature.pm
 157
 158 while (<DATA>) {
 159     last if /^FEATURES$/ ;
 160     print $pm $_ ;
 161 }
 162
 163 sub longest {
 164     my $long;
 165     for(@_) {
 166         if (!defined $long or length $long < length) {
 167             $long = $_;
 168         }
 169     }
 170     $long;
 171 }
 172
 173 print $pm "our %feature = (\n";
 174 my $width = length longest keys %feature;
 175 for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
 176     print $pm "    $_" . " "x($width-length)
 177             . " => 'feature_$feature{$_}',\n";
 178 }
 179 print $pm ");\n\n";
 180
 181 print $pm "our %feature_bundle = (\n";
 182 $width = length longest values %UniqueBundles;
 183 for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
 184           keys %UniqueBundles ) {
 185     my $bund = $UniqueBundles{$_};
 186     print $pm qq'    "$bund"' . " "x($width-length $bund)
 187             . qq' => [qw($_)],\n';
 188 }
 189 print $pm ");\n\n";
 190
 191 for (sort keys %Aliases) {
 192     print $pm
 193         qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
 194 };
 195
 196 print $pm "my \%noops = (\n";
 197 print $pm "    $_ => 1,\n", for @noops;
 198 print $pm ");\n";
 199
 200 print $pm "my \%removed = (\n";
 201 print $pm "    $_ => 1,\n", for @removed;
 202 print $pm ");\n";
 203
 204 print $pm <<EOPM;
 205
 206 our \$hint_shift   = $HintShift;
 207 our \$hint_mask    = $HintMask;
 208 our \@hint_bundles = qw( @HintedBundles );
 209
 210 # This gets set (for now) in \$^H as well as in %^H,
 211 # for runtime speed of the uc/lc/ucfirst/lcfirst functions.
 212 # See HINT_UNI_8_BIT in perl.h.
 213 our \$hint_uni8bit = $Uni8Bit;
 214 EOPM
 215
 216
 217 while (<DATA>) {
 218     last if /^PODTURES$/ ;
 219     print $pm $_ ;
 220 }
 221
 222 select +(select($pm), $~ = 'PODTURES')[0];
 223 format PODTURES =
 224   ^<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
 225 $::bundle, $::feature
 226 .
 227
 228 for ('default', sort grep /\.\d[02468]/, keys %feature_bundle) {
 229     $::bundle = ":$_";
 230     $::feature = join ' ', @{$feature_bundle{$_}};
 231     write $pm;
 232     print $pm "\n";
 233 }
 234
 235 while (<DATA>) {
 236     print $pm $_ ;
 237 }
 238
 239 read_only_bottom_close_and_rename($pm);
 240
 241
 242 ###########################################################################
 243 # Generate feature.h
 244
 245 print $h <<EOH;
 246
 247 #ifndef PERL_FEATURE_H_
 248 #define PERL_FEATURE_H_
 249
 250 #if defined(PERL_CORE) || defined (PERL_EXT)
 251
 252 #define HINT_FEATURE_SHIFT      $HintShift
 253
 254 EOH
 255
 256 my $count;
 257 for (@HintedBundles) {
 258     (my $key = uc) =~ y/.//d;
 259     print $h "#define FEATURE_BUNDLE_$key       ", $count++, "\n";
 260 }
 261
 262 print $h <<'EOH';
 263 #define FEATURE_BUNDLE_CUSTOM   (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
 264
 265 #define CURRENT_HINTS \
 266     (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
 267 #define CURRENT_FEATURE_BUNDLE \
 268     ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
 269
 270 /* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
 271    the HP-UX cc on PA-RISC */
 272 #define FEATURE_IS_ENABLED(name)                                        \
 273         ((CURRENT_HINTS                                                  \
 274            & HINT_LOCALIZE_HH)                                            \
 275             ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
 276 /* The longest string we pass in.  */
 277 EOH
 278
 279 my $longest_internal_feature_name = longest values %feature;
 280 print $h <<EOL;
 281 #define MAX_FEATURE_LEN (sizeof("$longest_internal_feature_name")-1)
 282
 283 EOL
 284
 285 for (
 286     sort { length $a <=> length $b || $a cmp $b } keys %feature
 287 ) {
 288     my($first,$last) =
 289         map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
 290     my $name = $feature{$_};
 291     my $NAME = uc $name;
 292     if ($last && $first eq 'DEFAULT') { #  '>= DEFAULT' warns
 293         print $h <<EOI;
 294 #define FEATURE_$NAME\_IS_ENABLED \\
 295     ( \\
 296         CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
 297      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
 298          FEATURE_IS_ENABLED("$name")) \\
 299     )
 300
 301 EOI
 302     }
 303     elsif ($last) {
 304         print $h <<EOH3;
 305 #define FEATURE_$NAME\_IS_ENABLED \\
 306     ( \\
 307         (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
 308          CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
 309      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
 310          FEATURE_IS_ENABLED("$name")) \\
 311     )
 312
 313 EOH3
 314     }
 315     elsif ($first) {
 316         print $h <<EOH4;
 317 #define FEATURE_$NAME\_IS_ENABLED \\
 318     ( \\
 319         CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
 320      || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
 321          FEATURE_IS_ENABLED("$name")) \\
 322     )
 323
 324 EOH4
 325     }
 326     else {
 327         print $h <<EOH5;
 328 #define FEATURE_$NAME\_IS_ENABLED \\
 329     ( \\
 330         CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
 331          FEATURE_IS_ENABLED("$name") \\
 332     )
 333
 334 EOH5
 335     }
 336 }
 337
 338 print $h <<EOH;
 339
 340 #endif /* PERL_CORE or PERL_EXT */
 341
 342 #ifdef PERL_IN_OP_C
 343 PERL_STATIC_INLINE void
 344 S_enable_feature_bundle(pTHX_ SV *ver)
 345 {
 346     SV *comp_ver = sv_newmortal();
 347     PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
 348              | (
 349 EOH
 350
 351 for (reverse @HintedBundles[1..$#HintedBundles]) { # skip default
 352     my $numver = $_;
 353     if ($numver eq '5.10') { $numver = '5.009005' } # special case
 354     else                   { $numver =~ s/\./.0/  } # 5.11 => 5.011
 355     (my $macrover = $_) =~ y/.//d;
 356     print $h <<"    EOK";
 357                   (sv_setnv(comp_ver, $numver),
 358                    vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
 359                         ? FEATURE_BUNDLE_$macrover :
 360     EOK
 361 }
 362
 363 print $h <<EOJ;
 364                           FEATURE_BUNDLE_DEFAULT
 365                ) << HINT_FEATURE_SHIFT;
 366     /* special case */
 367     assert(PL_curcop == &PL_compiling);
 368     if (FEATURE_UNICODE_IS_ENABLED) PL_hints |=  HINT_UNI_8_BIT;
 369     else                            PL_hints &= ~HINT_UNI_8_BIT;
 370 }
 371 #endif /* PERL_IN_OP_C */
 372
 373 #endif /* PERL_FEATURE_H_ */
 374 EOJ
 375
 376 read_only_bottom_close_and_rename($h);
 377
 378
 379 ###########################################################################
 380 # Template for feature.pm
 381
 382 __END__
 383 package feature;
 384
 385 our $VERSION = '1.55';
 386
 387 FEATURES
 388
 389 # TODO:
 390 # - think about versioned features (use feature switch => 2)
 391
 392 =head1 NAME
 393
 394 feature - Perl pragma to enable new features
 395
 396 =head1 SYNOPSIS
 397
 398     use feature qw(say switch);
 399     given ($foo) {
 400         when (1)          { say "\$foo == 1" }
 401         when ([2,3])      { say "\$foo == 2 || \$foo == 3" }
 402         when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
 403         when ($_ > 100)   { say "\$foo > 100" }
 404         default           { say "None of the above" }
 405     }
 406
 407     use feature ':5.10'; # loads all features available in perl 5.10
 408
 409     use v5.10;           # implicitly loads :5.10 feature bundle
 410
 411 =head1 DESCRIPTION
 412
 413 It is usually impossible to add new syntax to Perl without breaking
 414 some existing programs.  This pragma provides a way to minimize that
 415 risk. New syntactic constructs, or new semantic meanings to older
 416 constructs, can be enabled by C<use feature 'foo'>, and will be parsed
 417 only when the appropriate feature pragma is in scope.  (Nevertheless, the
 418 C<CORE::> prefix provides access to all Perl keywords, regardless of this
 419 pragma.)
 420
 421 =head2 Lexical effect
 422
 423 Like other pragmas (C<use strict>, for example), features have a lexical
 424 effect.  C<use feature qw(foo)> will only make the feature "foo" available
 425 from that point to the end of the enclosing block.
 426
 427     {
 428         use feature 'say';
 429         say "say is available here";
 430     }
 431     print "But not here.\n";
 432
 433 =head2 C<no feature>
 434
 435 Features can also be turned off by using C<no feature "foo">.  This too
 436 has lexical effect.
 437
 438     use feature 'say';
 439     say "say is available here";
 440     {
 441         no feature 'say';
 442         print "But not here.\n";
 443     }
 444     say "Yet it is here.";
 445
 446 C<no feature> with no features specified will reset to the default group.  To
 447 disable I<all> features (an unusual request!) use C<no feature ':all'>.
 448
 449 =head1 AVAILABLE FEATURES
 450
 451 =head2 The 'say' feature
 452
 453 C<use feature 'say'> tells the compiler to enable the Perl 6 style
 454 C<say> function.
 455
 456 See L<perlfunc/say> for details.
 457
 458 This feature is available starting with Perl 5.10.
 459
 460 =head2 The 'state' feature
 461
 462 C<use feature 'state'> tells the compiler to enable C<state>
 463 variables.
 464
 465 See L<perlsub/"Persistent Private Variables"> for details.
 466
 467 This feature is available starting with Perl 5.10.
 468
 469 =head2 The 'switch' feature
 470
 471 B<WARNING>: Because the L<smartmatch operator|perlop/"Smartmatch Operator"> is
 472 experimental, Perl will warn when you use this feature, unless you have
 473 explicitly disabled the warning:
 474
 475     no warnings "experimental::smartmatch";
 476
 477 C<use feature 'switch'> tells the compiler to enable the Perl 6
 478 given/when construct.
 479
 480 See L<perlsyn/"Switch Statements"> for details.
 481
 482 This feature is available starting with Perl 5.10.
 483
 484 =head2 The 'unicode_strings' feature
 485
 486 C<use feature 'unicode_strings'> tells the compiler to use Unicode rules
 487 in all string operations executed within its scope (unless they are also
 488 within the scope of either C<use locale> or C<use bytes>).  The same applies
 489 to all regular expressions compiled within the scope, even if executed outside
 490 it.  It does not change the internal representation of strings, but only how
 491 they are interpreted.
 492
 493 C<no feature 'unicode_strings'> tells the compiler to use the traditional
 494 Perl rules wherein the native character set rules is used unless it is
 495 clear to Perl that Unicode is desired.  This can lead to some surprises
 496 when the behavior suddenly changes.  (See
 497 L<perlunicode/The "Unicode Bug"> for details.)  For this reason, if you are
 498 potentially using Unicode in your program, the
 499 C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
 500
 501 This feature is available starting with Perl 5.12; was almost fully
 502 implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>;
 503 was extended further in Perl 5.26 to cover L<the range
 504 operator|perlop/Range Operators>; and was extended again in Perl 5.28 to
 505 cover L<special-cased whitespace splitting|perlfunc/split>.
 506
 507 =head2 The 'unicode_eval' and 'evalbytes' features
 508
 509 Together, these two features are intended to replace the legacy string
 510 C<eval> function, which behaves problematically in some instances.  They are
 511 available starting with Perl 5.16, and are enabled by default by a
 512 S<C<use 5.16>> or higher declaration.
 513
 514 C<unicode_eval> changes the behavior of plain string C<eval> to work more
 515 consistently, especially in the Unicode world.  Certain (mis)behaviors
 516 couldn't be changed without breaking some things that had come to rely on
 517 them, so the feature can be enabled and disabled.  Details are at
 518 L<perlfunc/Under the "unicode_eval" feature>.
 519
 520 C<evalbytes> is like string C<eval>, but operating on a byte stream that is
 521 not UTF-8 encoded.  Details are at L<perlfunc/evalbytes EXPR>.  Without a
 522 S<C<use feature 'evalbytes'>> nor a S<C<use v5.16>> (or higher) declaration in
 523 the current scope, you can still access it by instead writing
 524 C<CORE::evalbytes>.
 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 supported the legacy C<$[> variable.  See L<perlvar/$[>.
 536 It was on by default but disabled under C<use v5.16> (see
 537 L</IMPLICIT LOADING>, below) and unavailable since perl 5.30.
 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 In Perl versions prior to 5.26, this feature enabled
 555 declaration of subroutines via C<my sub foo>, C<state sub foo>
 556 and C<our sub foo> syntax.  See L<perlsub/Lexical Subroutines> for details.
 557
 558 This feature is available from Perl 5.18 onwards.  From Perl 5.18 to 5.24,
 559 it was classed as experimental, and Perl emitted a warning for its
 560 usage, except when explicitly disabled:
 561
 562   no warnings "experimental::lexical_subs";
 563
 564 As of Perl 5.26, use of this feature no longer triggers a warning, though
 565 the C<experimental::lexical_subs> warning category still exists (for
 566 compatibility with code that disables it).  In addition, this syntax is
 567 not only no longer experimental, but it is enabled for all Perl code,
 568 regardless of what feature declarations are in scope.
 569
 570 =head2 The 'postderef' and 'postderef_qq' features
 571
 572 The 'postderef_qq' feature extends the applicability of L<postfix
 573 dereference syntax|perlref/Postfix Dereference Syntax> so that postfix array
 574 and scalar dereference are available in double-quotish interpolations. For
 575 example, it makes the following two statements equivalent:
 576
 577   my $s = "[@{ $h->{a} }]";
 578   my $s = "[$h->{a}->@*]";
 579
 580 This feature is available from Perl 5.20 onwards. In Perl 5.20 and 5.22, it
 581 was classed as experimental, and Perl emitted a warning for its
 582 usage, except when explicitly disabled:
 583
 584   no warnings "experimental::postderef";
 585
 586 As of Perl 5.24, use of this feature no longer triggers a warning, though
 587 the C<experimental::postderef> warning category still exists (for
 588 compatibility with code that disables it).
 589
 590 The 'postderef' feature was used in Perl 5.20 and Perl 5.22 to enable
 591 postfix dereference syntax outside double-quotish interpolations. In those
 592 versions, using it triggered the C<experimental::postderef> warning in the
 593 same way as the 'postderef_qq' feature did. As of Perl 5.24, this syntax is
 594 not only no longer experimental, but it is enabled for all Perl code,
 595 regardless of what feature declarations are in scope.
 596
 597 =head2 The 'signatures' feature
 598
 599 B<WARNING>: This feature is still experimental and the implementation may
 600 change in future versions of Perl.  For this reason, Perl will
 601 warn when you use the feature, unless you have explicitly disabled the
 602 warning:
 603
 604     no warnings "experimental::signatures";
 605
 606 This enables unpacking of subroutine arguments into lexical variables
 607 by syntax such as
 608
 609     sub foo ($left, $right) {
 610         return $left + $right;
 611     }
 612
 613 See L<perlsub/Signatures> for details.
 614
 615 This feature is available from Perl 5.20 onwards.
 616
 617 =head2 The 'refaliasing' feature
 618
 619 B<WARNING>: This feature is still experimental and the implementation may
 620 change in future versions of Perl.  For this reason, Perl will
 621 warn when you use the feature, unless you have explicitly disabled the
 622 warning:
 623
 624     no warnings "experimental::refaliasing";
 625
 626 This enables aliasing via assignment to references:
 627
 628     \$a = \$b; # $a and $b now point to the same scalar
 629     \@a = \@b; #                     to the same array
 630     \%a = \%b;
 631     \&a = \&b;
 632     foreach \%hash (@array_of_hash_refs) {
 633         ...
 634     }
 635
 636 See L<perlref/Assigning to References> for details.
 637
 638 This feature is available from Perl 5.22 onwards.
 639
 640 =head2 The 'bitwise' feature
 641
 642 This makes the four standard bitwise operators (C<& | ^ ~>) treat their
 643 operands consistently as numbers, and introduces four new dotted operators
 644 (C<&. |. ^. ~.>) that treat their operands consistently as strings.  The
 645 same applies to the assignment variants (C<&= |= ^= &.= |.= ^.=>).
 646
 647 See L<perlop/Bitwise String Operators> for details.
 648
 649 This feature is available from Perl 5.22 onwards.  Starting in Perl 5.28,
 650 C<use v5.28> will enable the feature.  Before 5.28, it was still
 651 experimental and would emit a warning in the "experimental::bitwise"
 652 category.
 653
 654 =head2 The 'declared_refs' feature
 655
 656 B<WARNING>: This feature is still experimental and the implementation may
 657 change in future versions of Perl.  For this reason, Perl will
 658 warn when you use the feature, unless you have explicitly disabled the
 659 warning:
 660
 661     no warnings "experimental::declared_refs";
 662
 663 This allows a reference to a variable to be declared with C<my>, C<state>,
 664 our C<our>, or localized with C<local>.  It is intended mainly for use in
 665 conjunction with the "refaliasing" feature.  See L<perlref/Declaring a
 666 Reference to a Variable> for examples.
 667
 668 This feature is available from Perl 5.26 onwards.
 669
 670 =head1 FEATURE BUNDLES
 671
 672 It's possible to load multiple features together, using
 673 a I<feature bundle>.  The name of a feature bundle is prefixed with
 674 a colon, to distinguish it from an actual feature.
 675
 676   use feature ":5.10";
 677
 678 The following feature bundles are available:
 679
 680   bundle    features included
 681   --------- -----------------
 682 PODTURES
 683 The C<:default> bundle represents the feature set that is enabled before
 684 any C<use feature> or C<no feature> declaration.
 685
 686 Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
 687 no effect.  Feature bundles are guaranteed to be the same for all sub-versions.
 688
 689   use feature ":5.14.0";    # same as ":5.14"
 690   use feature ":5.14.1";    # same as ":5.14"
 691
 692 =head1 IMPLICIT LOADING
 693
 694 Instead of loading feature bundles by name, it is easier to let Perl do
 695 implicit loading of a feature bundle for you.
 696
 697 There are two ways to load the C<feature> pragma implicitly:
 698
 699 =over 4
 700
 701 =item *
 702
 703 By using the C<-E> switch on the Perl command-line instead of C<-e>.
 704 That will enable the feature bundle for that version of Perl in the
 705 main compilation unit (that is, the one-liner that follows C<-E>).
 706
 707 =item *
 708
 709 By explicitly requiring a minimum Perl version number for your program, with
 710 the C<use VERSION> construct.  That is,
 711
 712     use v5.10.0;
 713
 714 will do an implicit
 715
 716     no feature ':all';
 717     use feature ':5.10';
 718
 719 and so on.  Note how the trailing sub-version
 720 is automatically stripped from the
 721 version.
 722
 723 But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
 724
 725     use 5.010;
 726
 727 with the same effect.
 728
 729 If the required version is older than Perl 5.10, the ":default" feature
 730 bundle is automatically loaded instead.
 731
 732 Unlike C<use feature ":5.12">, saying C<use v5.12> (or any higher version)
 733 also does the equivalent of C<use strict>; see L<perlfunc/use> for details.
 734
 735 =back
 736
 737 =cut
 738
 739 sub import {
 740     shift;
 741
 742     if (!@_) {
 743         croak("No features specified");
 744     }
 745
 746     __common(1, @_);
 747 }
 748
 749 sub unimport {
 750     shift;
 751
 752     # A bare C<no feature> should reset to the default bundle
 753     if (!@_) {
 754         $^H &= ~($hint_uni8bit|$hint_mask);
 755         return;
 756     }
 757
 758     __common(0, @_);
 759 }
 760
 761
 762 sub __common {
 763     my $import = shift;
 764     my $bundle_number = $^H & $hint_mask;
 765     my $features = $bundle_number != $hint_mask
 766         && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
 767     if ($features) {
 768         # Features are enabled implicitly via bundle hints.
 769         # Delete any keys that may be left over from last time.
 770         delete @^H{ values(%feature) };
 771         $^H |= $hint_mask;
 772         for (@$features) {
 773             $^H{$feature{$_}} = 1;
 774             $^H |= $hint_uni8bit if $_ eq 'unicode_strings';
 775         }
 776     }
 777     while (@_) {
 778         my $name = shift;
 779         if (substr($name, 0, 1) eq ":") {
 780             my $v = substr($name, 1);
 781             if (!exists $feature_bundle{$v}) {
 782                 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
 783                 if (!exists $feature_bundle{$v}) {
 784                     unknown_feature_bundle(substr($name, 1));
 785                 }
 786             }
 787             unshift @_, @{$feature_bundle{$v}};
 788             next;
 789         }
 790         if (!exists $feature{$name}) {
 791             if (exists $noops{$name}) {
 792                 next;
 793             }
 794             if (!$import && exists $removed{$name}) {
 795                 next;
 796             }
 797             unknown_feature($name);
 798         }
 799         if ($import) {
 800             $^H{$feature{$name}} = 1;
 801             $^H |= $hint_uni8bit if $name eq 'unicode_strings';
 802         } else {
 803             delete $^H{$feature{$name}};
 804             $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
 805         }
 806     }
 807 }
 808
 809 sub unknown_feature {
 810     my $feature = shift;
 811     croak(sprintf('Feature "%s" is not supported by Perl %vd',
 812             $feature, $^V));
 813 }
 814
 815 sub unknown_feature_bundle {
 816     my $feature = shift;
 817     croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
 818             $feature, $^V));
 819 }
 820
 821 sub croak {
 822     require Carp;
 823     Carp::croak(@_);
 824 }
 825
 826 1;