3 # Regenerate (overwriting only if changed):
8 # from information hardcoded into this script and from two #defines
11 # This script is normally invoked from regen.pl.
14 require 'regen/regen_lib.pl';
20 ###########################################################################
23 # (feature name) => (internal name, used in %^H and macro names)
29 evalbytes => 'evalbytes',
30 array_base => 'arybase',
31 current_sub => '__SUB__',
32 refaliasing => 'refaliasing',
33 postderef_qq => 'postderef_qq',
34 unicode_eval => 'unieval',
35 unicode_strings => 'unicode',
37 signatures => 'signatures',
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.
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 "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)],
66 my @noops = qw( postderef lexical_subs );
69 ###########################################################################
70 # More data generated from the above
72 for (keys %feature_bundle) {
73 next unless /^5\.(\d*[13579])\z/;
74 $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
77 my %UniqueBundles; # "say state switch" => 5.10
78 my %Aliases; # 5.12 => 5.11
79 for( sort keys %feature_bundle ) {
80 my $value = join(' ', sort @{$feature_bundle{$_}});
81 if (exists $UniqueBundles{$value}) {
82 $Aliases{$_} = $UniqueBundles{$value};
85 $UniqueBundles{$value} = $_;
89 my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
91 sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
94 next if $bund =~ /[^\d.]/ and $bund ne 'default';
95 for (@{$feature_bundle{$bund}}) {
96 if (@{$BundleRanges{$_} ||= []} == 2) {
97 $BundleRanges{$_}[1] = $bund
100 push @{$BundleRanges{$_}}, $bund;
109 open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!";
110 while (readline "perl.h") {
111 next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
112 my $is_u8b = $1 =~ 8;
113 /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
118 my $hex = $HintMask = $1;
119 my $bits = sprintf "%b", oct $1;
120 $bits =~ /^0*1+(0*)\z/
121 or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
122 $HintShift = length $1;
124 length sprintf "%b", scalar keys %UniqueBundles;
125 $bits =~ /1{$bits_needed}/
126 or die "Not enough bits (need $bits_needed)"
127 . " in $bits (binary for $hex):\n\n$_\n ";
129 if ($Uni8Bit && $HintMask) { last }
131 die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
132 die "No HINT_UNI_8_BIT defined in perl.h" unless $Uni8Bit;
137 ('default', grep !/[^\d.]/, sort values %UniqueBundles);
140 ###########################################################################
141 # Open files to be generated
144 open_new($_, '>', { by => 'regen/feature.pl' });
145 } 'lib/feature.pm', 'feature.h';
148 ###########################################################################
149 # Generate lib/feature.pm
152 last if /^FEATURES$/ ;
159 if (!defined $long or length $long < length) {
166 print $pm "our %feature = (\n";
167 my $width = length longest keys %feature;
168 for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
169 print $pm " $_" . " "x($width-length)
170 . " => 'feature_$feature{$_}',\n";
174 print $pm "our %feature_bundle = (\n";
175 $width = length longest values %UniqueBundles;
176 for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
177 keys %UniqueBundles ) {
178 my $bund = $UniqueBundles{$_};
179 print $pm qq' "$bund"' . " "x($width-length $bund)
180 . qq' => [qw($_)],\n';
184 for (sort keys %Aliases) {
186 qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
189 print $pm "my \%noops = (\n";
190 print $pm " $_ => 1,\n", for @noops;
195 our \$hint_shift = $HintShift;
196 our \$hint_mask = $HintMask;
197 our \@hint_bundles = qw( @HintedBundles );
199 # This gets set (for now) in \$^H as well as in %^H,
200 # for runtime speed of the uc/lc/ucfirst/lcfirst functions.
201 # See HINT_UNI_8_BIT in perl.h.
202 our \$hint_uni8bit = $Uni8Bit;
207 last if /^PODTURES$/ ;
211 select +(select($pm), $~ = 'PODTURES')[0];
213 ^<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
214 $::bundle, $::feature
217 for ('default', sort grep /\.\d[02468]/, keys %feature_bundle) {
219 $::feature = join ' ', @{$feature_bundle{$_}};
228 read_only_bottom_close_and_rename($pm);
231 ###########################################################################
236 #if defined(PERL_CORE) || defined (PERL_EXT)
238 #define HINT_FEATURE_SHIFT $HintShift
243 for (@HintedBundles) {
244 (my $key = uc) =~ y/.//d;
245 print $h "#define FEATURE_BUNDLE_$key ", $count++, "\n";
249 #define FEATURE_BUNDLE_CUSTOM (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
251 #define CURRENT_HINTS \
252 (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
253 #define CURRENT_FEATURE_BUNDLE \
254 ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
256 /* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
257 the HP-UX cc on PA-RISC */
258 #define FEATURE_IS_ENABLED(name) \
260 & HINT_LOCALIZE_HH) \
261 ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
262 /* The longest string we pass in. */
265 my $longest_internal_feature_name = longest values %feature;
267 #define MAX_FEATURE_LEN (sizeof("$longest_internal_feature_name")-1)
272 sort { length $a <=> length $b || $a cmp $b } keys %feature
275 map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
276 my $name = $feature{$_};
278 if ($last && $first eq 'DEFAULT') { # '>= DEFAULT' warns
280 #define FEATURE_$NAME\_IS_ENABLED \\
282 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
283 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
284 FEATURE_IS_ENABLED("$name")) \\
291 #define FEATURE_$NAME\_IS_ENABLED \\
293 (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
294 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
295 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
296 FEATURE_IS_ENABLED("$name")) \\
303 #define FEATURE_$NAME\_IS_ENABLED \\
305 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
306 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
307 FEATURE_IS_ENABLED("$name")) \\
314 #define FEATURE_$NAME\_IS_ENABLED \\
316 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
317 FEATURE_IS_ENABLED("$name") \\
326 #endif /* PERL_CORE or PERL_EXT */
329 PERL_STATIC_INLINE void
330 S_enable_feature_bundle(pTHX_ SV *ver)
332 SV *comp_ver = sv_newmortal();
333 PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
337 for (reverse @HintedBundles[1..$#HintedBundles]) { # skip default
339 if ($numver eq '5.10') { $numver = '5.009005' } # special case
340 else { $numver =~ s/\./.0/ } # 5.11 => 5.011
341 (my $macrover = $_) =~ y/.//d;
343 (sv_setnv(comp_ver, $numver),
344 vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
345 ? FEATURE_BUNDLE_$macrover :
350 FEATURE_BUNDLE_DEFAULT
351 ) << HINT_FEATURE_SHIFT;
353 assert(PL_curcop == &PL_compiling);
354 if (FEATURE_UNICODE_IS_ENABLED) PL_hints |= HINT_UNI_8_BIT;
355 else PL_hints &= ~HINT_UNI_8_BIT;
357 #endif /* PERL_IN_OP_C */
360 read_only_bottom_close_and_rename($h);
363 ###########################################################################
364 # Template for feature.pm
369 our $VERSION = '1.44';
374 # - think about versioned features (use feature switch => 2)
378 feature - Perl pragma to enable new features
382 use feature qw(say switch);
384 when (1) { say "\$foo == 1" }
385 when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
386 when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
387 when ($_ > 100) { say "\$foo > 100" }
388 default { say "None of the above" }
391 use feature ':5.10'; # loads all features available in perl 5.10
393 use v5.10; # implicitly loads :5.10 feature bundle
397 It is usually impossible to add new syntax to Perl without breaking
398 some existing programs. This pragma provides a way to minimize that
399 risk. New syntactic constructs, or new semantic meanings to older
400 constructs, can be enabled by C<use feature 'foo'>, and will be parsed
401 only when the appropriate feature pragma is in scope. (Nevertheless, the
402 C<CORE::> prefix provides access to all Perl keywords, regardless of this
405 =head2 Lexical effect
407 Like other pragmas (C<use strict>, for example), features have a lexical
408 effect. C<use feature qw(foo)> will only make the feature "foo" available
409 from that point to the end of the enclosing block.
413 say "say is available here";
415 print "But not here.\n";
419 Features can also be turned off by using C<no feature "foo">. This too
423 say "say is available here";
426 print "But not here.\n";
428 say "Yet it is here.";
430 C<no feature> with no features specified will reset to the default group. To
431 disable I<all> features (an unusual request!) use C<no feature ':all'>.
433 =head1 AVAILABLE FEATURES
435 =head2 The 'say' feature
437 C<use feature 'say'> tells the compiler to enable the Perl 6 style
440 See L<perlfunc/say> for details.
442 This feature is available starting with Perl 5.10.
444 =head2 The 'state' feature
446 C<use feature 'state'> tells the compiler to enable C<state>
449 See L<perlsub/"Persistent Private Variables"> for details.
451 This feature is available starting with Perl 5.10.
453 =head2 The 'switch' feature
455 B<WARNING>: Because the L<smartmatch operator|perlop/"Smartmatch Operator"> is
456 experimental, Perl will warn when you use this feature, unless you have
457 explicitly disabled the warning:
459 no warnings "experimental::smartmatch";
461 C<use feature 'switch'> tells the compiler to enable the Perl 6
462 given/when construct.
464 See L<perlsyn/"Switch Statements"> for details.
466 This feature is available starting with Perl 5.10.
468 =head2 The 'unicode_strings' feature
470 C<use feature 'unicode_strings'> tells the compiler to use Unicode rules
471 in all string operations executed within its scope (unless they are also
472 within the scope of either C<use locale> or C<use bytes>). The same applies
473 to all regular expressions compiled within the scope, even if executed outside
474 it. It does not change the internal representation of strings, but only how
475 they are interpreted.
477 C<no feature 'unicode_strings'> tells the compiler to use the traditional
478 Perl rules wherein the native character set rules is used unless it is
479 clear to Perl that Unicode is desired. This can lead to some surprises
480 when the behavior suddenly changes. (See
481 L<perlunicode/The "Unicode Bug"> for details.) For this reason, if you are
482 potentially using Unicode in your program, the
483 C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
485 This feature is available starting with Perl 5.12; was almost fully
486 implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>.
488 =head2 The 'unicode_eval' and 'evalbytes' features
490 Under the C<unicode_eval> feature, Perl's C<eval> function, when passed a
491 string, will evaluate it as a string of characters, ignoring any
492 C<use utf8> declarations. C<use utf8> exists to declare the encoding of
493 the script, which only makes sense for a stream of bytes, not a string of
494 characters. Source filters are forbidden, as they also really only make
495 sense on strings of bytes. Any attempt to activate a source filter will
498 The C<evalbytes> feature enables the C<evalbytes> keyword, which evaluates
499 the argument passed to it as a string of bytes. It dies if the string
500 contains any characters outside the 8-bit range. Source filters work
501 within C<evalbytes>: they apply to the contents of the string being
504 Together, these two features are intended to replace the historical C<eval>
505 function, which has (at least) two bugs in it, that cannot easily be fixed
506 without breaking existing programs:
512 C<eval> behaves differently depending on the internal encoding of the
513 string, sometimes treating its argument as a string of bytes, and sometimes
514 as a string of characters.
518 Source filters activated within C<eval> leak out into whichever I<file>
519 scope is currently being compiled. To give an example with the CPAN module
522 BEGIN { eval "use Semi::Semicolons; # not filtered here " }
525 C<evalbytes> fixes that to work the way one would expect:
527 use feature "evalbytes";
528 BEGIN { evalbytes "use Semi::Semicolons; # filtered " }
533 These two features are available starting with Perl 5.16.
535 =head2 The 'current_sub' feature
537 This provides the C<__SUB__> token that returns a reference to the current
538 subroutine or C<undef> outside of a subroutine.
540 This feature is available starting with Perl 5.16.
542 =head2 The 'array_base' feature
544 This feature supports the legacy C<$[> variable. See L<perlvar/$[> and
545 L<arybase>. It is on by default but disabled under C<use v5.16> (see
546 L</IMPLICIT LOADING>, below).
548 This feature is available under this name starting with Perl 5.16. In
549 previous versions, it was simply on all the time, and this pragma knew
552 =head2 The 'fc' feature
554 C<use feature 'fc'> tells the compiler to enable the C<fc> function,
555 which implements Unicode casefolding.
557 See L<perlfunc/fc> for details.
559 This feature is available from Perl 5.16 onwards.
561 =head2 The 'lexical_subs' feature
563 In Perl versions prior to 5.26, this feature enabled
564 declaration of subroutines via C<my sub foo>, C<state sub foo>
565 and C<our sub foo> syntax. See L<perlsub/Lexical Subroutines> for details.
567 This feature is available from Perl 5.18 onwards. From Perl 5.18 to 5.24,
568 it was classed as experimental, and Perl emitted a warning for its
569 usage, except when explicitly disabled:
571 no warnings "experimental::lexical_subs";
573 As of Perl 5.26, use of this feature no longer triggers a warning, though
574 the C<experimental::lexical_subs> warning category still exists (for
575 compatibility with code that disables it). In addition, this syntax is
576 not only no longer experimental, but it is enabled for all Perl code,
577 regardless of what feature declarations are in scope.
579 =head2 The 'postderef' and 'postderef_qq' features
581 The 'postderef_qq' feature extends the applicability of L<postfix
582 dereference syntax|perlref/Postfix Dereference Syntax> so that postfix array
583 and scalar dereference are available in double-quotish interpolations. For
584 example, it makes the following two statements equivalent:
586 my $s = "[@{ $h->{a} }]";
587 my $s = "[$h->{a}->@*]";
589 This feature is available from Perl 5.20 onwards. In Perl 5.20 and 5.22, it
590 was classed as experimental, and Perl emitted a warning for its
591 usage, except when explicitly disabled:
593 no warnings "experimental::postderef";
595 As of Perl 5.24, use of this feature no longer triggers a warning, though
596 the C<experimental::postderef> warning category still exists (for
597 compatibility with code that disables it).
599 The 'postderef' feature was used in Perl 5.20 and Perl 5.22 to enable
600 postfix dereference syntax outside double-quotish interpolations. In those
601 versions, using it triggered the C<experimental::postderef> warning in the
602 same way as the 'postderef_qq' feature did. As of Perl 5.24, this syntax is
603 not only no longer experimental, but it is enabled for all Perl code,
604 regardless of what feature declarations are in scope.
606 =head2 The 'signatures' feature
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
613 no warnings "experimental::signatures";
615 This enables unpacking of subroutine arguments into lexical variables
618 sub foo ($left, $right) {
619 return $left + $right;
622 See L<perlsub/Signatures> for details.
624 This feature is available from Perl 5.20 onwards.
626 =head2 The 'refaliasing' feature
628 B<WARNING>: This feature is still experimental and the implementation may
629 change in future versions of Perl. For this reason, Perl will
630 warn when you use the feature, unless you have explicitly disabled the
633 no warnings "experimental::refaliasing";
635 This enables aliasing via assignment to references:
637 \$a = \$b; # $a and $b now point to the same scalar
638 \@a = \@b; # to the same array
641 foreach \%hash (@array_of_hash_refs) {
645 See L<perlref/Assigning to References> for details.
647 This feature is available from Perl 5.22 onwards.
649 =head2 The 'bitwise' feature
651 B<WARNING>: This feature is still experimental and the implementation may
652 change in future versions of Perl. For this reason, Perl will
653 warn when you use the feature, unless you have explicitly disabled the
656 no warnings "experimental::bitwise";
658 This makes the four standard bitwise operators (C<& | ^ ~>) treat their
659 operands consistently as numbers, and introduces four new dotted operators
660 (C<&. |. ^. ~.>) that treat their operands consistently as strings. The
661 same applies to the assignment variants (C<&= |= ^= &.= |.= ^.=>).
663 See L<perlop/Bitwise String Operators> for details.
665 This feature is available from Perl 5.22 onwards.
667 =head1 FEATURE BUNDLES
669 It's possible to load multiple features together, using
670 a I<feature bundle>. The name of a feature bundle is prefixed with
671 a colon, to distinguish it from an actual feature.
675 The following feature bundles are available:
677 bundle features included
678 --------- -----------------
680 The C<:default> bundle represents the feature set that is enabled before
681 any C<use feature> or C<no feature> declaration.
683 Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
684 no effect. Feature bundles are guaranteed to be the same for all sub-versions.
686 use feature ":5.14.0"; # same as ":5.14"
687 use feature ":5.14.1"; # same as ":5.14"
689 =head1 IMPLICIT LOADING
691 Instead of loading feature bundles by name, it is easier to let Perl do
692 implicit loading of a feature bundle for you.
694 There are two ways to load the C<feature> pragma implicitly:
700 By using the C<-E> switch on the Perl command-line instead of C<-e>.
701 That will enable the feature bundle for that version of Perl in the
702 main compilation unit (that is, the one-liner that follows C<-E>).
706 By explicitly requiring a minimum Perl version number for your program, with
707 the C<use VERSION> construct. That is,
716 and so on. Note how the trailing sub-version
717 is automatically stripped from the
720 But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
724 with the same effect.
726 If the required version is older than Perl 5.10, the ":default" feature
727 bundle is automatically loaded instead.
737 croak("No features specified");
746 # A bare C<no feature> should reset to the default bundle
748 $^H &= ~($hint_uni8bit|$hint_mask);
758 my $bundle_number = $^H & $hint_mask;
759 my $features = $bundle_number != $hint_mask
760 && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
762 # Features are enabled implicitly via bundle hints.
763 # Delete any keys that may be left over from last time.
764 delete @^H{ values(%feature) };
767 $^H{$feature{$_}} = 1;
768 $^H |= $hint_uni8bit if $_ eq 'unicode_strings';
773 if (substr($name, 0, 1) eq ":") {
774 my $v = substr($name, 1);
775 if (!exists $feature_bundle{$v}) {
776 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
777 if (!exists $feature_bundle{$v}) {
778 unknown_feature_bundle(substr($name, 1));
781 unshift @_, @{$feature_bundle{$v}};
784 if (!exists $feature{$name}) {
785 if (exists $noops{$name}) {
788 unknown_feature($name);
791 $^H{$feature{$name}} = 1;
792 $^H |= $hint_uni8bit if $name eq 'unicode_strings';
794 delete $^H{$feature{$name}};
795 $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
800 sub unknown_feature {
802 croak(sprintf('Feature "%s" is not supported by Perl %vd',
806 sub unknown_feature_bundle {
808 croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',