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