This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
feature.pl: %BundleRanges
[perl5.git] / regen / feature.pl
CommitLineData
69bcf1d3
FC
1#!/usr/bin/perl
2#
3# Regenerate (overwriting only if changed):
4#
5# lib/feature.pm
f2c01b15 6# feature.h
69bcf1d3
FC
7#
8# from information hardcoded into this script.
9#
10# This script is normally invoked from regen.pl.
11
12BEGIN {
13 require 'regen/regen_lib.pl';
14 push @INC, './lib';
15}
16use strict ;
17
18# (feature name) => (internal name, used in %^H)
19my %feature = (
67bdaa9e
FC
20 say => 'say',
21 state => 'state',
22 switch => 'switch',
23 evalbytes => 'evalbytes',
24 current_sub => '__SUB__',
25 unicode_eval => 'unieval',
26 unicode_strings => 'unicode',
69bcf1d3
FC
27);
28
29# These work backwards--the presence of the hint elem disables the feature:
30my %default_feature = (
61d30f47 31 array_base => 'noarybase',
69bcf1d3
FC
32);
33
40e4d872
FC
34# NOTE: If a feature is ever enabled in a non-contiguous range of Perl
35# versions, any code below that uses %BundleRanges will have to
36# be changed to account.
37
69bcf1d3
FC
38my %feature_bundle = (
39 default => [keys %default_feature],
40 "5.9.5" => [qw(say state switch array_base)],
41 "5.10" => [qw(say state switch array_base)],
42 "5.11" => [qw(say state switch unicode_strings array_base)],
43 "5.12" => [qw(say state switch unicode_strings array_base)],
44 "5.13" => [qw(say state switch unicode_strings array_base)],
45 "5.14" => [qw(say state switch unicode_strings array_base)],
46 "5.15" => [qw(say state switch unicode_strings unicode_eval
47 evalbytes current_sub)],
48 "5.16" => [qw(say state switch unicode_strings unicode_eval
49 evalbytes current_sub)],
50);
51
52###########################################################################
53
f2c01b15
FC
54my %UniqueBundles; # "say state switch" => 5.10
55my %Aliases; # 5.12 => 5.11
56for( sort keys %feature_bundle ) {
57 my $value = join(' ', sort @{$feature_bundle{$_}});
58 if (exists $UniqueBundles{$value}) {
59 $Aliases{$_} = $UniqueBundles{$value};
60 }
61 else {
62 $UniqueBundles{$value} = $_;
63 }
64}
40e4d872
FC
65 # start end
66my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
67for my $bund (
68 sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
69 values %UniqueBundles
70) {
71 for (@{$feature_bundle{$bund}}) {
72 if (@{$BundleRanges{$_} ||= []} == 2) {
73 $BundleRanges{$_}[1] = $bund
74 }
75 else {
76 push @{$BundleRanges{$_}}, $bund;
77 }
78 }
79}
69bcf1d3 80
f2c01b15
FC
81###########################################################################
82
83
84my ($pm, $h) = map {
69bcf1d3 85 open_new($_, '>', { by => 'regen/feature.pl' });
f2c01b15 86} 'lib/feature.pm', 'feature.h';
69bcf1d3
FC
87
88
89while (<DATA>) {
90 last if /^FEATURES$/ ;
91 print $pm $_ ;
92}
93
94sub longest {
95 my $long;
96 for(@_) {
97 if (!defined $long or length $long < length) {
98 $long = $_;
99 }
100 }
101 $long;
102}
103
104print $pm "my %feature = (\n";
105my $width = length longest keys %feature;
106for(sort { length $a <=> length $b } keys %feature) {
67bdaa9e
FC
107 print $pm " $_" . " "x($width-length)
108 . " => 'feature_$feature{$_}',\n";
69bcf1d3
FC
109}
110print $pm ");\n\n";
111
112print $pm "my %default_feature = (\n";
113$width = length longest keys %default_feature;
114for(sort { length $a <=> length $b } keys %default_feature) {
115 print $pm " $_" . " "x($width-length)
67bdaa9e 116 . " => 'feature_$default_feature{$_}',\n";
69bcf1d3
FC
117}
118print $pm ");\n\n";
119
120print $pm "our %feature_bundle = (\n";
88da30d7
FC
121$width = length longest values %UniqueBundles;
122for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
123 keys %UniqueBundles ) {
124 my $bund = $UniqueBundles{$_};
125 print $pm qq' "$bund"' . " "x($width-length $bund)
126 . qq' => [qw($_)],\n';
69bcf1d3
FC
127}
128print $pm ");\n\n";
129
88da30d7
FC
130for (sort keys %Aliases) {
131 print $pm
132 qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
133};
69bcf1d3
FC
134
135
136while (<DATA>) {
137 print $pm $_ ;
138}
139
140read_only_bottom_close_and_rename($pm);
141
f2c01b15
FC
142my $HintShift;
143
23a52d6b
FC
144open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!";
145perlh: {
146 while (readline "perl.h") {
147 next unless /#define\s+HINT_FEATURE_MASK/;
148 /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
149 my $hex = $1;
150 my $bits = sprintf "%b", oct $1;
f2c01b15 151 $bits =~ /^0*1+(0*)\z/
23a52d6b 152 or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
f2c01b15 153 $HintShift = length $1;
23a52d6b 154 my $bits_needed =
88da30d7 155 length sprintf "%b", scalar keys %UniqueBundles;
23a52d6b
FC
156 $bits =~ /1{$bits_needed}/
157 or die "Not enough bits (need $bits_needed)"
158 . " in $bits (binary for $hex):\n\n$_\n";
159 last perlh;
160 }
161 die "No HINT_FEATURE_MASK defined in perl.h";
162}
163close "perl.h";
164
f2c01b15
FC
165my $first_bit = sprintf "0x%08x", 1 << $HintShift;
166print $h <<EOH;
167
168#if defined(PERL_CORE) || defined (PERL_EXT)
169
170#define HINT_FEATURE_SHIFT $HintShift
171
172#define FEATURE_BUNDLE_DEFAULT 0
173EOH
174
175my $count;
176for (sort values %UniqueBundles) {
177 (my $key = $_) =~ y/.//d;
178 next if $key =~ /\D/;
179 print $h "#define FEATURE_BUNDLE_$key ", ++$count, "\n";
180}
181
182print $h <<EOH;
2b9e0ab7 183#define FEATURE_BUNDLE_CUSTOM (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
f2c01b15 184
d1fd0100
FC
185#define CURRENT_HINTS \\
186 (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
187#define CURRENT_FEATURE_BUNDLE (CURRENT_HINTS >> HINT_FEATURE_SHIFT)
188
f2c01b15
FC
189#endif /* PERL_CORE or PERL_EXT */
190EOH
191
192read_only_bottom_close_and_rename($h);
193
69bcf1d3
FC
194__END__
195package feature;
196
197our $VERSION = '1.25';
198
199FEATURES
200
201# This gets set (for now) in $^H as well as in %^H,
202# for runtime speed of the uc/lc/ucfirst/lcfirst functions.
203# See HINT_UNI_8_BIT in perl.h.
204our $hint_uni8bit = 0x00000800;
205
206# TODO:
207# - think about versioned features (use feature switch => 2)
208
209=head1 NAME
210
211feature - Perl pragma to enable new features
212
213=head1 SYNOPSIS
214
215 use feature qw(say switch);
216 given ($foo) {
217 when (1) { say "\$foo == 1" }
218 when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
219 when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
220 when ($_ > 100) { say "\$foo > 100" }
221 default { say "None of the above" }
222 }
223
224 use feature ':5.10'; # loads all features available in perl 5.10
225
226 use v5.10; # implicitly loads :5.10 feature bundle
227
228=head1 DESCRIPTION
229
230It is usually impossible to add new syntax to Perl without breaking
231some existing programs. This pragma provides a way to minimize that
232risk. New syntactic constructs, or new semantic meanings to older
233constructs, can be enabled by C<use feature 'foo'>, and will be parsed
234only when the appropriate feature pragma is in scope. (Nevertheless, the
235C<CORE::> prefix provides access to all Perl keywords, regardless of this
236pragma.)
237
238=head2 Lexical effect
239
240Like other pragmas (C<use strict>, for example), features have a lexical
241effect. C<use feature qw(foo)> will only make the feature "foo" available
242from that point to the end of the enclosing block.
243
244 {
245 use feature 'say';
246 say "say is available here";
247 }
248 print "But not here.\n";
249
250=head2 C<no feature>
251
252Features can also be turned off by using C<no feature "foo">. This too
253has lexical effect.
254
255 use feature 'say';
256 say "say is available here";
257 {
258 no feature 'say';
259 print "But not here.\n";
260 }
261 say "Yet it is here.";
262
263C<no feature> with no features specified will turn off all features.
264
265=head1 AVAILABLE FEATURES
266
267=head2 The 'say' feature
268
269C<use feature 'say'> tells the compiler to enable the Perl 6 style
270C<say> function.
271
272See L<perlfunc/say> for details.
273
274This feature is available starting with Perl 5.10.
275
276=head2 The 'state' feature
277
278C<use feature 'state'> tells the compiler to enable C<state>
279variables.
280
281See L<perlsub/"Persistent Private Variables"> for details.
282
283This feature is available starting with Perl 5.10.
284
285=head2 The 'switch' feature
286
287C<use feature 'switch'> tells the compiler to enable the Perl 6
288given/when construct.
289
290See L<perlsyn/"Switch statements"> for details.
291
292This feature is available starting with Perl 5.10.
293
294=head2 The 'unicode_strings' feature
295
296C<use feature 'unicode_strings'> tells the compiler to use Unicode semantics
297in all string operations executed within its scope (unless they are also
298within the scope of either C<use locale> or C<use bytes>). The same applies
299to all regular expressions compiled within the scope, even if executed outside
300it.
301
302C<no feature 'unicode_strings'> tells the compiler to use the traditional
303Perl semantics wherein the native character set semantics is used unless it is
304clear to Perl that Unicode is desired. This can lead to some surprises
305when the behavior suddenly changes. (See
306L<perlunicode/The "Unicode Bug"> for details.) For this reason, if you are
307potentially using Unicode in your program, the
308C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
309
310This feature is available starting with Perl 5.12, but was not fully
311implemented until Perl 5.14.
312
313=head2 The 'unicode_eval' and 'evalbytes' features
314
315Under the C<unicode_eval> feature, Perl's C<eval> function, when passed a
316string, will evaluate it as a string of characters, ignoring any
317C<use utf8> declarations. C<use utf8> exists to declare the encoding of
318the script, which only makes sense for a stream of bytes, not a string of
319characters. Source filters are forbidden, as they also really only make
320sense on strings of bytes. Any attempt to activate a source filter will
321result in an error.
322
323The C<evalbytes> feature enables the C<evalbytes> keyword, which evaluates
324the argument passed to it as a string of bytes. It dies if the string
325contains any characters outside the 8-bit range. Source filters work
326within C<evalbytes>: they apply to the contents of the string being
327evaluated.
328
329Together, these two features are intended to replace the historical C<eval>
330function, which has (at least) two bugs in it, that cannot easily be fixed
331without breaking existing programs:
332
333=over
334
335=item *
336
337C<eval> behaves differently depending on the internal encoding of the
338string, sometimes treating its argument as a string of bytes, and sometimes
339as a string of characters.
340
341=item *
342
343Source filters activated within C<eval> leak out into whichever I<file>
344scope is currently being compiled. To give an example with the CPAN module
345L<Semi::Semicolons>:
346
347 BEGIN { eval "use Semi::Semicolons; # not filtered here " }
348 # filtered here!
349
350C<evalbytes> fixes that to work the way one would expect:
351
352 use feature "evalbytes";
353 BEGIN { evalbytes "use Semi::Semicolons; # filtered " }
354 # not filtered
355
356=back
357
358These two features are available starting with Perl 5.16.
359
360=head2 The 'current_sub' feature
361
362This provides the C<__SUB__> token that returns a reference to the current
363subroutine or C<undef> outside of a subroutine.
364
365This feature is available starting with Perl 5.16.
366
367=head2 The 'array_base' feature
368
369This feature supports the legacy C<$[> variable. See L<perlvar/$[> and
370L<arybase>. It is on by default but disabled under C<use v5.16> (see
371L</IMPLICIT LOADING>, below).
372
373This feature is available under this name starting with Perl 5.16. In
374previous versions, it was simply on all the time, and this pragma knew
375nothing about it.
376
377=head1 FEATURE BUNDLES
378
379It's possible to load multiple features together, using
380a I<feature bundle>. The name of a feature bundle is prefixed with
381a colon, to distinguish it from an actual feature.
382
383 use feature ":5.10";
384
385The following feature bundles are available:
386
387 bundle features included
388 --------- -----------------
389 :default array_base
390
391 :5.10 say state switch array_base
392
393 :5.12 say state switch unicode_strings array_base
394
395 :5.14 say state switch unicode_strings array_base
396
397 :5.16 say state switch unicode_strings
398 unicode_eval evalbytes current_sub
399
400The C<:default> bundle represents the feature set that is enabled before
401any C<use feature> or C<no feature> declaration.
402
403Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
404no effect. Feature bundles are guaranteed to be the same for all sub-versions.
405
406 use feature ":5.14.0"; # same as ":5.14"
407 use feature ":5.14.1"; # same as ":5.14"
408
409=head1 IMPLICIT LOADING
410
411Instead of loading feature bundles by name, it is easier to let Perl do
412implicit loading of a feature bundle for you.
413
414There are two ways to load the C<feature> pragma implicitly:
415
416=over 4
417
418=item *
419
420By using the C<-E> switch on the Perl command-line instead of C<-e>.
421That will enable the feature bundle for that version of Perl in the
422main compilation unit (that is, the one-liner that follows C<-E>).
423
424=item *
425
426By explicitly requiring a minimum Perl version number for your program, with
427the C<use VERSION> construct. That is,
428
429 use v5.10.0;
430
431will do an implicit
432
433 no feature;
434 use feature ':5.10';
435
436and so on. Note how the trailing sub-version
437is automatically stripped from the
438version.
439
440But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
441
442 use 5.010;
443
444with the same effect.
445
446If the required version is older than Perl 5.10, the ":default" feature
447bundle is automatically loaded instead.
448
449=back
450
451=cut
452
453sub import {
454 my $class = shift;
455 if (@_ == 0) {
456 croak("No features specified");
457 }
458 while (@_) {
459 my $name = shift(@_);
460 if (substr($name, 0, 1) eq ":") {
461 my $v = substr($name, 1);
462 if (!exists $feature_bundle{$v}) {
463 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
464 if (!exists $feature_bundle{$v}) {
465 unknown_feature_bundle(substr($name, 1));
466 }
467 }
468 unshift @_, @{$feature_bundle{$v}};
469 next;
470 }
471 if (!exists $feature{$name}) {
472 if (!exists $default_feature{$name}) {
473 unknown_feature($name);
474 }
475 delete $^H{$default_feature{$name}}; next;
476 }
477 $^H{$feature{$name}} = 1;
478 $^H |= $hint_uni8bit if $name eq 'unicode_strings';
479 }
480}
481
482sub unimport {
483 my $class = shift;
484
485 # A bare C<no feature> should disable *all* features
486 if (!@_) {
487 delete @^H{ values(%feature) };
488 $^H &= ~ $hint_uni8bit;
489 @^H{ values(%default_feature) } = (1) x keys %default_feature;
490 return;
491 }
492
493 while (@_) {
494 my $name = shift;
495 if (substr($name, 0, 1) eq ":") {
496 my $v = substr($name, 1);
497 if (!exists $feature_bundle{$v}) {
498 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
499 if (!exists $feature_bundle{$v}) {
500 unknown_feature_bundle(substr($name, 1));
501 }
502 }
503 unshift @_, @{$feature_bundle{$v}};
504 next;
505 }
506 if (!exists($feature{$name})) {
507 if (!exists $default_feature{$name}) {
508 unknown_feature($name);
509 }
510 $^H{$default_feature{$name}} = 1; next;
511 }
512 else {
513 delete $^H{$feature{$name}};
514 $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
515 }
516 }
517}
518
519sub unknown_feature {
520 my $feature = shift;
521 croak(sprintf('Feature "%s" is not supported by Perl %vd',
522 $feature, $^V));
523}
524
525sub unknown_feature_bundle {
526 my $feature = shift;
527 croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
528 $feature, $^V));
529}
530
531sub croak {
532 require Carp;
533 Carp::croak(@_);
534}
535
5361;