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 postderef => 'postderef',
31 array_base => 'arybase',
32 current_sub => '__SUB__',
33 refaliasing => 'refaliasing',
34 lexical_subs => 'lexsubs',
35 postderef_qq => 'postderef_qq',
36 unicode_eval => 'unieval',
37 unicode_strings => 'unicode',
39 signatures => 'signatures',
42 # NOTE: If a feature is ever enabled in a non-contiguous range of Perl
43 # versions, any code below that uses %BundleRanges will have to
44 # be changed to account.
46 # 5.odd implies the next 5.even, but an explicit 5.even can override it.
47 my %feature_bundle = (
48 all => [ keys %feature ],
49 default => [qw(array_base)],
50 "5.9.5" => [qw(say state switch array_base)],
51 "5.10" => [qw(say state switch array_base)],
52 "5.11" => [qw(say state switch unicode_strings array_base)],
53 "5.13" => [qw(say state switch unicode_strings array_base)],
54 "5.15" => [qw(say state switch unicode_strings unicode_eval
55 evalbytes current_sub fc)],
56 "5.17" => [qw(say state switch unicode_strings unicode_eval
57 evalbytes current_sub fc)],
58 "5.19" => [qw(say state switch unicode_strings unicode_eval
59 evalbytes current_sub fc)],
60 "5.21" => [qw(say state switch unicode_strings unicode_eval
61 evalbytes current_sub fc)],
62 "5.23" => [qw(say state switch unicode_strings unicode_eval
63 evalbytes current_sub fc postderef_qq)],
66 # not actually used currently
67 my @experimental = qw( lexical_subs );
70 ###########################################################################
71 # More data generated from the above
73 for (keys %feature_bundle) {
74 next unless /^5\.(\d*[13579])\z/;
75 $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
78 my %UniqueBundles; # "say state switch" => 5.10
79 my %Aliases; # 5.12 => 5.11
80 for( sort keys %feature_bundle ) {
81 my $value = join(' ', sort @{$feature_bundle{$_}});
82 if (exists $UniqueBundles{$value}) {
83 $Aliases{$_} = $UniqueBundles{$value};
86 $UniqueBundles{$value} = $_;
90 my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
92 sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
95 next if $bund =~ /[^\d.]/ and $bund ne 'default';
96 for (@{$feature_bundle{$bund}}) {
97 if (@{$BundleRanges{$_} ||= []} == 2) {
98 $BundleRanges{$_}[1] = $bund
101 push @{$BundleRanges{$_}}, $bund;
110 open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!";
111 while (readline "perl.h") {
112 next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
113 my $is_u8b = $1 =~ 8;
114 /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
119 my $hex = $HintMask = $1;
120 my $bits = sprintf "%b", oct $1;
121 $bits =~ /^0*1+(0*)\z/
122 or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
123 $HintShift = length $1;
125 length sprintf "%b", scalar keys %UniqueBundles;
126 $bits =~ /1{$bits_needed}/
127 or die "Not enough bits (need $bits_needed)"
128 . " in $bits (binary for $hex):\n\n$_\n ";
130 if ($Uni8Bit && $HintMask) { last }
132 die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
133 die "No HINT_UNI_8_BIT defined in perl.h" unless $Uni8Bit;
138 ('default', grep !/[^\d.]/, sort values %UniqueBundles);
141 ###########################################################################
142 # Open files to be generated
145 open_new($_, '>', { by => 'regen/feature.pl' });
146 } 'lib/feature.pm', 'feature.h';
149 ###########################################################################
150 # Generate lib/feature.pm
153 last if /^FEATURES$/ ;
160 if (!defined $long or length $long < length) {
167 print $pm "our %feature = (\n";
168 my $width = length longest keys %feature;
169 for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
170 print $pm " $_" . " "x($width-length)
171 . " => 'feature_$feature{$_}',\n";
175 print $pm "our %feature_bundle = (\n";
176 $width = length longest values %UniqueBundles;
177 for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
178 keys %UniqueBundles ) {
179 my $bund = $UniqueBundles{$_};
180 print $pm qq' "$bund"' . " "x($width-length $bund)
181 . qq' => [qw($_)],\n';
185 for (sort keys %Aliases) {
187 qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
190 #print $pm "my \%experimental = (\n";
191 #print $pm " $_ => 1,\n", for @experimental;
196 our \$hint_shift = $HintShift;
197 our \$hint_mask = $HintMask;
198 our \@hint_bundles = qw( @HintedBundles );
200 # This gets set (for now) in \$^H as well as in %^H,
201 # for runtime speed of the uc/lc/ucfirst/lcfirst functions.
202 # See HINT_UNI_8_BIT in perl.h.
203 our \$hint_uni8bit = $Uni8Bit;
208 last if /^PODTURES$/ ;
212 select +(select($pm), $~ = 'PODTURES')[0];
214 ^<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
215 $::bundle, $::feature
218 for ('default', sort grep /\.\d[02468]/, keys %feature_bundle) {
220 $::feature = join ' ', @{$feature_bundle{$_}};
229 read_only_bottom_close_and_rename($pm);
232 ###########################################################################
237 #if defined(PERL_CORE) || defined (PERL_EXT)
239 #define HINT_FEATURE_SHIFT $HintShift
244 for (@HintedBundles) {
245 (my $key = uc) =~ y/.//d;
246 print $h "#define FEATURE_BUNDLE_$key ", $count++, "\n";
250 #define FEATURE_BUNDLE_CUSTOM (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
252 #define CURRENT_HINTS \
253 (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
254 #define CURRENT_FEATURE_BUNDLE \
255 ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
257 /* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
258 the HP-UX cc on PA-RISC */
259 #define FEATURE_IS_ENABLED(name) \
261 & HINT_LOCALIZE_HH) \
262 ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
263 /* The longest string we pass in. */
266 my $longest_internal_feature_name = longest values %feature;
268 #define MAX_FEATURE_LEN (sizeof("$longest_internal_feature_name")-1)
273 sort { length $a <=> length $b || $a cmp $b } keys %feature
276 map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
277 my $name = $feature{$_};
279 if ($last && $first eq 'DEFAULT') { # '>= DEFAULT' warns
281 #define FEATURE_$NAME\_IS_ENABLED \\
283 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
284 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
285 FEATURE_IS_ENABLED("$name")) \\
292 #define FEATURE_$NAME\_IS_ENABLED \\
294 (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
295 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
296 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
297 FEATURE_IS_ENABLED("$name")) \\
304 #define FEATURE_$NAME\_IS_ENABLED \\
306 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
307 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
308 FEATURE_IS_ENABLED("$name")) \\
315 #define FEATURE_$NAME\_IS_ENABLED \\
317 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
318 FEATURE_IS_ENABLED("$name") \\
327 #endif /* PERL_CORE or PERL_EXT */
330 PERL_STATIC_INLINE void
331 S_enable_feature_bundle(pTHX_ SV *ver)
333 SV *comp_ver = sv_newmortal();
334 PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
338 for (reverse @HintedBundles[1..$#HintedBundles]) { # skip default
340 if ($numver eq '5.10') { $numver = '5.009005' } # special case
341 else { $numver =~ s/\./.0/ } # 5.11 => 5.011
342 (my $macrover = $_) =~ y/.//d;
344 (sv_setnv(comp_ver, $numver),
345 vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
346 ? FEATURE_BUNDLE_$macrover :
351 FEATURE_BUNDLE_DEFAULT
352 ) << HINT_FEATURE_SHIFT;
354 assert(PL_curcop == &PL_compiling);
355 if (FEATURE_UNICODE_IS_ENABLED) PL_hints |= HINT_UNI_8_BIT;
356 else PL_hints &= ~HINT_UNI_8_BIT;
358 #endif /* PERL_IN_OP_C */
361 read_only_bottom_close_and_rename($h);
364 ###########################################################################
365 # Template for feature.pm
370 our $VERSION = '1.42';
375 # - think about versioned features (use feature switch => 2)
379 feature - Perl pragma to enable new features
383 use feature qw(say switch);
385 when (1) { say "\$foo == 1" }
386 when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
387 when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
388 when ($_ > 100) { say "\$foo > 100" }
389 default { say "None of the above" }
392 use feature ':5.10'; # loads all features available in perl 5.10
394 use v5.10; # implicitly loads :5.10 feature bundle
398 It is usually impossible to add new syntax to Perl without breaking
399 some existing programs. This pragma provides a way to minimize that
400 risk. New syntactic constructs, or new semantic meanings to older
401 constructs, can be enabled by C<use feature 'foo'>, and will be parsed
402 only when the appropriate feature pragma is in scope. (Nevertheless, the
403 C<CORE::> prefix provides access to all Perl keywords, regardless of this
406 =head2 Lexical effect
408 Like other pragmas (C<use strict>, for example), features have a lexical
409 effect. C<use feature qw(foo)> will only make the feature "foo" available
410 from that point to the end of the enclosing block.
414 say "say is available here";
416 print "But not here.\n";
420 Features can also be turned off by using C<no feature "foo">. This too
424 say "say is available here";
427 print "But not here.\n";
429 say "Yet it is here.";
431 C<no feature> with no features specified will reset to the default group. To
432 disable I<all> features (an unusual request!) use C<no feature ':all'>.
434 =head1 AVAILABLE FEATURES
436 =head2 The 'say' feature
438 C<use feature 'say'> tells the compiler to enable the Perl 6 style
441 See L<perlfunc/say> for details.
443 This feature is available starting with Perl 5.10.
445 =head2 The 'state' feature
447 C<use feature 'state'> tells the compiler to enable C<state>
450 See L<perlsub/"Persistent Private Variables"> for details.
452 This feature is available starting with Perl 5.10.
454 =head2 The 'switch' feature
456 B<WARNING>: Because the L<smartmatch operator|perlop/"Smartmatch Operator"> is
457 experimental, Perl will warn when you use this feature, unless you have
458 explicitly disabled the warning:
460 no warnings "experimental::smartmatch";
462 C<use feature 'switch'> tells the compiler to enable the Perl 6
463 given/when construct.
465 See L<perlsyn/"Switch Statements"> for details.
467 This feature is available starting with Perl 5.10.
469 =head2 The 'unicode_strings' feature
471 C<use feature 'unicode_strings'> tells the compiler to use Unicode rules
472 in all string operations executed within its scope (unless they are also
473 within the scope of either C<use locale> or C<use bytes>). The same applies
474 to all regular expressions compiled within the scope, even if executed outside
475 it. It does not change the internal representation of strings, but only how
476 they are interpreted.
478 C<no feature 'unicode_strings'> tells the compiler to use the traditional
479 Perl rules wherein the native character set rules is used unless it is
480 clear to Perl that Unicode is desired. This can lead to some surprises
481 when the behavior suddenly changes. (See
482 L<perlunicode/The "Unicode Bug"> for details.) For this reason, if you are
483 potentially using Unicode in your program, the
484 C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
486 This feature is available starting with Perl 5.12; was almost fully
487 implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>.
489 =head2 The 'unicode_eval' and 'evalbytes' features
491 Under the C<unicode_eval> feature, Perl's C<eval> function, when passed a
492 string, will evaluate it as a string of characters, ignoring any
493 C<use utf8> declarations. C<use utf8> exists to declare the encoding of
494 the script, which only makes sense for a stream of bytes, not a string of
495 characters. Source filters are forbidden, as they also really only make
496 sense on strings of bytes. Any attempt to activate a source filter will
499 The C<evalbytes> feature enables the C<evalbytes> keyword, which evaluates
500 the argument passed to it as a string of bytes. It dies if the string
501 contains any characters outside the 8-bit range. Source filters work
502 within C<evalbytes>: they apply to the contents of the string being
505 Together, these two features are intended to replace the historical C<eval>
506 function, which has (at least) two bugs in it, that cannot easily be fixed
507 without breaking existing programs:
513 C<eval> behaves differently depending on the internal encoding of the
514 string, sometimes treating its argument as a string of bytes, and sometimes
515 as a string of characters.
519 Source filters activated within C<eval> leak out into whichever I<file>
520 scope is currently being compiled. To give an example with the CPAN module
523 BEGIN { eval "use Semi::Semicolons; # not filtered here " }
526 C<evalbytes> fixes that to work the way one would expect:
528 use feature "evalbytes";
529 BEGIN { evalbytes "use Semi::Semicolons; # filtered " }
534 These two features are available starting with Perl 5.16.
536 =head2 The 'current_sub' feature
538 This provides the C<__SUB__> token that returns a reference to the current
539 subroutine or C<undef> outside of a subroutine.
541 This feature is available starting with Perl 5.16.
543 =head2 The 'array_base' feature
545 This feature supports the legacy C<$[> variable. See L<perlvar/$[> and
546 L<arybase>. It is on by default but disabled under C<use v5.16> (see
547 L</IMPLICIT LOADING>, below).
549 This feature is available under this name starting with Perl 5.16. In
550 previous versions, it was simply on all the time, and this pragma knew
553 =head2 The 'fc' feature
555 C<use feature 'fc'> tells the compiler to enable the C<fc> function,
556 which implements Unicode casefolding.
558 See L<perlfunc/fc> for details.
560 This feature is available from Perl 5.16 onwards.
562 =head2 The 'lexical_subs' feature
564 B<WARNING>: This feature is still experimental and the implementation may
565 change in future versions of Perl. For this reason, Perl will
566 warn when you use the feature, unless you have explicitly disabled the
569 no warnings "experimental::lexical_subs";
571 This enables declaration of subroutines via C<my sub foo>, C<state sub foo>
572 and C<our sub foo> syntax. See L<perlsub/Lexical Subroutines> for details.
574 This feature is available from Perl 5.18 onwards.
576 =head2 The 'postderef' and 'postderef_qq' features
578 The 'postderef_qq' feature extends the applicability of L<postfix
579 dereference syntax|perlref/Postfix Dereference Syntax> so that postfix array
580 and scalar dereference are available in double-quotish interpolations. For
581 example, it makes the following two statements equivalent:
583 my $s = "[@{ $h->{a} }]";
584 my $s = "[$h->{a}->@*]";
586 This feature is available from Perl 5.20 onwards. In Perl 5.20 and 5.22, it
587 was classed as experimental, and Perl emitted a warning for its
588 usage, except when explicitly disabled:
590 no warnings "experimental::postderef";
592 As of Perl 5.24, use of this feature no longer triggers a warning, though
593 the C<experimental::postderef> warning category still exists (for
594 compatibility with code that disables it).
596 The 'postderef' feature was used in Perl 5.20 and Perl 5.22 to enable
597 postfix dereference syntax outside double-quotish interpolations. In those
598 versions, using it triggered the C<experimental::postderef> warning in the
599 same way as the 'postderef_qq' feature did. As of Perl 5.24, this syntax is
600 not only no longer experimental, but it is enabled for all Perl code,
601 regardless of what feature declarations are in scope.
603 =head2 The 'signatures' feature
605 B<WARNING>: This feature is still experimental and the implementation may
606 change in future versions of Perl. For this reason, Perl will
607 warn when you use the feature, unless you have explicitly disabled the
610 no warnings "experimental::signatures";
612 This enables unpacking of subroutine arguments into lexical variables
615 sub foo ($left, $right) {
616 return $left + $right;
619 See L<perlsub/Signatures> for details.
621 This feature is available from Perl 5.20 onwards.
623 =head2 The 'refaliasing' feature
625 B<WARNING>: This feature is still experimental and the implementation may
626 change in future versions of Perl. For this reason, Perl will
627 warn when you use the feature, unless you have explicitly disabled the
630 no warnings "experimental::refaliasing";
632 This enables aliasing via assignment to references:
634 \$a = \$b; # $a and $b now point to the same scalar
635 \@a = \@b; # to the same array
638 foreach \%hash (@array_of_hash_refs) {
642 See L<perlref/Assigning to References> for details.
644 This feature is available from Perl 5.22 onwards.
646 =head2 The 'bitwise' feature
648 B<WARNING>: This feature is still experimental and the implementation may
649 change in future versions of Perl. For this reason, Perl will
650 warn when you use the feature, unless you have explicitly disabled the
653 no warnings "experimental::bitwise";
655 This makes the four standard bitwise operators (C<& | ^ ~>) treat their
656 operands consistently as numbers, and introduces four new dotted operators
657 (C<&. |. ^. ~.>) that treat their operands consistently as strings. The
658 same applies to the assignment variants (C<&= |= ^= &.= |.= ^.=>).
660 See L<perlop/Bitwise String Operators> for details.
662 This feature is available from Perl 5.22 onwards.
664 =head1 FEATURE BUNDLES
666 It's possible to load multiple features together, using
667 a I<feature bundle>. The name of a feature bundle is prefixed with
668 a colon, to distinguish it from an actual feature.
672 The following feature bundles are available:
674 bundle features included
675 --------- -----------------
677 The C<:default> bundle represents the feature set that is enabled before
678 any C<use feature> or C<no feature> declaration.
680 Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
681 no effect. Feature bundles are guaranteed to be the same for all sub-versions.
683 use feature ":5.14.0"; # same as ":5.14"
684 use feature ":5.14.1"; # same as ":5.14"
686 =head1 IMPLICIT LOADING
688 Instead of loading feature bundles by name, it is easier to let Perl do
689 implicit loading of a feature bundle for you.
691 There are two ways to load the C<feature> pragma implicitly:
697 By using the C<-E> switch on the Perl command-line instead of C<-e>.
698 That will enable the feature bundle for that version of Perl in the
699 main compilation unit (that is, the one-liner that follows C<-E>).
703 By explicitly requiring a minimum Perl version number for your program, with
704 the C<use VERSION> construct. That is,
713 and so on. Note how the trailing sub-version
714 is automatically stripped from the
717 But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
721 with the same effect.
723 If the required version is older than Perl 5.10, the ":default" feature
724 bundle is automatically loaded instead.
734 croak("No features specified");
743 # A bare C<no feature> should reset to the default bundle
745 $^H &= ~($hint_uni8bit|$hint_mask);
755 my $bundle_number = $^H & $hint_mask;
756 my $features = $bundle_number != $hint_mask
757 && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
759 # Features are enabled implicitly via bundle hints.
760 # Delete any keys that may be left over from last time.
761 delete @^H{ values(%feature) };
764 $^H{$feature{$_}} = 1;
765 $^H |= $hint_uni8bit if $_ eq 'unicode_strings';
770 if (substr($name, 0, 1) eq ":") {
771 my $v = substr($name, 1);
772 if (!exists $feature_bundle{$v}) {
773 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
774 if (!exists $feature_bundle{$v}) {
775 unknown_feature_bundle(substr($name, 1));
778 unshift @_, @{$feature_bundle{$v}};
781 if (!exists $feature{$name}) {
782 unknown_feature($name);
785 $^H{$feature{$name}} = 1;
786 $^H |= $hint_uni8bit if $name eq 'unicode_strings';
788 delete $^H{$feature{$name}};
789 $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
794 sub unknown_feature {
796 croak(sprintf('Feature "%s" is not supported by Perl %vd',
800 sub unknown_feature_bundle {
802 croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',