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)
28 evalbytes => 'evalbytes',
29 postderef => 'postderef',
30 array_base => 'arybase',
31 current_sub => '__SUB__',
32 lexical_subs => 'lexsubs',
33 postderef_qq => 'postderef_qq',
34 unicode_eval => 'unieval',
35 unicode_strings => 'unicode',
39 # NOTE: If a feature is ever enabled in a non-contiguous range of Perl
40 # versions, any code below that uses %BundleRanges will have to
41 # be changed to account.
43 # 5.odd implies the next 5.even, but an explicit 5.even can override it.
44 my %feature_bundle = (
45 all => [ keys %feature ],
46 default => [qw(array_base)],
47 "5.9.5" => [qw(say state switch array_base)],
48 "5.10" => [qw(say state switch array_base)],
49 "5.11" => [qw(say state switch unicode_strings array_base)],
50 "5.13" => [qw(say state switch unicode_strings array_base)],
51 "5.15" => [qw(say state switch unicode_strings unicode_eval
52 evalbytes current_sub fc)],
53 "5.17" => [qw(say state switch unicode_strings unicode_eval
54 evalbytes current_sub fc)],
55 "5.19" => [qw(say state switch unicode_strings unicode_eval
56 evalbytes current_sub fc)],
59 # not actually used currently
60 my @experimental = qw( lexical_subs );
63 ###########################################################################
64 # More data generated from the above
66 for (keys %feature_bundle) {
67 next unless /^5\.(\d*[13579])\z/;
68 $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
71 my %UniqueBundles; # "say state switch" => 5.10
72 my %Aliases; # 5.12 => 5.11
73 for( sort keys %feature_bundle ) {
74 my $value = join(' ', sort @{$feature_bundle{$_}});
75 if (exists $UniqueBundles{$value}) {
76 $Aliases{$_} = $UniqueBundles{$value};
79 $UniqueBundles{$value} = $_;
83 my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
85 sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
88 next if $bund =~ /[^\d.]/ and $bund ne 'default';
89 for (@{$feature_bundle{$bund}}) {
90 if (@{$BundleRanges{$_} ||= []} == 2) {
91 $BundleRanges{$_}[1] = $bund
94 push @{$BundleRanges{$_}}, $bund;
103 open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!";
104 while (readline "perl.h") {
105 next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
106 my $is_u8b = $1 =~ 8;
107 /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
112 my $hex = $HintMask = $1;
113 my $bits = sprintf "%b", oct $1;
114 $bits =~ /^0*1+(0*)\z/
115 or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
116 $HintShift = length $1;
118 length sprintf "%b", scalar keys %UniqueBundles;
119 $bits =~ /1{$bits_needed}/
120 or die "Not enough bits (need $bits_needed)"
121 . " in $bits (binary for $hex):\n\n$_\n ";
123 if ($Uni8Bit && $HintMask) { last }
125 die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
126 die "No HINT_UNI_8_BIT defined in perl.h" unless $Uni8Bit;
131 ('default', grep !/[^\d.]/, sort values %UniqueBundles);
134 ###########################################################################
135 # Open files to be generated
138 open_new($_, '>', { by => 'regen/feature.pl' });
139 } 'lib/feature.pm', 'feature.h';
142 ###########################################################################
143 # Generate lib/feature.pm
146 last if /^FEATURES$/ ;
153 if (!defined $long or length $long < length) {
160 print $pm "our %feature = (\n";
161 my $width = length longest keys %feature;
162 for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
163 print $pm " $_" . " "x($width-length)
164 . " => 'feature_$feature{$_}',\n";
168 print $pm "our %feature_bundle = (\n";
169 $width = length longest values %UniqueBundles;
170 for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
171 keys %UniqueBundles ) {
172 my $bund = $UniqueBundles{$_};
173 print $pm qq' "$bund"' . " "x($width-length $bund)
174 . qq' => [qw($_)],\n';
178 for (sort keys %Aliases) {
180 qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
183 #print $pm "my \%experimental = (\n";
184 #print $pm " $_ => 1,\n", for @experimental;
189 our \$hint_shift = $HintShift;
190 our \$hint_mask = $HintMask;
191 our \@hint_bundles = qw( @HintedBundles );
193 # This gets set (for now) in \$^H as well as in %^H,
194 # for runtime speed of the uc/lc/ucfirst/lcfirst functions.
195 # See HINT_UNI_8_BIT in perl.h.
196 our \$hint_uni8bit = $Uni8Bit;
201 last if /^PODTURES$/ ;
205 select +(select($pm), $~ = 'PODTURES')[0];
207 ^<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
208 $::bundle, $::feature
211 for ('default', sort grep /\.\d[02468]/, keys %feature_bundle) {
213 $::feature = join ' ', @{$feature_bundle{$_}};
222 read_only_bottom_close_and_rename($pm);
225 ###########################################################################
230 #if defined(PERL_CORE) || defined (PERL_EXT)
232 #define HINT_FEATURE_SHIFT $HintShift
237 for (@HintedBundles) {
238 (my $key = uc) =~ y/.//d;
239 print $h "#define FEATURE_BUNDLE_$key ", $count++, "\n";
243 #define FEATURE_BUNDLE_CUSTOM (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
245 #define CURRENT_HINTS \
246 (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
247 #define CURRENT_FEATURE_BUNDLE \
248 ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
250 /* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
251 the HP-UX cc on PA-RISC */
252 #define FEATURE_IS_ENABLED(name) \
254 & HINT_LOCALIZE_HH) \
255 ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
256 /* The longest string we pass in. */
259 my $longest_internal_feature_name = longest values %feature;
261 #define MAX_FEATURE_LEN (sizeof("$longest_internal_feature_name")-1)
266 sort { length $a <=> length $b || $a cmp $b } keys %feature
269 map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
270 my $name = $feature{$_};
272 if ($last && $first eq 'DEFAULT') { # ‘>= DEFAULT’ warns
274 #define FEATURE_$NAME\_IS_ENABLED \\
276 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
277 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
278 FEATURE_IS_ENABLED("$name")) \\
285 #define FEATURE_$NAME\_IS_ENABLED \\
287 (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
288 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
289 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
290 FEATURE_IS_ENABLED("$name")) \\
297 #define FEATURE_$NAME\_IS_ENABLED \\
299 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
300 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
301 FEATURE_IS_ENABLED("$name")) \\
308 #define FEATURE_$NAME\_IS_ENABLED \\
310 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
311 FEATURE_IS_ENABLED("$name") \\
320 #endif /* PERL_CORE or PERL_EXT */
323 PERL_STATIC_INLINE void
324 S_enable_feature_bundle(pTHX_ SV *ver)
326 SV *comp_ver = sv_newmortal();
327 PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
331 for (reverse @HintedBundles[1..$#HintedBundles]) { # skip default
333 if ($numver eq '5.10') { $numver = '5.009005' } # special case
334 else { $numver =~ s/\./.0/ } # 5.11 => 5.011
335 (my $macrover = $_) =~ y/.//d;
337 (sv_setnv(comp_ver, $numver),
338 vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
339 ? FEATURE_BUNDLE_$macrover :
344 FEATURE_BUNDLE_DEFAULT
345 ) << HINT_FEATURE_SHIFT;
347 assert(PL_curcop == &PL_compiling);
348 if (FEATURE_UNICODE_IS_ENABLED) PL_hints |= HINT_UNI_8_BIT;
349 else PL_hints &= ~HINT_UNI_8_BIT;
351 #endif /* PERL_IN_OP_C */
354 read_only_bottom_close_and_rename($h);
357 ###########################################################################
358 # Template for feature.pm
363 our $VERSION = '1.34';
368 # - think about versioned features (use feature switch => 2)
372 feature - Perl pragma to enable new features
376 use feature qw(say switch);
378 when (1) { say "\$foo == 1" }
379 when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
380 when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
381 when ($_ > 100) { say "\$foo > 100" }
382 default { say "None of the above" }
385 use feature ':5.10'; # loads all features available in perl 5.10
387 use v5.10; # implicitly loads :5.10 feature bundle
391 It is usually impossible to add new syntax to Perl without breaking
392 some existing programs. This pragma provides a way to minimize that
393 risk. New syntactic constructs, or new semantic meanings to older
394 constructs, can be enabled by C<use feature 'foo'>, and will be parsed
395 only when the appropriate feature pragma is in scope. (Nevertheless, the
396 C<CORE::> prefix provides access to all Perl keywords, regardless of this
399 =head2 Lexical effect
401 Like other pragmas (C<use strict>, for example), features have a lexical
402 effect. C<use feature qw(foo)> will only make the feature "foo" available
403 from that point to the end of the enclosing block.
407 say "say is available here";
409 print "But not here.\n";
413 Features can also be turned off by using C<no feature "foo">. This too
417 say "say is available here";
420 print "But not here.\n";
422 say "Yet it is here.";
424 C<no feature> with no features specified will reset to the default group. To
425 disable I<all> features (an unusual request!) use C<no feature ':all'>.
427 =head1 AVAILABLE FEATURES
429 =head2 The 'say' feature
431 C<use feature 'say'> tells the compiler to enable the Perl 6 style
434 See L<perlfunc/say> for details.
436 This feature is available starting with Perl 5.10.
438 =head2 The 'state' feature
440 C<use feature 'state'> tells the compiler to enable C<state>
443 See L<perlsub/"Persistent Private Variables"> for details.
445 This feature is available starting with Perl 5.10.
447 =head2 The 'switch' feature
449 C<use feature 'switch'> tells the compiler to enable the Perl 6
450 given/when construct.
452 See L<perlsyn/"Switch Statements"> for details.
454 This feature is available starting with Perl 5.10.
456 =head2 The 'unicode_strings' feature
458 C<use feature 'unicode_strings'> tells the compiler to use Unicode semantics
459 in all string operations executed within its scope (unless they are also
460 within the scope of either C<use locale> or C<use bytes>). The same applies
461 to all regular expressions compiled within the scope, even if executed outside
462 it. It does not change the internal representation of strings, but only how
463 they are interpreted.
465 C<no feature 'unicode_strings'> tells the compiler to use the traditional
466 Perl semantics wherein the native character set semantics is used unless it is
467 clear to Perl that Unicode is desired. This can lead to some surprises
468 when the behavior suddenly changes. (See
469 L<perlunicode/The "Unicode Bug"> for details.) For this reason, if you are
470 potentially using Unicode in your program, the
471 C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
473 This feature is available starting with Perl 5.12; was almost fully
474 implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>.
476 =head2 The 'unicode_eval' and 'evalbytes' features
478 Under the C<unicode_eval> feature, Perl's C<eval> function, when passed a
479 string, will evaluate it as a string of characters, ignoring any
480 C<use utf8> declarations. C<use utf8> exists to declare the encoding of
481 the script, which only makes sense for a stream of bytes, not a string of
482 characters. Source filters are forbidden, as they also really only make
483 sense on strings of bytes. Any attempt to activate a source filter will
486 The C<evalbytes> feature enables the C<evalbytes> keyword, which evaluates
487 the argument passed to it as a string of bytes. It dies if the string
488 contains any characters outside the 8-bit range. Source filters work
489 within C<evalbytes>: they apply to the contents of the string being
492 Together, these two features are intended to replace the historical C<eval>
493 function, which has (at least) two bugs in it, that cannot easily be fixed
494 without breaking existing programs:
500 C<eval> behaves differently depending on the internal encoding of the
501 string, sometimes treating its argument as a string of bytes, and sometimes
502 as a string of characters.
506 Source filters activated within C<eval> leak out into whichever I<file>
507 scope is currently being compiled. To give an example with the CPAN module
510 BEGIN { eval "use Semi::Semicolons; # not filtered here " }
513 C<evalbytes> fixes that to work the way one would expect:
515 use feature "evalbytes";
516 BEGIN { evalbytes "use Semi::Semicolons; # filtered " }
521 These two features are available starting with Perl 5.16.
523 =head2 The 'current_sub' feature
525 This provides the C<__SUB__> token that returns a reference to the current
526 subroutine or C<undef> outside of a subroutine.
528 This feature is available starting with Perl 5.16.
530 =head2 The 'array_base' feature
532 This feature supports the legacy C<$[> variable. See L<perlvar/$[> and
533 L<arybase>. It is on by default but disabled under C<use v5.16> (see
534 L</IMPLICIT LOADING>, below).
536 This feature is available under this name starting with Perl 5.16. In
537 previous versions, it was simply on all the time, and this pragma knew
540 =head2 The 'fc' feature
542 C<use feature 'fc'> tells the compiler to enable the C<fc> function,
543 which implements Unicode casefolding.
545 See L<perlfunc/fc> for details.
547 This feature is available from Perl 5.16 onwards.
549 =head2 The 'lexical_subs' feature
551 B<WARNING>: This feature is still experimental and the implementation may
552 change in future versions of Perl. For this reason, Perl will
553 warn when you use the feature, unless you have explicitly disabled the
556 no warnings "experimental::lexical_subs";
558 This enables declaration of subroutines via C<my sub foo>, C<state sub foo>
559 and C<our sub foo> syntax. See L<perlsub/Lexical Subroutines> for details.
561 This feature is available from Perl 5.18 onwards.
563 =head1 FEATURE BUNDLES
565 It's possible to load multiple features together, using
566 a I<feature bundle>. The name of a feature bundle is prefixed with
567 a colon, to distinguish it from an actual feature.
571 The following feature bundles are available:
573 bundle features included
574 --------- -----------------
576 The C<:default> bundle represents the feature set that is enabled before
577 any C<use feature> or C<no feature> declaration.
579 Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
580 no effect. Feature bundles are guaranteed to be the same for all sub-versions.
582 use feature ":5.14.0"; # same as ":5.14"
583 use feature ":5.14.1"; # same as ":5.14"
585 =head1 IMPLICIT LOADING
587 Instead of loading feature bundles by name, it is easier to let Perl do
588 implicit loading of a feature bundle for you.
590 There are two ways to load the C<feature> pragma implicitly:
596 By using the C<-E> switch on the Perl command-line instead of C<-e>.
597 That will enable the feature bundle for that version of Perl in the
598 main compilation unit (that is, the one-liner that follows C<-E>).
602 By explicitly requiring a minimum Perl version number for your program, with
603 the C<use VERSION> construct. That is,
612 and so on. Note how the trailing sub-version
613 is automatically stripped from the
616 But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
620 with the same effect.
622 If the required version is older than Perl 5.10, the ":default" feature
623 bundle is automatically loaded instead.
633 croak("No features specified");
642 # A bare C<no feature> should reset to the default bundle
644 $^H &= ~($hint_uni8bit|$hint_mask);
654 my $bundle_number = $^H & $hint_mask;
655 my $features = $bundle_number != $hint_mask
656 && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
658 # Features are enabled implicitly via bundle hints.
659 # Delete any keys that may be left over from last time.
660 delete @^H{ values(%feature) };
663 $^H{$feature{$_}} = 1;
664 $^H |= $hint_uni8bit if $_ eq 'unicode_strings';
669 if (substr($name, 0, 1) eq ":") {
670 my $v = substr($name, 1);
671 if (!exists $feature_bundle{$v}) {
672 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
673 if (!exists $feature_bundle{$v}) {
674 unknown_feature_bundle(substr($name, 1));
677 unshift @_, @{$feature_bundle{$v}};
680 if (!exists $feature{$name}) {
681 unknown_feature($name);
684 $^H{$feature{$name}} = 1;
685 $^H |= $hint_uni8bit if $name eq 'unicode_strings';
687 delete $^H{$feature{$name}};
688 $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
693 sub unknown_feature {
695 croak(sprintf('Feature "%s" is not supported by Perl %vd',
699 sub unknown_feature_bundle {
701 croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',