summaryrefslogtreecommitdiff
path: root/embed.pl
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2008-02-12 13:15:20 +0000
committerNicholas Clark <nick@ccl4.org>2008-02-12 13:15:20 +0000
commit7918f24d20384771923d344a382e1d16d9552018 (patch)
tree627e24f3c520f70ddfd3fc9779420bd72fd00c55 /embed.pl
parent9f10164a6c9d93684fedbbc188fb9dfe004c22c4 (diff)
downloadperl-7918f24d20384771923d344a382e1d16d9552018.tar.gz
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
Diffstat (limited to 'embed.pl')
-rwxr-xr-xembed.pl22
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;