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