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