parts/apicheck.pl: Add a few comments; white-space

(cherry picked from commit fc50937fba868cf630ba6ccedd83d88a307ea81f)
Signed-off-by: Nicolas R <atoomic@cpan.org>

diff --git a/dist/Devel-PPPort/parts/apicheck.pl b/dist/Devel-PPPort/parts/apicheck.pl
index 72ee68b..8221499 100644 (file)
--- a/dist/Devel-PPPort/parts/apicheck.pl
+++ b/dist/Devel-PPPort/parts/apicheck.pl
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 ################################################################################
 #
-#  apicheck.pl -- generate C source for automated API check
+#  apicheck.pl -- generate apicheck.c: C source for automated API check
 #
 ################################################################################
 #
@@ -25,26 +25,38 @@ else {
   *OUT = \*STDOUT;
 }
 
+# Get list of functions/macros to test
 my @f = parse_embed(qw( parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc ));
 
+# Read in what we've decided in previous calls should be #ifdef'd out for this
+# call.  The keys are the symbols to test; each value is a subhash, like so:
+#     'utf8_hop_forward' => {
+#                               'version' => '5.025007'
+#                           },
+# We don't care here about other subkeys
 my %todo = %{&parse_todo};
 
+# We convert these types into these other types
 my %tmap = (
   void => 'int',
 );
 
+# These are for special marker argument names, as mentioned in embed.fnc
 my %amap = (
   SP   => 'SP',
   type => 'int',
   cast => 'int',
 );
 
+# Certain return types are instead considered void
 my %void = (
   void     => 1,
   Free_t   => 1,
   Signal_t => 1,
 );
 
+# khw doesn't know why these exist.  These have an explicit (void) cast added.
+# Undef'ing this hash made no difference.  Maybe it's for older compilers?
 my %castvoid = (
   map { ($_ => 1) } qw(
     G_ARRAY
@@ -73,12 +85,15 @@ my %castvoid = (
   ),
 );
 
+# Ignore the return value of these
 my %ignorerv = (
   map { ($_ => 1) } qw(
     newCONSTSUB
   ),
 );
 
+# The value of each key is a list of things that need to be declared in order
+# for the key to compile.
 my %stack = (
   MULTICALL      => ['dMULTICALL;'],
   ORIGMARK       => ['dORIGMARK;'],
@@ -107,6 +122,8 @@ my %stack = (
   XS_VERSION_BOOTCHECK => ['CV * cv;'],
 );
 
+# Things to not try to check.  Either not applicable, or too hard to get to
+# work here.
 my %ignore = (
   map { ($_ => 1) } qw(
     CLASS
@@ -128,6 +145,7 @@ my %ignore = (
   ),
 );
 
+# XXX The NEED_foo lines should be autogenerated
 print OUT <<HEAD;
 /*
  * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
@@ -202,6 +220,7 @@ typedef void yy_parser;
 
 HEAD
 
+# Caller can restrict what functions tests are generated for
 if (@ARGV) {
   my %want = map { ($_ => 0) } @ARGV;
   @f = grep { exists $want{$_->{name}} } @f;
@@ -212,7 +231,7 @@ if (@ARGV) {
 }
 
 my $f;
-for $f (@f) {
+for $f (@f) {   # Loop through all the tests to add
   $ignore{$f->{name}} and next;
   $f->{flags}{A} or next;  # only public API members
 
@@ -227,41 +246,56 @@ for $f (@f) {
   my $i = 1;
   my $ca;
   my $varargs = 0;
-  for $ca (@{$f->{args}}) {
-    my $a = $ca->[0];
+
+  for $ca (@{$f->{args}}) {   # Loop through the function's args
+    my $a = $ca->[0];           # 1th is the name, 0th is its type
     if ($a eq '...') {
       $varargs = 1;
       push @arg, qw(VARarg1 VARarg2 VARarg3);
       last;
     }
+
+    # Split this type into its components
     my($n, $p, $d) = $a =~ /^ (\w+(?:\s+\w+)*)\s*  # type name  => $n
                               (\**)                # pointer    => $p
                               (?:\s*\bconst\b\s*)? # const
                               ((?:\[[^\]]*\])*)    # dimension  => $d
                             $/x
                      or die "$0 - cannot parse argument: [$a]\n";
+
+    # Replace a special argument name by something that will compile.
     if (exists $amap{$n}) {
       push @arg, $amap{$n};
       next;
     }
+
+    # Certain types, like 'void', get remapped.
     $n = $tmap{$n} || $n;
+
+    # Use a literal of our choosing for non-format functions
     if ($n =~ /\bconst\s+char\b/ and $p eq '*' and !$f->{flags}{f}) {
       push @arg, '"foo"';
     }
     else {
-      my $v = 'arg' . $i++;
+      my $v = 'arg' . $i++;     # Argument number
       push @arg, $v;
-      my $no_const_n = $n;
+      my $no_const_n = $n;      # Get rid of any remaining 'const's
       $no_const_n =~ s/\bconst\b// unless $p;
+
+      # Declare this argument
       $stack .= "  static $no_const_n $p$v$d;\n";
     }
   }
 
+  # Declare thread context for functions and macros that might need it.
+  # (Macros often fail to say they don't need it.)
   unless ($f->{flags}{'T'}) {
     $stack = "  dTHX;\n$stack";     # Harmless to declare even if not needed
     $aTHX = @arg ? 'aTHX_ ' : 'aTHX';
   }
 
+  # If this function is on the list of things that need declarations, add
+  # them.
   if ($stack{$f->{name}}) {
     my $s = '';
     for (@{$stack{$f->{name}}}) {
@@ -271,17 +305,22 @@ for $f (@f) {
   }
 
   my $args = join ', ', @arg;
+
+  # Failure to specify a return type in the apidoc line means void
   my $rvt = $f->{ret} || 'void';
+
   my $ret;
-  if ($void{$rvt}) {
+  if ($void{$rvt}) {    # Certain return types are instead considered void
     $ret = $castvoid{$f->{name}} ? '(void) ' : '';
   }
   else {
     $stack .= "  $rvt rval;\n";
     $ret = $ignorerv{$f->{name}} ? '(void) ' : "rval = ";
   }
+
   my $aTHX_args = "";
 
+  # Add parens to functions that take an argument list, even if empty
   unless ($f->{flags}{'n'}) {
     $aTHX_args = "($aTHX$args)";
     $args = "($args)";
@@ -296,6 +335,7 @@ for $f (@f) {
 
 HEAD
 
+  # #ifdef out if marked as todo (not known in) this version
   if ($todo{$f->{name}}) {
     my($ver,$sub) = $todo{$f->{name}} =~ /^5\.(\d{3})(\d{3})$/ or die;
     for ($ver, $sub) {
@@ -311,6 +351,7 @@ HEAD
               ? "$Perl_$f->{name}$aTHX_args"
               : "$f->{name}$args";
 
+  # If there is a '#if' associated with this, add that
   $f->{cond} and print OUT "#if $f->{cond}\n";
 
   print OUT <<END;