regen/embed.pl: Keep parsing for some fatal issues
authorKarl Williamson <khw@cpan.org>
Mon, 12 Dec 2016 21:37:37 +0000 (14:37 -0700)
committerKarl Williamson <khw@cpan.org>
Wed, 14 Dec 2016 17:45:02 +0000 (10:45 -0700)
It's best to list all errors in a single run.  This creates a mechanism
to do so and uses it in a few places.

regen/embed.pl

index 9b432ba..4b39e15 100755 (executable)
@@ -39,6 +39,13 @@ my $unflagged_pointers;
 # implicit interpreter context argument.
 #
 
+my $error_count = 0;
+sub die_at_end ($) { # Keeps going for now, but makes sure the regen doesn't
+                     # succeed.
+    warn shift;
+    $error_count++;
+}
+
 sub full_name ($$) { # Returns the function name with potentially the
                     # prefixes 'S_' or 'Perl_'
     my ($func, $flags) = @_;
@@ -75,7 +82,7 @@ my ($embed, $core, $ext, $api) = setup_embed();
 
        my ($flags,$retval,$plain_func,@args) = @$_;
         if ($flags =~ / ( [^AabDdEfiMmnOoPpRrsUWXx] ) /x) {
-           warn "flag $1 is not legal (for function $plain_func)";
+           die_at_end "flag $1 is not legal (for function $plain_func)";
        }
        my @nonnull;
         my $has_depth = ( $flags =~ /W/ );
@@ -92,7 +99,7 @@ my ($embed, $core, $ext, $api) = setup_embed();
            warn "It is nonsensical to require the return value of a void function ($plain_func) to be checked";
        }
 
-       warn "$plain_func: s flag is mutually exclusive from the i and p plags"
+       die_at_end "$plain_func: s flag is mutually exclusive from the i and p plags"
                                            if $flags =~ /s/ && $flags =~ /[ip]/;
 
        if ($flags =~ /([si])/) {
@@ -140,7 +147,7 @@ my ($embed, $core, $ext, $api) = setup_embed();
                $temp_arg =~ s/\s*\bstruct\b\s*/ /g;
                if ( ($temp_arg ne "...")
                     && ($temp_arg !~ /\w+\s+(\w+)(?:\[\d+\])?\s*$/) ) {
-                   warn "$func: $arg ($n) doesn't have a name\n";
+                   die_at_end "$func: $arg ($n) doesn't have a name\n";
                }
                if (defined $1 && $nn && !($commented_out && !$binarycompat)) {
                    push @names_of_nn, $1;
@@ -221,10 +228,10 @@ my ($embed, $core, $ext, $api) = setup_embed();
 END_EXTERN_C
 EOF
 
-    read_only_bottom_close_and_rename($pr);
+    read_only_bottom_close_and_rename($pr) if ! $error_count;
 }
 
-warn "$unflagged_pointers pointer arguments to clean up\n" if $unflagged_pointers;
+die_at_end "$unflagged_pointers pointer arguments to clean up\n" if $unflagged_pointers;
 
 sub readvars {
     my ($file, $pre) = @_;
@@ -235,7 +242,7 @@ sub readvars {
     while (<FILE>) {
        s/[ \t]*#.*//;          # Delete comments.
        if (/PERLVARA?I?C?\($pre,\s*(\w+)/) {
-           warn "duplicate symbol $1 while processing $file line $.\n"
+           die_at_end "duplicate symbol $1 while processing $file line $.\n"
                if $seen{$1}++;
        }
     }
@@ -427,7 +434,7 @@ print $em <<'END';
 #endif
 END
 
-read_only_bottom_close_and_rename($em);
+read_only_bottom_close_and_rename($em) if ! $error_count;
 
 $em = open_print_header('embedvar.h');
 
@@ -492,7 +499,7 @@ print $em <<'END';
 #endif /* PERL_GLOBAL_STRUCT */
 END
 
-read_only_bottom_close_and_rename($em);
+read_only_bottom_close_and_rename($em) if ! $error_count;
 
 my $capih = open_print_header('perlapi.h');
 
@@ -595,7 +602,7 @@ print $capih <<'EOT';
 #endif /* __perlapi_h__ */
 EOT
 
-read_only_bottom_close_and_rename($capih);
+read_only_bottom_close_and_rename($capih) if ! $error_count;
 
 my $capi = open_print_header('perlapi.c', <<'EOQ');
  *
@@ -644,6 +651,8 @@ END_EXTERN_C
 #endif /* MULTIPLICITY && PERL_GLOBAL_STRUCT */
 EOT
 
-read_only_bottom_close_and_rename($capi);
+read_only_bottom_close_and_rename($capi) if ! $error_count;
+
+die "$error_count errors found" if $error_count;
 
 # ex: set ts=8 sts=4 sw=4 noet: