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