regen/feature.pl - use regen/HeaderParser to parse perl.h

[perl5.git] / regen / feature.pl

diff --git a/regen/feature.pl b/regen/feature.pl
index 031f1a8..d315253 100755 (executable)
--- a/regen/feature.pl
+++ b/regen/feature.pl
@@ -11,8 +11,9 @@
 # This script is normally invoked from regen.pl.
 
 BEGIN {
-    require './regen/regen_lib.pl';
     push @INC, './lib';
+    require './regen/regen_lib.pl';
+    require './regen/HeaderParser.pm';
 }
 
 use strict;
@@ -23,27 +24,27 @@ use warnings;
 
 # (feature name) => (internal name, used in %^H and macro names)
 my %feature = (
-    say             => 'say',
-    state           => 'state',
-    switch          => 'switch',
-    bitwise         => 'bitwise',
-    evalbytes       => 'evalbytes',
-    current_sub     => '__SUB__',
-    refaliasing     => 'refaliasing',
-    postderef_qq    => 'postderef_qq',
-    unicode_eval    => 'unieval',
-    declared_refs   => 'myref',
-    unicode_strings => 'unicode',
-    fc              => 'fc',
-    signatures      => 'signatures',
-    isa             => 'isa',
-    indirect        => 'indirect',
-    multidimensional => 'multidimensional',
-    bareword_filehandles => 'bareword_filehandles',
-    try             => 'try',
-    defer           => 'defer',
+    say                     => 'say',
+    state                   => 'state',
+    switch                  => 'switch',
+    bitwise                 => 'bitwise',
+    evalbytes               => 'evalbytes',
+    current_sub             => '__SUB__',
+    refaliasing             => 'refaliasing',
+    postderef_qq            => 'postderef_qq',
+    unicode_eval            => 'unieval',
+    declared_refs           => 'myref',
+    unicode_strings         => 'unicode',
+    fc                      => 'fc',
+    signatures              => 'signatures',
+    isa                     => 'isa',
+    indirect                => 'indirect',
+    multidimensional        => 'multidimensional',
+    bareword_filehandles    => 'bareword_filehandles',
+    try                     => 'try',
+    defer                   => 'defer',
     extra_paired_delimiters => 'more_delims',
-    module_true => 'module_true',
+    module_true             => 'module_true',
 );
 
 # NOTE: If a feature is ever enabled in a non-contiguous range of Perl
@@ -150,12 +151,15 @@ for my $bund (
 my $HintShift;
 my $HintMask;
 my $Uni8Bit;
+my $hp = HeaderParser->new()->read_file("perl.h");
 
-open "perl.h", "<", "perl.h" or die "$0 cannot open perl.h: $!";
-while (readline "perl.h") {
-    next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
+foreach my $line_data (@{$hp->lines}) {
+    next unless $line_data->{type} eq "content"
+            and $line_data->{sub_type} eq "#define";
+    my $line = $line_data->{line};
+    next unless $line=~/^\s*#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/;
     my $is_u8b = $1 =~ 8;
-    /(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$_\n ";
+    $line=~/(0x[A-Fa-f0-9]+)/ or die "No hex number in:\n\n$line\n ";
     if ($is_u8b) {
        $Uni8Bit = $1;
     }
@@ -163,21 +167,19 @@ while (readline "perl.h") {
        my $hex = $HintMask = $1;
        my $bits = sprintf "%b", oct $1;
        $bits =~ /^0*1+(0*)\z/
-        or die "Non-contiguous bits in $bits (binary for $hex):\n\n$_\n ";
+         or die "Non-contiguous bits in $bits (binary for $hex):\n\n$line\n ";
        $HintShift = length $1;
        my $bits_needed =
            length sprintf "%b", scalar keys %UniqueBundles;
        $bits =~ /1{$bits_needed}/
            or die "Not enough bits (need $bits_needed)"
-                . " in $bits (binary for $hex):\n\n$_\n ";
+                 . " in $bits (binary for $hex):\n\n$line\n ";
     }
     if ($Uni8Bit && $HintMask) { last }
 }
 die "No HINT_FEATURE_MASK defined in perl.h" unless $HintMask;
 die "No HINT_UNI_8_BIT defined in perl.h"    unless $Uni8Bit;
 
-close "perl.h";
-
 my @HintedBundles =
     ('default', grep !/[^\d.]/, sort values %UniqueBundles);
 
@@ -498,7 +500,7 @@ read_only_bottom_close_and_rename($h);
 
 __END__
 package feature;
-our $VERSION = '1.77';
+our $VERSION = '1.78';
 
 FEATURES
 
@@ -692,9 +694,10 @@ regardless of what feature declarations are in scope.
 =head2 The 'postderef' and 'postderef_qq' features
 
 The 'postderef_qq' feature extends the applicability of L<postfix
-dereference syntax|perlref/Postfix Dereference Syntax> so that postfix array
-and scalar dereference are available in double-quotish interpolations. For
-example, it makes the following two statements equivalent:
+dereference syntax|perlref/Postfix Dereference Syntax> so that
+postfix array dereference, postfix scalar dereference, and
+postfix array highest index access are available in double-quotish interpolations.
+For example, it makes the following two statements equivalent:
 
   my $s = "[@{ $h->{a} }]";
   my $s = "[$h->{a}->@*]";