2 ################################################################################
4 # apicheck.pl -- generate C source for automated API check
6 ################################################################################
10 # $Date: 2004/08/17 20:56:15 +0200 $
12 ################################################################################
14 # Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz.
15 # Version 2.x, Copyright (C) 2001, Paul Marquess.
16 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
18 # This program is free software; you can redistribute it and/or
19 # modify it under the same terms as Perl itself.
21 ################################################################################
24 require 'parts/ppptools.pl';
27 open OUT, ">$ARGV[0]" or die "$ARGV[0]: $!\n";
33 my @f = parse_embed(qw( parts/embed.fnc parts/apidoc.fnc ));
35 my %todo = %{&parse_todo};
88 ORIGMARK => ['dORIGMARK;'],
89 POPpx => ['STRLEN n_a;'],
90 POPpbytex => ['STRLEN n_a;'],
99 UNDERBAR => ['dUNDERBAR;'],
103 dSP => "some_global_var = !sp;",
104 dMARK => "some_global_var = !mark;",
105 dORIGMARK => "some_global_var = !origmark;",
106 dAX => "some_global_var = !ax;",
107 dITEMS => "some_global_var = !items;",
108 dXSARGS => "some_global_var = ax && items;",
109 NEWSV => "some_global_var = !arg1;",
110 New => "some_global_var = !arg1;",
111 Newc => "some_global_var = !arg1;",
112 Newz => "some_global_var = !arg1;",
113 dUNDERBAR => "(void) UNDERBAR;",
117 map { ($_ => 1) } qw(
132 * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
133 * This file is built by $0.
134 * Any changes made here will be lost!
141 #ifndef DPPP_APICHECK_NO_PPPORT_H
144 #define NEED_grok_bin
145 #define NEED_grok_hex
146 #define NEED_grok_number
147 #define NEED_grok_numeric_radix
148 #define NEED_grok_oct
149 #define NEED_newCONSTSUB
150 #define NEED_newRV_noinc
151 #define NEED_sv_2pv_nolen
152 #define NEED_sv_2pvbyte
153 #define NEED_sv_catpvf_mg
154 #define NEED_sv_catpvf_mg_nocontext
155 #define NEED_sv_setpvf_mg
156 #define NEED_sv_setpvf_mg_nocontext
157 #define NEED_vnewSVpvf
164 static int some_global_var;
167 static char *VARarg2;
168 static double VARarg3;
174 $ignore{$f->{name}} and next;
175 $f->{flags}{A} or next; # only public API members
177 $ignore{$f->{name}} = 1; # ignore duplicates
179 my $Perl_ = $f->{flags}{p} ? 'Perl_' : '';
188 for $ca (@{$f->{args}}) {
192 push @arg, qw(VARarg1 VARarg2 VARarg3);
195 my($n, $p, $d) = $a =~ /^(\w+(?:\s+\w+)*)\s*(\**)((?:\[[^\]]*\])*)$/ or die;
196 if (exists $amap{$n}) {
197 push @arg, $amap{$n};
200 $n = $tmap{$n} || $n;
201 my $v = 'arg' . $i++;
203 $stack .= " static $n $p$v$d;\n";
206 unless ($f->{flags}{n} || $f->{flags}{'m'}) {
207 $stack = " dTHX;\n$stack";
208 $aTHX = @arg ? 'aTHX_ ' : 'aTHX';
211 if ($stack{$f->{name}}) {
213 for (@{$stack{$f->{name}}}) {
219 my $args = join ', ', @arg;
220 my $rvt = $f->{ret} || 'void';
223 $ret = $castvoid{$f->{name}} ? '(void) ' : '';
226 $ret = $ignorerv{$f->{name}} ? '(void) ' : "return ";
228 my $aTHX_args = "$aTHX$args";
231 if ($postcode{$f->{name}}) {
232 $post = $postcode{$f->{name}};
237 unless ($f->{flags}{'m'} and @arg == 0) {
239 $aTHX_args = "($aTHX_args)";
243 /******************************************************************************
247 ******************************************************************************/
251 if ($todo{$f->{name}}) {
252 my($ver,$sub) = $todo{$f->{name}} =~ /^5\.(\d{3})(\d{3})$/ or die;
256 if ($ver < 6 && $sub > 0) {
257 $sub =~ s/0$// or die;
259 print OUT "#if PERL_VERSION > $ver || (PERL_VERSION == $ver && PERL_SUBVERSION >= $sub) /* TODO */\n";
263 ? "$Perl_$f->{name}$aTHX_args"
266 $f->{cond} and print OUT "#if $f->{cond}\n";
269 $rvt _DPPP_test_$f->{name} (void)
276 $ret$f->{name}$args;$post
280 some_global_var = items && ax;
286 $ret$Perl_$f->{name}$aTHX_args;$post
292 $f->{cond} and print OUT "#endif\n";
293 $todo{$f->{name}} and print OUT "#endif\n";