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     array_base      => 'arybase',
  30     current_sub     => '__SUB__',
  31     lexical_subs    => 'lexsubs',
  32     unicode_eval    => 'unieval',
  33     unicode_strings => 'unicode',
  34     fc              => 'fc',
  35 );
  36
  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
  41 # 5.odd implies the next 5.even, but an explicit 5.even can override it.
  42 my %feature_bundle = (
  43      all     => [ keys %feature ],
  44      default => [qw(array_base)],
  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)],
  48     "5.13"   => [qw(say state switch unicode_strings array_base)],
  49     "5.15"   => [qw(say state switch unicode_strings unicode_eval
  50                     evalbytes current_sub fc)],
  51     "5.17"   => [qw(say state switch unicode_strings unicode_eval
  52                     evalbytes current_sub fc)],
  53 );
  54
  55 my @experimental = qw( lexical_subs );
  56
  57
  58 ###########################################################################
  59 # More data generated from the above
  60
  61 for (keys %feature_bundle) {
  62     next unless /^5\.(\d*[13579])\z/;
  63     $feature_bundle{"5.".($1+1)} ||= $feature_bundle{$_};
  64 }
  65
  66 my %UniqueBundles; # "say state switch" => 5.10
  67 my %Aliases;       #  5.12 => 5.11
  68 for( 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 }
  77                            # start   end
  78 my %BundleRanges; # say => ['5.10', '5.15'] # unique bundles for values
  79 for my $bund (
  80     sort { $a eq 'default' ? -1 : $b eq 'default' ? 1 : $a cmp $b }
  81          values %UniqueBundles
  82 ) {
  83     next if $bund =~ /[^\d.]/ and $bund ne 'default';
  84     for (@{$feature_bundle{$bund}}) {
  85         if (@{$BundleRanges{$_} ||= []} == 2) {
  86             $BundleRanges{$_}[1] = $bund
  87         }
  88         else {
  89             push @{$BundleRanges{$_}}, $bund;
  90         }
  91     }
  92 }
  93
  94 my $HintShift;
  95 my $HintMask;
  96 my $Uni8Bit;
  97
  98 open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!";
  99 while (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 {
 107         my $hex = $HintMask = $1;
 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)"
 116                  . " in $bits (binary for $hex):\n\n$_\n ";
 117     }
 118     if ($Uni8Bit && $HintMask) { last }
 119 }
 120 die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
 121 die "No HINT_UNI_8_BIT defined in perl.h"    unless $Uni8Bit;
 122
 123 close "perl.h";
 124
 125 my @HintedBundles =
 126     ('default', grep !/[^\d.]/, sort values %UniqueBundles);
 127
 128
 129 ###########################################################################
 130 # Open files to be generated
 131
 132 my ($pm, $h) = map {
 133     open_new($_, '>', { by => 'regen/feature.pl' });
 134 } 'lib/feature.pm', 'feature.h';
 135
 136
 137 ###########################################################################
 138 # Generate lib/feature.pm
 139
 140 while (<DATA>) {
 141     last if /^FEATURES$/ ;
 142     print $pm $_ ;
 143 }
 144
 145 sub longest {
 146     my $long;
 147     for(@_) {
 148         if (!defined $long or length $long < length) {
 149             $long = $_;
 150         }
 151     }
 152     $long;
 153 }
 154
 155 print $pm "our %feature = (\n";
 156 my $width = length longest keys %feature;
 157 for(sort { length $a <=> length $b || $a cmp $b } keys %feature) {
 158     print $pm "    $_" . " "x($width-length)
 159             . " => 'feature_$feature{$_}',\n";
 160 }
 161 print $pm ");\n\n";
 162
 163 print $pm "our %feature_bundle = (\n";
 164 $width = length longest values %UniqueBundles;
 165 for( 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';
 170 }
 171 print $pm ");\n\n";
 172
 173 for (sort keys %Aliases) {
 174     print $pm
 175         qq'\$feature_bundle{"$_"} = \$feature_bundle{"$Aliases{$_}"};\n';
 176 };
 177
 178 print $pm "my \%experimental = (\n";
 179 print $pm "    $_ => 1,\n", for @experimental;
 180 print $pm ");\n";
 181
 182 print $pm <<EOPM;
 183
 184 our \$hint_shift   = $HintShift;
 185 our \$hint_mask    = $HintMask;
 186 our \@hint_bundles = qw( @HintedBundles );
 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.
 191 our \$hint_uni8bit = $Uni8Bit;
 192 EOPM
 193
 194
 195 while (<DATA>) {
 196     last if /^PODTURES$/ ;
 197     print $pm $_ ;
 198 }
 199
 200 select +(select($pm), $~ = 'PODTURES')[0];
 201 format PODTURES =
 202   ^<<<<<<<< ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
 203 $::bundle, $::feature
 204 .
 205
 206 for ('default', sort grep /\.\d[02468]/, keys %feature_bundle) {
 207     $::bundle = ":$_";
 208     $::feature = join ' ', @{$feature_bundle{$_}};
 209     write $pm;
 210     print $pm "\n";
 211 }
 212
 213 while (<DATA>) {
 214     print $pm $_ ;
 215 }
 216
 217 read_only_bottom_close_and_rename($pm);
 218
 219
 220 ###########################################################################
 221 # Generate feature.h
 222
 223 print $h <<EOH;
 224
 225 #if defined(PERL_CORE) || defined (PERL_EXT)
 226
 227 #define HINT_FEATURE_SHIFT      $HintShift
 228
 229 EOH
 230
 231 my $count;
 232 for (@HintedBundles) {
 233     (my $key = uc) =~ y/.//d;
 234     print $h "#define FEATURE_BUNDLE_$key       ", $count++, "\n";
 235 }
 236
 237 print $h <<'EOH';
 238 #define FEATURE_BUNDLE_CUSTOM   (HINT_FEATURE_MASK >> HINT_FEATURE_SHIFT)
 239
 240 #define CURRENT_HINTS \
 241     (PL_curcop == &PL_compiling ? PL_hints : PL_curcop->cop_hints)
 242 #define CURRENT_FEATURE_BUNDLE \
 243     ((CURRENT_HINTS & HINT_FEATURE_MASK) >> HINT_FEATURE_SHIFT)
 244
 245 /* Avoid using ... && Perl_feature_is_enabled(...) as that triggers a bug in
 246    the HP-UX cc on PA-RISC */
 247 #define FEATURE_IS_ENABLED(name)                                        \
 248         ((CURRENT_HINTS                                                  \
 249            & HINT_LOCALIZE_HH)                                            \
 250             ? Perl_feature_is_enabled(aTHX_ STR_WITH_LEN(name)) : FALSE)
 251 /* The longest string we pass in.  */
 252 EOH
 253
 254 my $longest_internal_feature_name = longest values %feature;
 255 print $h <<EOL;
 256 #define MAX_FEATURE_LEN (sizeof("$longest_internal_feature_name")-1)
 257
 258 EOL
 259
 260 for (
 261     sort { length $a <=> length $b || $a cmp $b } keys %feature
 262 ) {
 263     my($first,$last) =
 264         map { (my $__ = uc) =~ y/.//d; $__ } @{$BundleRanges{$_}};
 265     my $name = $feature{$_};
 266     my $NAME = uc $name;
 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 && \\
 273          FEATURE_IS_ENABLED("$name")) \\
 274     )
 275
 276 EOI
 277     }
 278     elsif ($last) {
 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 && \\
 285          FEATURE_IS_ENABLED("$name")) \\
 286     )
 287
 288 EOH3
 289     }
 290     elsif ($first) {
 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 && \\
 296          FEATURE_IS_ENABLED("$name")) \\
 297     )
 298
 299 EOH4
 300     }
 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
 309 EOH5
 310     }
 311 }
 312
 313 print $h <<EOH;
 314
 315 #endif /* PERL_CORE or PERL_EXT */
 316
 317 #ifdef PERL_IN_OP_C
 318 PERL_STATIC_INLINE void
 319 S_enable_feature_bundle(pTHX_ SV *ver)
 320 {
 321     SV *comp_ver = sv_newmortal();
 322     PL_hints = (PL_hints &~ HINT_FEATURE_MASK)
 323              | (
 324 EOH
 325
 326 for (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
 338 print $h <<EOJ;
 339                           FEATURE_BUNDLE_DEFAULT
 340                ) << HINT_FEATURE_SHIFT;
 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;
 345 }
 346 #endif /* PERL_IN_OP_C */
 347 EOJ
 348
 349 read_only_bottom_close_and_rename($h);
 350
 351
 352 ###########################################################################
 353 # Template for feature.pm
 354
 355 __END__
 356 package feature;
 357
 358 our $VERSION = '1.31';
 359
 360 FEATURES
 361
 362 # TODO:
 363 # - think about versioned features (use feature switch => 2)
 364
 365 =head1 NAME
 366
 367 feature - 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
 386 It is usually impossible to add new syntax to Perl without breaking
 387 some existing programs.  This pragma provides a way to minimize that
 388 risk. New syntactic constructs, or new semantic meanings to older
 389 constructs, can be enabled by C<use feature 'foo'>, and will be parsed
 390 only when the appropriate feature pragma is in scope.  (Nevertheless, the
 391 C<CORE::> prefix provides access to all Perl keywords, regardless of this
 392 pragma.)
 393
 394 =head2 Lexical effect
 395
 396 Like other pragmas (C<use strict>, for example), features have a lexical
 397 effect.  C<use feature qw(foo)> will only make the feature "foo" available
 398 from 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
 408 Features can also be turned off by using C<no feature "foo">.  This too
 409 has 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
 419 C<no feature> with no features specified will reset to the default group.  To
 420 disable I<all> features (an unusual request!) use C<no feature ':all'>.
 421
 422 =head1 AVAILABLE FEATURES
 423
 424 =head2 The 'say' feature
 425
 426 C<use feature 'say'> tells the compiler to enable the Perl 6 style
 427 C<say> function.
 428
 429 See L<perlfunc/say> for details.
 430
 431 This feature is available starting with Perl 5.10.
 432
 433 =head2 The 'state' feature
 434
 435 C<use feature 'state'> tells the compiler to enable C<state>
 436 variables.
 437
 438 See L<perlsub/"Persistent Private Variables"> for details.
 439
 440 This feature is available starting with Perl 5.10.
 441
 442 =head2 The 'switch' feature
 443
 444 C<use feature 'switch'> tells the compiler to enable the Perl 6
 445 given/when construct.
 446
 447 See L<perlsyn/"Switch Statements"> for details.
 448
 449 This feature is available starting with Perl 5.10.
 450
 451 =head2 The 'unicode_strings' feature
 452
 453 C<use feature 'unicode_strings'> tells the compiler to use Unicode semantics
 454 in all string operations executed within its scope (unless they are also
 455 within the scope of either C<use locale> or C<use bytes>).  The same applies
 456 to all regular expressions compiled within the scope, even if executed outside
 457 it.  It does not change the internal representation of strings, but only how
 458 they are interpreted.
 459
 460 C<no feature 'unicode_strings'> tells the compiler to use the traditional
 461 Perl semantics wherein the native character set semantics is used unless it is
 462 clear to Perl that Unicode is desired.  This can lead to some surprises
 463 when the behavior suddenly changes.  (See
 464 L<perlunicode/The "Unicode Bug"> for details.)  For this reason, if you are
 465 potentially using Unicode in your program, the
 466 C<use feature 'unicode_strings'> subpragma is B<strongly> recommended.
 467
 468 This feature is available starting with Perl 5.12; was almost fully
 469 implemented in Perl 5.14; and extended in Perl 5.16 to cover C<quotemeta>.
 470
 471 =head2 The 'unicode_eval' and 'evalbytes' features
 472
 473 Under the C<unicode_eval> feature, Perl's C<eval> function, when passed a
 474 string, will evaluate it as a string of characters, ignoring any
 475 C<use utf8> declarations.  C<use utf8> exists to declare the encoding of
 476 the script, which only makes sense for a stream of bytes, not a string of
 477 characters.  Source filters are forbidden, as they also really only make
 478 sense on strings of bytes.  Any attempt to activate a source filter will
 479 result in an error.
 480
 481 The C<evalbytes> feature enables the C<evalbytes> keyword, which evaluates
 482 the argument passed to it as a string of bytes.  It dies if the string
 483 contains any characters outside the 8-bit range.  Source filters work
 484 within C<evalbytes>: they apply to the contents of the string being
 485 evaluated.
 486
 487 Together, these two features are intended to replace the historical C<eval>
 488 function, which has (at least) two bugs in it, that cannot easily be fixed
 489 without breaking existing programs:
 490
 491 =over
 492
 493 =item *
 494
 495 C<eval> behaves differently depending on the internal encoding of the
 496 string, sometimes treating its argument as a string of bytes, and sometimes
 497 as a string of characters.
 498
 499 =item *
 500
 501 Source filters activated within C<eval> leak out into whichever I<file>
 502 scope is currently being compiled.  To give an example with the CPAN module
 503 L<Semi::Semicolons>:
 504
 505     BEGIN { eval "use Semi::Semicolons;  # not filtered here " }
 506     # filtered here!
 507
 508 C<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
 516 These two features are available starting with Perl 5.16.
 517
 518 =head2 The 'current_sub' feature
 519
 520 This provides the C<__SUB__> token that returns a reference to the current
 521 subroutine or C<undef> outside of a subroutine.
 522
 523 This feature is available starting with Perl 5.16.
 524
 525 =head2 The 'array_base' feature
 526
 527 This feature supports the legacy C<$[> variable.  See L<perlvar/$[> and
 528 L<arybase>.  It is on by default but disabled under C<use v5.16> (see
 529 L</IMPLICIT LOADING>, below).
 530
 531 This feature is available under this name starting with Perl 5.16.  In
 532 previous versions, it was simply on all the time, and this pragma knew
 533 nothing about it.
 534
 535 =head2 The 'fc' feature
 536
 537 C<use feature 'fc'> tells the compiler to enable the C<fc> function,
 538 which implements Unicode casefolding.
 539
 540 See L<perlfunc/fc> for details.
 541
 542 This feature is available from Perl 5.16 onwards.
 543
 544 =head2 The 'lexical_subs' feature
 545
 546 B<WARNING>: This feature is still experimental and the implementation may
 547 change in future versions of Perl.  For this reason, F<feature.pm> will
 548 warn when you enable the feature, unless you have explicitly disabled the
 549 warning:
 550
 551     no warnings "experimental::lexical_subs";
 552
 553 This enables declaration of subroutines via C<my sub foo>, C<state sub foo>
 554 and C<our sub foo> syntax.  See L<perlsub/Lexical Subroutines> for details.
 555
 556 This feature is available from Perl 5.18 onwards.
 557
 558 =head1 FEATURE BUNDLES
 559
 560 It's possible to load multiple features together, using
 561 a I<feature bundle>.  The name of a feature bundle is prefixed with
 562 a colon, to distinguish it from an actual feature.
 563
 564   use feature ":5.10";
 565
 566 The following feature bundles are available:
 567
 568   bundle    features included
 569   --------- -----------------
 570 PODTURES
 571 The C<:default> bundle represents the feature set that is enabled before
 572 any C<use feature> or C<no feature> declaration.
 573
 574 Specifying sub-versions such as the C<0> in C<5.14.0> in feature bundles has
 575 no 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
 582 Instead of loading feature bundles by name, it is easier to let Perl do
 583 implicit loading of a feature bundle for you.
 584
 585 There are two ways to load the C<feature> pragma implicitly:
 586
 587 =over 4
 588
 589 =item *
 590
 591 By using the C<-E> switch on the Perl command-line instead of C<-e>.
 592 That will enable the feature bundle for that version of Perl in the
 593 main compilation unit (that is, the one-liner that follows C<-E>).
 594
 595 =item *
 596
 597 By explicitly requiring a minimum Perl version number for your program, with
 598 the C<use VERSION> construct.  That is,
 599
 600     use v5.10.0;
 601
 602 will do an implicit
 603
 604     no feature ':all';
 605     use feature ':5.10';
 606
 607 and so on.  Note how the trailing sub-version
 608 is automatically stripped from the
 609 version.
 610
 611 But to avoid portability warnings (see L<perlfunc/use>), you may prefer:
 612
 613     use 5.010;
 614
 615 with the same effect.
 616
 617 If the required version is older than Perl 5.10, the ":default" feature
 618 bundle is automatically loaded instead.
 619
 620 =back
 621
 622 =cut
 623
 624 sub import {
 625     my $class = shift;
 626
 627     if (!@_) {
 628         croak("No features specified");
 629     }
 630
 631     __common(1, @_);
 632 }
 633
 634 sub unimport {
 635     my $class = shift;
 636
 637     # A bare C<no feature> should reset to the default bundle
 638     if (!@_) {
 639         $^H &= ~($hint_uni8bit|$hint_mask);
 640         return;
 641     }
 642
 643     __common(0, @_);
 644 }
 645
 646
 647 sub __common {
 648     my $import = shift;
 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) {
 653         # Features are enabled implicitly via bundle hints.
 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         }
 661     }
 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         }
 675         if (!exists $feature{$name}) {
 676             unknown_feature($name);
 677         }
 678         if ($import) {
 679             $^H{$feature{$name}} = 1;
 680             $^H |= $hint_uni8bit if $name eq 'unicode_strings';
 681             if ($experimental{$name}) {
 682                 require warnings;
 683                 warnings::warnif("experimental::$name",
 684                                  "The $name feature is experimental");
 685             }
 686         } else {
 687             delete $^H{$feature{$name}};
 688             $^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
 689         }
 690     }
 691 }
 692
 693 sub unknown_feature {
 694     my $feature = shift;
 695     croak(sprintf('Feature "%s" is not supported by Perl %vd',
 696             $feature, $^V));
 697 }
 698
 699 sub unknown_feature_bundle {
 700     my $feature = shift;
 701     croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
 702             $feature, $^V));
 703 }
 704
 705 sub croak {
 706     require Carp;
 707     Carp::croak(@_);
 708 }
 709
 710 1;