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