{
my $file = shift;
- my $years = '1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005';
+ my $years = '1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006';
$years =~ s/1999,/1999,\n / if length $years > 40;
} '/dev/null', '', '';
local $^I = '.bak';
while (<>) {
-# if (/^#\s*include\s+"perl.h"/) {
-# my $file = uc $ARGV;
-# $file =~ s/\./_/g;
-# print "#define PERL_IN_$file\n";
-# }
-# s{^(\w+)\s*\(}
-# {
-# my $f = $1;
-# my $repl = "$f(";
-# if (exists $functions->{$f}) {
-# my $flags = $functions->{$f}[0];
-# $repl = "Perl_$repl" if $flags =~ /p/;
-# unless ($flags =~ /n/) {
-# $repl .= "pTHX";
-# $repl .= "_ " if @{$functions->{$f}} > 3;
-# }
-# warn("$ARGV:$.:$repl\n");
-# }
-# $repl;
-# }e;
s{(\b(\w+)[ \t]*\([ \t]*(?!aTHX))}
{
my $repl = $1;
my $n;
for my $arg ( @args ) {
++$n;
+ if ( $arg =~ /\*/ && $arg !~ /\b(NN|NULLOK)\b/ ) {
+ warn "$func: $arg needs NN or NULLOK\n";
+ our $unflagged_pointers;
+ ++$unflagged_pointers;
+ }
push( @nonnull, $n ) if ( $arg =~ s/\s*\bNN\b\s+// );
+ $arg =~ s/\s*\bNULLOK\b\s+//; # strip NULLOK with no effect
+
+ # Make sure each arg has at least a type and a var name.
+ # An arg of "int" is valid C, but want it to be "int foo".
+ 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";
+ }
}
$ret .= join ", ", @args;
}
$ret;
}
-# generates global.sym (API export list), and populates %global with global symbols
-sub write_global_sym {
- my $ret = "";
- if (@_ > 1) {
- my ($flags,$retval,$func,@args) = @_;
- if ($flags =~ /[AX]/ && $flags !~ /[xm]/
- || $flags =~ /b/) { # public API, so export
- $func = "Perl_$func" if $flags =~ /[pbX]/;
- $ret = "$func\n";
- }
- }
- $ret;
+# generates global.sym (API export list)
+{
+ my %seen;
+ sub write_global_sym {
+ my $ret = "";
+ if (@_ > 1) {
+ my ($flags,$retval,$func,@args) = @_;
+ # If a function is defined twice, for example before and after an
+ # #else, only process the flags on the first instance for global.sym
+ return $ret if $seen{$func}++;
+ if ($flags =~ /[AX]/ && $flags !~ /[xm]/
+ || $flags =~ /b/) { # public API, so export
+ $func = "Perl_$func" if $flags =~ /[pbX]/;
+ $ret = "$func\n";
+ }
+ }
+ $ret;
+ }
}
+
+our $unflagged_pointers;
walk_table(\&write_protos, "proto.h", undef, "/* ex: set ro: */\n");
+warn "$unflagged_pointers pointer arguments to clean up\n" if $unflagged_pointers;
walk_table(\&write_global_sym, "global.sym", undef, "# ex: set ro:\n");
# XXX others that may need adding
Perl_dump_indent Perl_dump_vindent
Perl_default_protect Perl_vdefault_protect
);
+
+# ex: set ts=8 sts=4 sw=4 noet: