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 array_base => 'arybase',
30 current_sub => '__SUB__',
31 lexical_subs => 'lexsubs',
32 unicode_eval => 'unieval',
33 unicode_strings => 'unicode',
37 # NOTE: If a feature is ever enabled in a non-contiguous range of Perl
38 # versions, any code below that uses %BundleRanges will have to
39 # be changed to account.
41 # 5.odd implies the next 5.even, but an explicit 5.even can override it.
42 my %feature_bundle = (
43 all => [ keys %feature ],
44 default => [qw(array_base)],
45 "5.9.5" => [qw(say state switch array_base)],
46 "5.10" => [qw(say state switch array_base)],
47 "5.11" => [qw(say state switch unicode_strings array_base)],
48 "5.13" => [qw(say state switch unicode_strings array_base)],
49 "5.15" => [qw(say state switch unicode_strings unicode_eval
50 evalbytes current_sub fc)],
51 "5.17" => [qw(say state switch unicode_strings unicode_eval
52 evalbytes current_sub fc)],
53 "5.19" => [qw(say state switch unicode_strings unicode_eval
54 evalbytes current_sub fc)],
57 # not actually used currently
58 my @experimental = qw( lexical_subs );
61 ###########################################################################
62 # More data generated from the above
64 for (keys %feature_bundle) {
65 next unless /^5\.(\d*[13579])\z/;
66 $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
69 my %UniqueBundles; # "say state switch" => 5.10
70 my %Aliases; # 5.12 => 5.11
71 for( sort keys %feature_bundle ) {
72 my $value = join(' ', sort @{$feature_bundle{$_}});
73 if (exists $UniqueBundles{$value}) {
74 $Aliases{$_} = $UniqueBundles{$value};
77 $UniqueBundles{$value} = $_;
81 my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
83 sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
86 next if $bund =~ /[^\d.]/ and $bund ne 'default';
87 for (@{$feature_bundle{$bund}}) {
88 if (@{$BundleRanges{$_} ||= []} == 2) {
89 $BundleRanges{$_}[1] = $bund
92 push @{$BundleRanges{$_}}, $bund;
101 open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!";
102 while (readline "perl.h") {
103 next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
104 my $is_u8b = $1 =~ 8;
105 /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
110 my $hex = $HintMask = $1;
111 my $bits = sprintf "%b", oct $1;
112 $bits =~ /^0*1+(0*)\z/
113 or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
114 $HintShift = length $1;
116 length sprintf "%b", scalar keys %UniqueBundles;
117 $bits =~ /1{$bits_needed}/
118 or die "Not enough bits (need $bits_needed)"
119 . " in $bits (binary for $hex):\n\n$_\n ";
121 if ($Uni8Bit && $HintMask) { last }
123 die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
124 die "No HINT_UNI_8_BIT defined in perl.h" unless $Uni8Bit;
129 ('default', grep !/[^\d.]/, sort values %UniqueBundles);
132 ###########################################################################
133 # Open files to be generated
136 open_new($_, '>', { by => 'regen/feature.pl' });
137 } 'lib/feature.pm', 'feature.h';
140 ###########################################################################
141 # Generate lib/feature.pm
144 last if /^FEATURES$/ ;
151 if (!defined $long or length $long < length) {
158 print $pm "our %feature = (\n";
159 my $width = length longest keys %feature;
160 for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
161 print $pm " $_" . " "x($width-length)
162 . " => 'feature_$feature{$_}',\n";
166 print $pm "our %feature_bundle = (\n";
167 $width = length longest values %UniqueBundles;
168 for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
169 keys %UniqueBundles ) {
170 my $bund = $UniqueBundles{$_};
171 print $pm qq' "$bund"' . " "x($width-length $bund)
172 . qq' => [qw($_)],\n';
176 for (sort keys %Aliases) {
178 qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
181 #print $pm "my \%experimental = (\n";
182 #print $pm " $_ => 1,\n", for @experimental;
187 our \$hint_shift = $HintShift;
188 our \$hint_mask = $HintMask;
189 our \@hint_bundles = qw( @HintedBundles );
191 # This gets set (for now) in \$^H as well as in %^H,
192 # for runtime speed of the uc/lc/ucfirst/lcfirst functions.
193 # See HINT_UNI_8_BIT in perl.h.
194 our \$hint_uni8bit = $Uni8Bit;
199 last if /^PODTURES$/ ;
203 select +(select($pm), $~ = 'PODTURES')[0];
205 ^<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
206 $::bundle, $::feature
209 for ('default', sort grep /\.\d[02468]/, keys %feature_bundle) {
211 $::feature = join ' ', @{$feature_bundle{$_}};
220 read_only_bottom_close_and_rename($pm);
223 ###########################################################################
228 #if defined(PERL_CORE) || defined (PERL_EXT)
230 #define HINT_FEATURE_SHIFT $HintShift
235 for (@HintedBundles) {
236 (my $key = uc) =~ y/.//d;
237 print $h "#define FEATURE_BUNDLE_$key ", $count++, "\n";
241 #define FEATURE_BUNDLE_CUSTOM (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
243 #define CURRENT_HINTS \
244 (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
245 #define CURRENT_FEATURE_BUNDLE \
246 ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
248 /* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
249 the HP-UX cc on PA-RISC */
250 #define FEATURE_IS_ENABLED(name) \
252 & HINT_LOCALIZE_HH) \
253 ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
254 /* The longest string we pass in. */
257 my $longest_internal_feature_name = longest values %feature;
259 #define MAX_FEATURE_LEN (sizeof("$longest_internal_feature_name")-1)
264 sort { length $a <=> length $b || $a cmp $b } keys %feature
267 map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
268 my $name = $feature{$_};
270 if ($last && $first eq 'DEFAULT') { # ‘>= DEFAULT’ warns
272 #define FEATURE_$NAME\_IS_ENABLED \\
274 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
275 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
276 FEATURE_IS_ENABLED("$name")) \\
283 #define FEATURE_$NAME\_IS_ENABLED \\
285 (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
286 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
287 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
288 FEATURE_IS_ENABLED("$name")) \\
295 #define FEATURE_$NAME\_IS_ENABLED \\
297 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
298 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
299 FEATURE_IS_ENABLED("$name")) \\
306 #define FEATURE_$NAME\_IS_ENABLED \\
308 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
309 FEATURE_IS_ENABLED("$name") \\
318 #endif /* PERL_CORE or PERL_EXT */
321 PERL_STATIC_INLINE void
322 S_enable_feature_bundle(pTHX_ SV *ver)
324 SV *comp_ver = sv_newmortal();
325 PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
329 for (reverse @HintedBundles[1..$#HintedBundles]) { # skip default
331 if ($numver eq '5.10') { $numver = '5.009005' } # special case
332 else { $numver =~ s/\./.0/ } # 5.11 => 5.011
333 (my $macrover = $_) =~ y/.//d;
335 (sv_setnv(comp_ver, $numver),
336 vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
337 ? FEATURE_BUNDLE_$macrover :
342 FEATURE_BUNDLE_DEFAULT
343 ) << HINT_FEATURE_SHIFT;
345 assert(PL_curcop == &PL_compiling);
346 if (FEATURE_UNICODE_IS_ENABLED) PL_hints |= HINT_UNI_8_BIT;
347 else PL_hints &= ~HINT_UNI_8_BIT;
349 #endif /* PERL_IN_OP_C */
352 read_only_bottom_close_and_rename($h);
355 ###########################################################################
356 # Template for feature.pm
361 our $VERSION = '1.33';
366 # - think about versioned features (use feature switch => 2)
370 feature - Perl pragma to enable new features
374 use feature qw(say switch);
376 when (1) { say "\$foo == 1" }
377 when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
378 when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
379 when ($_ > 100) { say "\$foo > 100" }
380 default { say "None of the above" }
383 use feature ':5.10'; # loads all features available in perl 5.10
385 use v5.10; # implicitly loads :5.10 feature bundle
389 It is usually impossible to add new syntax to Perl without breaking
390 some existing programs. This pragma provides a way to minimize that
391 risk. New syntactic constructs, or new semantic meanings to older
392 constructs, can be enabled by C<use feature 'foo'>, and will be parsed
393 only when the appropriate feature pragma is in scope. (Nevertheless, the
394 C<CORE::> prefix provides access to all Perl keywords, regardless of this
397 =head2 Lexical effect
399 Like other pragmas (C<use strict>, for example), features have a lexical
400 effect. C<use feature qw(foo)> will only make the feature "foo" available
401 from that point to the end of the enclosing block.
405 say "say is available here";
407 print "But not here.\n";
411 Features can also be turned off by using C<no feature "foo">. This too
415 say "say is available here";
418 print "But not here.\n";
420 say "Yet it is here.";
422 C<no feature> with no features specified will reset to the default group. To
423 disable I<all> features (an unusual request!) use C<no feature ':all'>.
425 =head1 AVAILABLE FEATURES
427 =head2 The 'say' feature
429 C<use feature 'say'> tells the compiler to enable the Perl 6 style
432 See L<perlfunc/say> for details.
434 This feature is available starting with Perl 5.10.
436 =head2 The 'state' feature
438 C<use feature 'state'> tells the compiler to enable C<state>
441 See L<perlsub/"Persistent Private Variables"> for details.
443 This feature is available starting with Perl 5.10.
445 =head2 The 'switch' feature
447 C<use feature 'switch'> tells the compiler to enable the Perl 6
448 given/when construct.
450 See L<perlsyn/"Switch Statements"> for details.
452 This feature is available starting with Perl 5.10.
454 =head2 The 'unicode_strings' feature
456 C<use feature 'unicode_strings'> tells the compiler to use Unicode semantics
457 in all string operations executed within its scope (unless they are also
458 within the scope of either C<use locale> or C<use bytes>). The same applies
459 to all regular expressions compiled within the scope, even if executed outside
460 it. It does not change the internal representation of strings, but only how
461 they are interpreted.
463 C<no feature 'unicode_strings'> tells the compiler to use the traditional
464 Perl semantics wherein the native character set semantics is used unless it is
465 clear to Perl that Unicode is desired. This can lead to some surprises
466 when the behavior suddenly changes. (See
467 L<perlunicode/The "Unicode Bug"> for details.) For this reason, if you are
468 potentially using Unicode in your program, the
469 C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
471 This feature is available starting with Perl 5.12; was almost fully
472 implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>.
474 =head2 The 'unicode_eval' and 'evalbytes' features
476 Under the C<unicode_eval> feature, Perl's C<eval> function, when passed a
477 string, will evaluate it as a string of characters, ignoring any
478 C<use utf8> declarations. C<use utf8> exists to declare the encoding of
479 the script, which only makes sense for a stream of bytes, not a string of
480 characters. Source filters are forbidden, as they also really only make
481 sense on strings of bytes. Any attempt to activate a source filter will
484 The C<evalbytes> feature enables the C<evalbytes> keyword, which evaluates
485 the argument passed to it as a string of bytes. It dies if the string
486 contains any characters outside the 8-bit range. Source filters work
487 within C<evalbytes>: they apply to the contents of the string being
490 Together, these two features are intended to replace the historical C<eval>
491 function, which has (at least) two bugs in it, that cannot easily be fixed
492 without breaking existing programs:
498 C<eval> behaves differently depending on the internal encoding of the
499 string, sometimes treating its argument as a string of bytes, and sometimes
500 as a string of characters.
504 Source filters activated within C<eval> leak out into whichever I<file>
505 scope is currently being compiled. To give an example with the CPAN module
508 BEGIN { eval "use Semi::Semicolons; # not filtered here " }
511 C<evalbytes> fixes that to work the way one would expect:
513 use feature "evalbytes";
514 BEGIN { evalbytes "use Semi::Semicolons; # filtered " }
519 These two features are available starting with Perl 5.16.
521 =head2 The 'current_sub' feature
523 This provides the C<__SUB__> token that returns a reference to the current
524 subroutine or C<undef> outside of a subroutine.
526 This feature is available starting with Perl 5.16.
528 =head2 The 'array_base' feature
530 This feature supports the legacy C<$[> variable. See L<perlvar/$[> and
531 L<arybase>. It is on by default but disabled under C<use v5.16> (see
532 L</IMPLICIT LOADING>, below).
534 This feature is available under this name starting with Perl 5.16. In
535 previous versions, it was simply on all the time, and this pragma knew
538 =head2 The 'fc' feature
540 C<use feature 'fc'> tells the compiler to enable the C<fc> function,
541 which implements Unicode casefolding.
543 See L<perlfunc/fc> for details.
545 This feature is available from Perl 5.16 onwards.
547 =head2 The 'lexical_subs' feature
549 B<WARNING>: This feature is still experimental and the implementation may
550 change in future versions of Perl. For this reason, Perl will
551 warn when you use the feature, unless you have explicitly disabled the
554 no warnings "experimental::lexical_subs";
556 This enables declaration of subroutines via C<my sub foo>, C<state sub foo>
557 and C<our sub foo> syntax. See L<perlsub/Lexical Subroutines> for details.
559 This feature is available from Perl 5.18 onwards.
561 =head1 FEATURE BUNDLES
563 It's possible to load multiple features together, using
564 a I<feature bundle>. The name of a feature bundle is prefixed with
565 a colon, to distinguish it from an actual feature.
569 The following feature bundles are available:
571 bundle features included
572 --------- -----------------
574 The C<:default> bundle represents the feature set that is enabled before
575 any C<use feature> or C<no feature> declaration.
577 Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
578 no effect. Feature bundles are guaranteed to be the same for all sub-versions.
580 use feature ":5.14.0"; # same as ":5.14"
581 use feature ":5.14.1"; # same as ":5.14"
583 =head1 IMPLICIT LOADING
585 Instead of loading feature bundles by name, it is easier to let Perl do
586 implicit loading of a feature bundle for you.
588 There are two ways to load the C<feature> pragma implicitly:
594 By using the C<-E> switch on the Perl command-line instead of C<-e>.
595 That will enable the feature bundle for that version of Perl in the
596 main compilation unit (that is, the one-liner that follows C<-E>).
600 By explicitly requiring a minimum Perl version number for your program, with
601 the C<use VERSION> construct. That is,
610 and so on. Note how the trailing sub-version
611 is automatically stripped from the
614 But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
618 with the same effect.
620 If the required version is older than Perl 5.10, the ":default" feature
621 bundle is automatically loaded instead.
631 croak("No features specified");
640 # A bare C<no feature> should reset to the default bundle
642 $^H &= ~($hint_uni8bit|$hint_mask);
652 my $bundle_number = $^H & $hint_mask;
653 my $features = $bundle_number != $hint_mask
654 && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
656 # Features are enabled implicitly via bundle hints.
657 # Delete any keys that may be left over from last time.
658 delete @^H{ values(%feature) };
661 $^H{$feature{$_}} = 1;
662 $^H |= $hint_uni8bit if $_ eq 'unicode_strings';
667 if (substr($name, 0, 1) eq ":") {
668 my $v = substr($name, 1);
669 if (!exists $feature_bundle{$v}) {
670 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
671 if (!exists $feature_bundle{$v}) {
672 unknown_feature_bundle(substr($name, 1));
675 unshift @_, @{$feature_bundle{$v}};
678 if (!exists $feature{$name}) {
679 unknown_feature($name);
682 $^H{$feature{$name}} = 1;
683 $^H |= $hint_uni8bit if $name eq 'unicode_strings';
685 delete $^H{$feature{$name}};
686 $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
691 sub unknown_feature {
693 croak(sprintf('Feature "%s" is not supported by Perl %vd',
697 sub unknown_feature_bundle {
699 croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',