This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Increase $feature::VERSION to 1.31
[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 7#
3489ea76 8# from information hardcoded into this script and from two #defines
d73d634c 9# in perl.h.
69bcf1d3
FC
10#
11# This script is normally invoked from regen.pl.
12
13BEGIN {
14 require 'regen/regen_lib.pl';
15 push @INC, './lib';
16}
17use strict ;
18
c452a42f
FC
19
20###########################################################################
21# Hand-editable data
22
c6b36e45 23# (feature name) => (internal name, used in %^H and macro names)
69bcf1d3 24my %feature = (
67bdaa9e
FC
25 say => 'say',
26 state => 'state',
27 switch => 'switch',
28 evalbytes => 'evalbytes',
3fff3427 29 array_base => 'arybase',
67bdaa9e 30 current_sub => '__SUB__',
ebd25686 31 lexical_subs => 'lexsubs',
67bdaa9e
FC
32 unicode_eval => 'unieval',
33 unicode_strings => 'unicode',
2a4315f8 34 fc => 'fc',
69bcf1d3
FC
35);
36
40e4d872
FC
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.
40
52fc5c56 41# 5.odd implies the next 5.even, but an explicit 5.even can override it.
69bcf1d3 42my %feature_bundle = (
39ec54a5 43 all => [ keys %feature ],
3fff3427 44 default => [qw(array_base)],
69bcf1d3
FC
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)],
69bcf1d3 48 "5.13" => [qw(say state switch unicode_strings array_base)],
69bcf1d3 49 "5.15" => [qw(say state switch unicode_strings unicode_eval
2a4315f8 50 evalbytes current_sub fc)],
d6402ebe
RS
51 "5.17" => [qw(say state switch unicode_strings unicode_eval
52 evalbytes current_sub fc)],
69bcf1d3
FC
53);
54
ebd25686
FC
55my @experimental = qw( lexical_subs );
56
c452a42f 57
69bcf1d3 58###########################################################################
c452a42f 59# More data generated from the above
69bcf1d3 60
52fc5c56
FC
61for (keys %feature_bundle) {
62 next unless /^5\.(\d*[13579])\z/;
63 $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
64}
65
f2c01b15
FC
66my %UniqueBundles; # "say state switch" => 5.10
67my %Aliases; # 5.12 => 5.11
68for( sort keys %feature_bundle ) {
69 my $value = join(' ', sort @{$feature_bundle{$_}});
70 if (exists $UniqueBundles{$value}) {
71 $Aliases{$_} = $UniqueBundles{$value};
72 }
73 else {
74 $UniqueBundles{$value} = $_;
75 }
76}
40e4d872
FC
77 # start end
78my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
79for my $bund (
80 sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
81 values %UniqueBundles
82) {
03222170 83 next if $bund =~ /[^\d.]/ and $bund ne 'default';
40e4d872
FC
84 for (@{$feature_bundle{$bund}}) {
85 if (@{$BundleRanges{$_} ||= []} == 2) {
86 $BundleRanges{$_}[1] = $bund
87 }
88 else {
89 push @{$BundleRanges{$_}}, $bund;
90 }
91 }
92}
69bcf1d3 93
47222a2d 94my $HintShift;
ada44f8c 95my $HintMask;
3489ea76 96my $Uni8Bit;
47222a2d
FC
97
98open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!";
3489ea76
FC
99while (readline "perl.h") {
100 next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
101 my $is_u8b = $1 =~ 8;
102 /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
103 if ($is_u8b) {
104 $Uni8Bit = $1;
105 }
106 else {
ada44f8c 107 my $hex = $HintMask = $1;
47222a2d
FC
108 my $bits = sprintf "%b", oct $1;
109 $bits =~ /^0*1+(0*)\z/
110 or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
111 $HintShift = length $1;
112 my $bits_needed =
113 length sprintf "%b", scalar keys %UniqueBundles;
114 $bits =~ /1{$bits_needed}/
115 or die "Not enough bits (need $bits_needed)"
5d826eae 116 . " in $bits (binary for $hex):\n\n$_\n ";
47222a2d 117 }
3489ea76 118 if ($Uni8Bit && $HintMask) { last }
47222a2d 119}
3489ea76
FC
120die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
121die "No HINT_UNI_8_BIT defined in perl.h" unless $Uni8Bit;
122
47222a2d
FC
123close "perl.h";
124
ada44f8c
FC
125my @HintedBundles =
126 ('default', grep !/[^\d.]/, sort values %UniqueBundles);
127
47222a2d 128
f2c01b15 129###########################################################################
c452a42f 130# Open files to be generated
f2c01b15
FC
131
132my ($pm, $h) = map {
69bcf1d3 133 open_new($_, '>', { by => 'regen/feature.pl' });
f2c01b15 134} 'lib/feature.pm', 'feature.h';
69bcf1d3
FC
135
136
c452a42f
FC
137###########################################################################
138# Generate lib/feature.pm
139
69bcf1d3
FC
140while (<DATA>) {
141 last if /^FEATURES$/ ;
142 print $pm $_ ;
143}
144
145sub longest {
146 my $long;
147 for(@_) {
148 if (!defined $long or length $long < length) {
149 $long = $_;
150 }
151 }
152 $long;
153}
154
0bb01b05 155print $pm "our %feature = (\n";
69bcf1d3 156my $width = length longest keys %feature;
ebd25686 157for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
67bdaa9e
FC
158 print $pm " $_" . " "x($width-length)
159 . " => 'feature_$feature{$_}',\n";
69bcf1d3
FC
160}
161print $pm ");\n\n";
162
69bcf1d3 163print $pm "our %feature_bundle = (\n";
88da30d7
FC
164$width = length longest values %UniqueBundles;
165for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
166 keys %UniqueBundles ) {
167 my $bund = $UniqueBundles{$_};
168 print $pm qq' "$bund"' . " "x($width-length $bund)
169 . qq' => [qw($_)],\n';
69bcf1d3
FC
170}
171print $pm ");\n\n";
172
88da30d7
FC
173for (sort keys %Aliases) {
174 print $pm
175 qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
176};
69bcf1d3 177
ebd25686
FC
178print $pm "my \%experimental = (\n";
179print $pm " $_ => 1,\n", for @experimental;
180print $pm ");\n";
181
ada44f8c
FC
182print $pm <<EOPM;
183
0bb01b05
FC
184our \$hint_shift = $HintShift;
185our \$hint_mask = $HintMask;
186our \@hint_bundles = qw( @HintedBundles );
3489ea76
FC
187
188# This gets set (for now) in \$^H as well as in %^H,
189# for runtime speed of the uc/lc/ucfirst/lcfirst functions.
190# See HINT_UNI_8_BIT in perl.h.
191our \$hint_uni8bit = $Uni8Bit;
ada44f8c
FC
192EOPM
193
69bcf1d3
FC
194
195while (<DATA>) {
2b3fe414
FC
196 last if /^PODTURES$/ ;
197 print $pm $_ ;
198}
199
200select +(select($pm), $~ = 'PODTURES')[0];
201format PODTURES =
202 ^<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
203$::bundle, $::feature
204.
205
206for ('default', sort grep /\.\d[02468]/, keys %feature_bundle) {
207 $::bundle = ":$_";
208 $::feature = join ' ', @{$feature_bundle{$_}};
209 write $pm;
210 print $pm "\n";
211}
212
213while (<DATA>) {
69bcf1d3
FC
214 print $pm $_ ;
215}
216
217read_only_bottom_close_and_rename($pm);
218
c452a42f
FC
219
220###########################################################################
221# Generate feature.h
222
f2c01b15
FC
223print $h <<EOH;
224
225#if defined(PERL_CORE) || defined (PERL_EXT)
226
227#define HINT_FEATURE_SHIFT $HintShift
228
f2c01b15
FC
229EOH
230
231my $count;
016d11cb
FC
232for (@HintedBundles) {
233 (my $key = uc) =~ y/.//d;
234 print $h "#define FEATURE_BUNDLE_$key ", $count++, "\n";
f2c01b15
FC
235}
236
7d058bc9 237print $h <<'EOH';
2b9e0ab7 238#define FEATURE_BUNDLE_CUSTOM (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
f2c01b15 239
7d058bc9 240#define CURRENT_HINTS \
d1fd0100 241 (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
035b6821
FC
242#define CURRENT_FEATURE_BUNDLE \
243 ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
d1fd0100 244
fc4b5f72
NC
245/* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
246 the HP-UX cc on PA-RISC */
7d058bc9 247#define FEATURE_IS_ENABLED(name) \
ef744b29 248 ((CURRENT_HINTS \
7d058bc9 249 & HINT_LOCALIZE_HH) \
fc4b5f72 250 ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
7d058bc9 251/* The longest string we pass in. */
03222170
FC
252EOH
253
1b6e8741
FC
254my $longest_internal_feature_name = longest values %feature;
255print $h <<EOL;
256#define MAX_FEATURE_LEN (sizeof("$longest_internal_feature_name")-1)
257
258EOL
259
03222170 260for (
ebd25686 261 sort { length $a <=> length $b || $a cmp $b } keys %feature
03222170
FC
262) {
263 my($first,$last) =
264 map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
3fff3427 265 my $name = $feature{$_};
03222170 266 my $NAME = uc $name;
beda0318
FC
267 if ($last && $first eq 'DEFAULT') { # ‘>= DEFAULT’ warns
268 print $h <<EOI;
269#define FEATURE_$NAME\_IS_ENABLED \\
270 ( \\
271 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last \\
272 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
3fff3427 273 FEATURE_IS_ENABLED("$name")) \\
beda0318
FC
274 )
275
276EOI
277 }
278 elsif ($last) {
03222170
FC
279 print $h <<EOH3;
280#define FEATURE_$NAME\_IS_ENABLED \\
281 ( \\
282 (CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_$first && \\
283 CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_$last) \\
284 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
3fff3427 285 FEATURE_IS_ENABLED("$name")) \\
03222170
FC
286 )
287
288EOH3
289 }
ebd25686 290 elsif ($first) {
03222170
FC
291 print $h <<EOH4;
292#define FEATURE_$NAME\_IS_ENABLED \\
293 ( \\
294 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_$first \\
295 || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
3fff3427 296 FEATURE_IS_ENABLED("$name")) \\
03222170
FC
297 )
298
299EOH4
300 }
ebd25686
FC
301 else {
302 print $h <<EOH5;
303#define FEATURE_$NAME\_IS_ENABLED \\
304 ( \\
305 CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \\
306 FEATURE_IS_ENABLED("$name") \\
307 )
308
309EOH5
310 }
03222170
FC
311}
312
313print $h <<EOH;
314
f2c01b15 315#endif /* PERL_CORE or PERL_EXT */
4160ddbd
FC
316
317#ifdef PERL_IN_OP_C
318PERL_STATIC_INLINE void
319S_enable_feature_bundle(pTHX_ SV *ver)
320{
321 SV *comp_ver = sv_newmortal();
322 PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
323 | (
f2c01b15
FC
324EOH
325
4160ddbd
FC
326for (reverse @HintedBundles[1..$#HintedBundles]) { # skip default
327 my $numver = $_;
328 if ($numver eq '5.10') { $numver = '5.009005' } # special case
329 else { $numver =~ s/\./.0/ } # 5.11 => 5.011
330 (my $macrover = $_) =~ y/.//d;
331 print $h <<" EOK";
332 (sv_setnv(comp_ver, $numver),
333 vcmp(ver, upg_version(comp_ver, FALSE)) >= 0)
334 ? FEATURE_BUNDLE_$macrover :
335 EOK
336}
337
338print $h <<EOJ;
339 FEATURE_BUNDLE_DEFAULT
340 ) << HINT_FEATURE_SHIFT;
6389c777
FC
341 /* special case */
342 assert(PL_curcop == &PL_compiling);
343 if (FEATURE_UNICODE_IS_ENABLED) PL_hints |= HINT_UNI_8_BIT;
344 else PL_hints &= ~HINT_UNI_8_BIT;
4160ddbd
FC
345}
346#endif /* PERL_IN_OP_C */
347EOJ
348
f2c01b15
FC
349read_only_bottom_close_and_rename($h);
350
c452a42f
FC
351
352###########################################################################
353# Template for feature.pm
354
69bcf1d3
FC
355__END__
356package feature;
357
23d16d50 358our $VERSION = '1.31';
69bcf1d3
FC
359
360FEATURES
361
69bcf1d3
FC
362# TODO:
363# - think about versioned features (use feature switch => 2)
364
365=head1 NAME
366
367feature - Perl pragma to enable new features
368
369=head1 SYNOPSIS
370
371 use feature qw(say switch);
372 given ($foo) {
373 when (1) { say "\$foo == 1" }
374 when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
375 when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
376 when ($_ > 100) { say "\$foo > 100" }
377 default { say "None of the above" }
378 }
379
380 use feature ':5.10'; # loads all features available in perl 5.10
381
382 use v5.10; # implicitly loads :5.10 feature bundle
383
384=head1 DESCRIPTION
385
386It is usually impossible to add new syntax to Perl without breaking
387some existing programs. This pragma provides a way to minimize that
388risk. New syntactic constructs, or new semantic meanings to older
389constructs, can be enabled by C<use feature 'foo'>, and will be parsed
390only when the appropriate feature pragma is in scope. (Nevertheless, the
391C<CORE::> prefix provides access to all Perl keywords, regardless of this
392pragma.)
393
394=head2 Lexical effect
395
396Like other pragmas (C<use strict>, for example), features have a lexical
301381dc 397effect. C<use feature qw(foo)> will only make the feature "foo" available
69bcf1d3
FC
398from that point to the end of the enclosing block.
399
400 {
401 use feature 'say';
402 say "say is available here";
403 }
404 print "But not here.\n";
405
406=head2 C<no feature>
407
408Features can also be turned off by using C<no feature "foo">. This too
409has lexical effect.
410
411 use feature 'say';
412 say "say is available here";
413 {
414 no feature 'say';
415 print "But not here.\n";
416 }
417 say "Yet it is here.";
418
39ec54a5
RS
419C<no feature> with no features specified will reset to the default group. To
420disable I<all> features (an unusual request!) use C<no feature ':all'>.
69bcf1d3
FC
421
422=head1 AVAILABLE FEATURES
423
424=head2 The 'say' feature
425
426C<use feature 'say'> tells the compiler to enable the Perl 6 style
427C<say> function.
428
429See L<perlfunc/say> for details.
430
431This feature is available starting with Perl 5.10.
432
433=head2 The 'state' feature
434
435C<use feature 'state'> tells the compiler to enable C<state>
436variables.
437
438See L<perlsub/"Persistent Private Variables"> for details.
439
440This feature is available starting with Perl 5.10.
441
442=head2 The 'switch' feature
443
444C<use feature 'switch'> tells the compiler to enable the Perl 6
445given/when construct.
446
48238296 447See L<perlsyn/"Switch Statements"> for details.
69bcf1d3
FC
448
449This feature is available starting with Perl 5.10.
450
451=head2 The 'unicode_strings' feature
452
453C<use feature 'unicode_strings'> tells the compiler to use Unicode semantics
454in all string operations executed within its scope (unless they are also
455within the scope of either C<use locale> or C<use bytes>). The same applies
456to all regular expressions compiled within the scope, even if executed outside
2269d15c
KW
457it. It does not change the internal representation of strings, but only how
458they are interpreted.
69bcf1d3
FC
459
460C<no feature 'unicode_strings'> tells the compiler to use the traditional
461Perl semantics wherein the native character set semantics is used unless it is
462clear to Perl that Unicode is desired. This can lead to some surprises
463when the behavior suddenly changes. (See
464L<perlunicode/The "Unicode Bug"> for details.) For this reason, if you are
465potentially using Unicode in your program, the
466C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
467
2e2b2571
KW
468This feature is available starting with Perl 5.12; was almost fully
469implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>.
69bcf1d3
FC
470
471=head2 The 'unicode_eval' and 'evalbytes' features
472
473Under the C<unicode_eval> feature, Perl's C<eval> function, when passed a
474string, will evaluate it as a string of characters, ignoring any
475C<use utf8> declarations. C<use utf8> exists to declare the encoding of
476the script, which only makes sense for a stream of bytes, not a string of
477characters. Source filters are forbidden, as they also really only make
478sense on strings of bytes. Any attempt to activate a source filter will
479result in an error.
480
481The C<evalbytes> feature enables the C<evalbytes> keyword, which evaluates
482the argument passed to it as a string of bytes. It dies if the string
483contains any characters outside the 8-bit range. Source filters work
484within C<evalbytes>: they apply to the contents of the string being
485evaluated.
486
487Together, these two features are intended to replace the historical C<eval>
488function, which has (at least) two bugs in it, that cannot easily be fixed
489without breaking existing programs:
490
491=over
492
493=item *
494
495C<eval> behaves differently depending on the internal encoding of the
496string, sometimes treating its argument as a string of bytes, and sometimes
497as a string of characters.
498
499=item *
500
501Source filters activated within C<eval> leak out into whichever I<file>
502scope is currently being compiled. To give an example with the CPAN module
503L<Semi::Semicolons>:
504
505 BEGIN { eval "use Semi::Semicolons; # not filtered here " }
506 # filtered here!
507
508C<evalbytes> fixes that to work the way one would expect:
509
510 use feature "evalbytes";
511 BEGIN { evalbytes "use Semi::Semicolons; # filtered " }
512 # not filtered
513
514=back
515
516These two features are available starting with Perl 5.16.
517
518=head2 The 'current_sub' feature
519
520This provides the C<__SUB__> token that returns a reference to the current
521subroutine or C<undef> outside of a subroutine.
522
523This feature is available starting with Perl 5.16.
524
525=head2 The 'array_base' feature
526
527This feature supports the legacy C<$[> variable. See L<perlvar/$[> and
528L<arybase>. It is on by default but disabled under C<use v5.16> (see
529L</IMPLICIT LOADING>, below).
530
531This feature is available under this name starting with Perl 5.16. In
532previous versions, it was simply on all the time, and this pragma knew
533nothing about it.
534
2a4315f8
BF
535=head2 The 'fc' feature
536
537C<use feature 'fc'> tells the compiler to enable the C<fc> function,
538which implements Unicode casefolding.
539
540See L<perlfunc/fc> for details.
541
542This feature is available from Perl 5.16 onwards.
543
ca40957e
FC
544=head2 The 'lexical_subs' feature
545
546B<WARNING>: This feature is still experimental and the implementation may
547change in future versions of Perl. For this reason, F<feature.pm> will
548warn when you enable the feature, unless you have explicitly disabled the
549warning:
550
f1d34ca8 551 no warnings "experimental::lexical_subs";
ca40957e
FC
552
553This enables declaration of subroutines via C<my sub foo>, C<state sub foo>
554and C<our sub foo> syntax. See L<perlsub/Lexical Subroutines> for details.
555
556This feature is available from Perl 5.18 onwards.
557
69bcf1d3
FC
558=head1 FEATURE BUNDLES
559
560It's possible to load multiple features together, using
561a I<feature bundle>. The name of a feature bundle is prefixed with
562a colon, to distinguish it from an actual feature.
563
564 use feature ":5.10";
565
566The following feature bundles are available:
567
568 bundle features included
569 --------- -----------------
2b3fe414 570PODTURES
69bcf1d3
FC
571The C<:default> bundle represents the feature set that is enabled before
572any C<use feature> or C<no feature> declaration.
573
574Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
575no effect. Feature bundles are guaranteed to be the same for all sub-versions.
576
577 use feature ":5.14.0"; # same as ":5.14"
578 use feature ":5.14.1"; # same as ":5.14"
579
580=head1 IMPLICIT LOADING
581
582Instead of loading feature bundles by name, it is easier to let Perl do
583implicit loading of a feature bundle for you.
584
585There are two ways to load the C<feature> pragma implicitly:
586
587=over 4
588
589=item *
590
591By using the C<-E> switch on the Perl command-line instead of C<-e>.
592That will enable the feature bundle for that version of Perl in the
593main compilation unit (that is, the one-liner that follows C<-E>).
594
595=item *
596
597By explicitly requiring a minimum Perl version number for your program, with
598the C<use VERSION> construct. That is,
599
600 use v5.10.0;
601
602will do an implicit
603
39ec54a5 604 no feature ':all';
69bcf1d3
FC
605 use feature ':5.10';
606
607and so on. Note how the trailing sub-version
608is automatically stripped from the
609version.
610
611But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
612
613 use 5.010;
614
615with the same effect.
616
617If the required version is older than Perl 5.10, the ":default" feature
618bundle is automatically loaded instead.
619
620=back
621
622=cut
623
624sub import {
625 my $class = shift;
36143a0c
NC
626
627 if (!@_) {
69bcf1d3
FC
628 croak("No features specified");
629 }
36143a0c 630
d3757264 631 __common(1, @_);
69bcf1d3
FC
632}
633
634sub unimport {
635 my $class = shift;
636
39ec54a5 637 # A bare C<no feature> should reset to the default bundle
69bcf1d3 638 if (!@_) {
39ec54a5
RS
639 $^H &= ~($hint_uni8bit|$hint_mask);
640 return;
69bcf1d3
FC
641 }
642
d3757264
NC
643 __common(0, @_);
644}
645
646
647sub __common {
648 my $import = shift;
0c8d5017
NC
649 my $bundle_number = $^H & $hint_mask;
650 my $features = $bundle_number != $hint_mask
651 && $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
652 if ($features) {
da5b5421 653 # Features are enabled implicitly via bundle hints.
d9ee6ccb
NC
654 # Delete any keys that may be left over from last time.
655 delete @^H{ values(%feature) };
656 $^H |= $hint_mask;
657 for (@$features) {
658 $^H{$feature{$_}} = 1;
659 $^H |= $hint_uni8bit if $_ eq 'unicode_strings';
660 }
da5b5421 661 }
69bcf1d3
FC
662 while (@_) {
663 my $name = shift;
664 if (substr($name, 0, 1) eq ":") {
665 my $v = substr($name, 1);
666 if (!exists $feature_bundle{$v}) {
667 $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
668 if (!exists $feature_bundle{$v}) {
669 unknown_feature_bundle(substr($name, 1));
670 }
671 }
672 unshift @_, @{$feature_bundle{$v}};
673 next;
674 }
36143a0c 675 if (!exists $feature{$name}) {
69bcf1d3 676 unknown_feature($name);
69bcf1d3 677 }
d3757264
NC
678 if ($import) {
679 $^H{$feature{$name}} = 1;
680 $^H |= $hint_uni8bit if $name eq 'unicode_strings';
ebd25686
FC
681 if ($experimental{$name}) {
682 require warnings;
f1d34ca8 683 warnings::warnif("experimental::$name",
ebd25686
FC
684 "The $name feature is experimental");
685 }
d3757264 686 } else {
69bcf1d3
FC
687 delete $^H{$feature{$name}};
688 $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
689 }
690 }
691}
692
693sub unknown_feature {
694 my $feature = shift;
695 croak(sprintf('Feature "%s" is not supported by Perl %vd',
696 $feature, $^V));
697}
698
699sub unknown_feature_bundle {
700 my $feature = shift;
701 croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
702 $feature, $^V));
703}
704
705sub croak {
706 require Carp;
707 Carp::croak(@_);
708}
709
7101;