assert() that every NN argument is not NULL. Otherwise we have the

ability to create landmines that will explode under someone in the
future when they upgrade their compiler to one with better
optimisation. We've already done this at least twice.
(Yes, some of the assertions are after code that would already have
SEGVd because it already deferences a pointer, but they are put in
to make it easier to automate checking that each and every case is
covered.)
Add a tool, checkARGS_ASSERT.pl, to check that every case is covered.

p4raw-id: //depot/perl@33291

1 files changed, 17 insertions, 5 deletions

diff --git a/embed.pl b/embed.pl
index 964406fe9c..97f0d8390e 100755
--- a/embed.pl
+++ b/embed.pl
@@ -156,13 +156,15 @@ sub write_protos {
 	$ret .= "$arg\n";
     }
     else {
-	my ($flags,$retval,$func,@args) = @_;
+	my ($flags,$retval,$plain_func,@args) = @_;
 	my @nonnull;
 	my $has_context = ( $flags !~ /n/ );
 	my $never_returns = ( $flags =~ /r/ );
 	my $commented_out = ( $flags =~ /m/ );
 	my $is_malloc = ( $flags =~ /a/ );
 	my $can_ignore = ( $flags !~ /R/ ) && !$is_malloc;
+	my @names_of_nn;
+	my $func;
 
 	my $splint_flags = "";
 	if ( $SPLINT && !$commented_out ) {
@@ -174,12 +176,14 @@ sub write_protos {
 
 	if ($flags =~ /s/) {
 	    $retval = "STATIC $splint_flags$retval";
-	    $func = "S_$func";
+	    $func = "S_$plain_func";
 	}
 	else {
 	    $retval = "PERL_CALLCONV $splint_flags$retval";
 	    if ($flags =~ /[bp]/) {
-		$func = "Perl_$func";
+		$func = "Perl_$plain_func";
+	    } else {
+		$func = $plain_func;
 	    }
 	}
 	$ret .= "$retval\t$func(";
@@ -205,12 +209,16 @@ sub write_protos {
 		my $temp_arg = $arg;
 		$temp_arg =~ s/\*//g;
 		$temp_arg =~ s/\s*\bstruct\b\s*/ /g;
-		if ( ($temp_arg ne "...") && ($temp_arg !~ /\w+\s+\w+/) ) {
-		    warn "$func: $arg doesn't have a name\n";
+		if ( ($temp_arg ne "...")
+		     && ($temp_arg !~ /\w+\s+(\w+)(?:\[\d+\])?\s*$/) ) {
+		    warn "$func: $arg ($n) doesn't have a name\n";
 		}
 		if ( $SPLINT && $nullok && !$commented_out ) {
 		    $arg = '/*@null@*/ ' . $arg;
 		}
+		if (defined $1 && $nn) {
+		    push @names_of_nn, $1;
+		}
 	    }
 	    $ret .= join ", ", @args;
 	}
@@ -251,6 +259,10 @@ sub write_protos {
 	}
 	$ret .= ";";
 	$ret = "/* $ret */" if $commented_out;
+	if (@names_of_nn) {
+	    $ret .= "\n#define PERL_ARGS_ASSERT_\U$plain_func\E\t\\\n\t"
+		. join '; ', map "assert($_)", @names_of_nn;
+	}
 	$ret .= @attrs ? "\n\n" : "\n";
     }
     $ret;