Data::Dumper (XS): use mortals to prevent leaks if magic throws

[perl5.git] / autodoc.pl

diff --git a/autodoc.pl b/autodoc.pl
index 6b0f080..aa45f31 100644 (file)
--- a/autodoc.pl
+++ b/autodoc.pl
@@ -42,11 +42,19 @@ my @specialized_docs = sort qw( perlguts
                                 warnings
                                 perlapio
                                 perlcall
+                                perlfilter
+                                perlmroapi
+                                config.h
                               );
-my $other_places_api = join " ",    map { "L<$_>" } sort @specialized_docs, 'perlintern';
-my $other_places_intern = join " ", map { "L<$_>" } sort @specialized_docs, 'perlapi';
+sub name_in_pod($) {
+    my $name = shift;
+    return "F<$name>" if $name =~ /\./;
+    return "L<$name>";
+}
+my $other_places_api = join " ",    map { name_in_pod($_) } sort @specialized_docs, 'perlintern';
+my $other_places_intern = join " ", map { name_in_pod($_) } sort @specialized_docs, 'perlapi';
 
-@specialized_docs = map { "L<$_>" } sort @specialized_docs;
+@specialized_docs = map { name_in_pod($_) } sort @specialized_docs;
 $specialized_docs[-1] =~ s/^/and /;
 my $specialized_docs = join ", ", @specialized_docs;
 
@@ -58,6 +66,7 @@ my $specialized_docs = join ", ", @specialized_docs;
 #
 
 my %docs;
+my %seen;
 my %funcflags;
 my %missing;
 
@@ -110,12 +119,33 @@ HDR_DOC:
             }
             next FUNC;
         }
-        if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
-            my $proto_in_file = $1;
+
+        # Parentheses are used to accept anything that looks like 'for
+        # apidoc', and later verify that things are the actual correct syntax.
+        my $apidoc_re = qr/^(\s*)(=?)(\s*)for(\s*)apidoc(\s*)(.*?)\s*\n/;
+
+        if ($in =~ /^=for comment/) {
+            $in = $get_next_line->();
+            if ($in =~ /skip apidoc/) {   # Skips the next apidoc-like line
+                while (defined($in = $get_next_line->())) {
+                    last if $in =~ $apidoc_re;
+                }
+            }
+            next FUNC;
+        }
+
+        if ($in =~ $apidoc_re) {
+            my $is_in_proper_form = length $1 == 0
+                                 && length $2 > 0
+                                 && length $3 == 0
+                                 && length $4 > 0
+                                 && length $5 > 0
+                                 && length $6 > 0;
+            my $proto_in_file = $6;
             my $proto = $proto_in_file;
             $proto = "||$proto" unless $proto =~ /\|/;
             my($flags, $ret, $name, @args) = split /\s*\|\s*/, $proto;
-            $name or die <<EOS;
+            $name && $is_in_proper_form or die <<EOS;
 Bad apidoc at $file line $.:
   $in
 Expected:
@@ -123,10 +153,21 @@ Expected:
   =for apidoc flags|returntype|name
   =for apidoc name
 EOS
+            die "flag $1 is not legal (for function $name (from $file))"
+                        if $flags =~ / ( [^AabCDdEefhiMmNnTOoPpRrSsUuWXx] ) /x;
             next FUNC if $flags =~ /h/;
 
+            die "'u' flag must also have 'm' flag' for $name" if $flags =~ /u/ && $flags !~ /m/;
             warn ("'$name' not \\w+ in '$proto_in_file' in $file")
                         if $flags !~ /N/ && $name !~ / ^ [_[:alpha:]] \w* $ /x;
+
+            if (exists $seen{$name}) {
+                die ("'$name' in $file was already documented in $seen{$name}");
+            }
+            else {
+                $seen{$name} = $file;
+            }
+
             my $docs = "";
 DOC:
             while (defined($doc = $get_next_line->())) {
@@ -193,7 +234,8 @@ sub docout ($$$) { # output the docs for one function
     $name =~ s/\s*$//;
 
     if ($flags =~ /D/) {
-        $docs = "\n\nDEPRECATED!  It is planned to remove this function from a
+        my $function = $flags =~ /n/ ? 'definition' : 'function';
+        $docs = "\n\nDEPRECATED!  It is planned to remove this $function from a
 future release of Perl.  Do not use it for new code; remove it from
 existing code.\n\n$docs";
     }
@@ -203,7 +245,8 @@ removed without notice.\n\n$docs" if $flags =~ /x/;
     }
 
     # Is Perl_, but no #define foo # Perl_foo
-    my $p = $flags =~ /p/ && $flags =~ /o/ && $flags !~ /M/;
+    my $p = (($flags =~ /p/ && $flags =~ /o/ && $flags !~ /M/)
+          || ($flags =~ /f/ && $flags !~ /T/));  # Can't handle threaded varargs
 
     $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
          if $flags =~ /O/;
@@ -240,7 +283,7 @@ removed without notice.\n\n$docs" if $flags =~ /x/;
                 }
             }
             my $args = '';
-            if ($p && $flags !~ /T/) {
+            if ($flags !~ /T/ && ($p || ($flags =~ /m/ && $name =~ /^Perl_/))) {
                 $args = @args ? "pTHX_ " : "pTHX";
                 if ($long_args) { print $fh $args; $args = '' }
             }
@@ -386,8 +429,8 @@ foreach (sort keys %missing) {
 # walk table providing an array of components in each line to
 # subroutine, printing the result
 
-# List of funcs in the public API that aren't also marked as experimental nor
-# deprecated.
+# List of funcs in the public API that aren't also marked as core-only,
+# experimental nor deprecated.
 my @missing_api = grep $funcflags{$_}{flags} =~ /A/
                     && $funcflags{$_}{flags} !~ /[xD]/
                     && !$docs{api}{$_}, keys %funcflags;