[perl #123514] Make prototype() imply $_

[perl5.git] / regen / regcomp.pl

diff --git a/regen/regcomp.pl b/regen/regcomp.pl
index 4a8b9d5..b90efc7 100644 (file)
--- a/regen/regcomp.pl
+++ b/regen/regcomp.pl
@@ -28,6 +28,7 @@ open DESC, 'regcomp.sym';
 my $ind = 0;
 my (@name,@rest,@type,@code,@args,@flags,@longj,@cmnt);
 my ($longest_name_length,$desc,$lastregop) = 0;
+my (%seen_op, %type_alias);
 while (<DESC>) {
     # Special pod comments
     if (/^#\* ?/) { $cmnt[$ind] .= "# $'"; }
@@ -43,8 +44,22 @@ while (<DESC>) {
     }
     unless ($lastregop) {
         ($name[$ind], $desc, $rest[$ind]) = /^(\S+)\s+([^\t]+?)\s*;\s*(.*)/;
+
+        if (defined $seen_op{$name[$ind]}) {
+            die "Duplicate regop $name[$ind] in regcomp.sym line $. previously defined on line $seen_op{$name[$ind]}\n";
+        } else {
+            $seen_op{$name[$ind]}= $.;
+        }
+
         ($type[$ind], $code[$ind], $args[$ind], $flags[$ind], $longj[$ind])
           = split /[,\s]\s*/, $desc;
+
+        if (!defined $seen_op{$type[$ind]} and !defined $type_alias{$type[$ind]}) {
+            #warn "Regop type '$type[$ind]' from regcomp.sym line $. is not an existing regop, and will be aliased to $name[$ind]\n"
+            #    if -t STDERR;
+            $type_alias{$type[$ind]}= $name[$ind];
+        }
+
         $longest_name_length = length $name[$ind]
           if length $name[$ind] > $longest_name_length;
         ++$ind;
@@ -148,10 +163,15 @@ EOP
     -$width, REGMATCH_STATE_MAX => $tot - 1
 ;
 
-
+my %rev_type_alias= reverse %type_alias;
 for ($ind=0; $ind < $lastregop ; ++$ind) {
   printf $out "#define\t%*s\t%d\t/* %#04x %s */\n",
     -$width, $name[$ind], $ind, $ind, $rest[$ind];
+  if (defined(my $alias= $rev_type_alias{$name[$ind]})) {
+      printf $out "#define\t%*s\t%d\t/* %#04x %s */\n",
+            -$width, $alias, $ind, $ind, "type alias";
+  }
+
 }
 print $out "\t/* ------------ States ------------- */\n";
 for ( ; $ind < $tot ; $ind++) {
@@ -261,6 +281,7 @@ my %rxfv;
 my %definitions;    # Remember what the symbol definitions are
 my $val = 0;
 my %reverse;
+my $REG_EXTFLAGS_NAME_SIZE = 0;
 foreach my $file ("op_reg_common.h", "regexp.h") {
     open FH,"<$file" or die "Can't read $file: $!";
     while (<FH>) {
@@ -332,6 +353,7 @@ for (0..31) {
     s/\bRXf_(PMf_)?// for $n, $extra;
     printf $out qq(\t%-20s/* 0x%08x%s */\n),
         qq("$n",),$power_of_2, $extra;
+    $REG_EXTFLAGS_NAME_SIZE++;
 }  
  
 print $out <<EOP;
@@ -339,6 +361,12 @@ print $out <<EOP;
 #endif /* DOINIT */
 
 EOP
+print $out <<EOQ
+#ifdef DEBUGGING
+#  define REG_EXTFLAGS_NAME_SIZE $REG_EXTFLAGS_NAME_SIZE
+#endif
+
+EOQ
 }
 {
 print $out <<EOP;
@@ -354,6 +382,7 @@ my %rxfv;
 my %definitions;    # Remember what the symbol definitions are
 my $val = 0;
 my %reverse;
+my $REG_INTFLAGS_NAME_SIZE = 0;
 foreach my $file ("regcomp.h") {
     open my $fh, "<", $file or die "Can't read $file: $!";
     while (<$fh>) {
@@ -369,6 +398,7 @@ foreach my $file ("regcomp.h") {
             $comment= $comment ? " - $comment" : "";
 
             printf $out qq(\t%-30s/* 0x%08x - %s%s */\n), qq("$abbr",), $val, $define, $comment;
+            $REG_INTFLAGS_NAME_SIZE++;
         }
     }
 }
@@ -378,8 +408,13 @@ print $out <<EOP;
 #endif /* DOINIT */
 
 EOP
-}
+print $out <<EOQ;
+#ifdef DEBUGGING
+#  define REG_INTFLAGS_NAME_SIZE $REG_INTFLAGS_NAME_SIZE
+#endif
 
+EOQ
+}
 
 print $out process_flags('V', 'varies', <<'EOC');
 /* The following have no fixed length. U8 so we can do strchr() on it. */