This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
autodoc.pl: Make 's' flag independent of 'n'
[perl5.git] / autodoc.pl
index 1856b3c..9a2e9ec 100644 (file)
@@ -106,7 +106,7 @@ HDR_DOC:
        if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
            my $proto = $1;
            $proto = "||$proto" unless $proto =~ /\|/;
-           my($flags, $ret, $name, @args) = split /\|/, $proto;
+           my($flags, $ret, $name, @args) = split /\s*\|\s*/, $proto;
            my $docs = "";
 DOC:
            while (defined($doc = $get_next_line->())) {
@@ -129,8 +129,12 @@ DOC:
            my $embed_docref = delete $funcflags{$name};
            if ($embed_docref and %$embed_docref) {
                $embed_where = $embed_docref->{flags} =~ /A/ ? 'api' : 'guts';
-               $embed_may_change = $embed_docref->{flags} =~ /M/;
+               $embed_may_change = $embed_docref->{flags} =~ /x/;
                 $flags .= 'D' if $embed_docref->{flags} =~ /D/;
+                $flags .= 'O' if $embed_docref->{flags} =~ /O/;
+                $flags .= 'p' if $embed_docref->{flags} =~ /p/;
+                $flags .= 'M' if $embed_docref->{flags} =~ /M/;
+                $flags .= 'T' if $embed_docref->{flags} =~ /T/;
            } else {
                $missing{$name} = $file;
            }
@@ -202,22 +206,27 @@ existing code.\n\n$docs";
         $docs = "\n\nNOTE: this function is experimental and may change or be
 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/;
+
     $docs .= "NOTE: the perl_ form of this function is deprecated.\n\n"
-       if $flags =~ /p/;
-    $docs .= "NOTE: this function must be explicitly called as Perl_$name with an aTHX_ parameter.\n\n"
-        if $flags =~ /o/;
+       if $flags =~ /O/;
+    if ($p) {
+        $docs .= "NOTE: this function must be explicitly called as Perl_$name";
+        $docs .= " with an aTHX_ parameter" if $flags !~ /T/;
+        $docs .= ".\n\n"
+    }
 
     print $fh "=item $name\nX<$name>\n$docs";
 
     if ($flags =~ /U/) { # no usage
+        warn("U and s flags are incompatible") if $flags =~ /s/;
        # nothing
     } else {
-        if ($flags =~ /s/) { # semicolon ("dTHR;")
-            print $fh "\t\t$name;";
-        } elsif ($flags =~ /n/) { # no args
+        if ($flags =~ /n/) { # no args
             print $fh "\t$ret\t$name";
         } else { # full usage
-            my $p            = $flags =~ /o/; # no #define foo Perl_foo
             my $n            = "Perl_"x$p . $name;
             my $large_ret    = length $ret > 7;
             my $indent_size  = 7+8 # nroff: 7 under =head + 8 under =item
@@ -234,7 +243,7 @@ removed without notice.\n\n$docs" if $flags =~ /x/;
                 }
             }
             my $args = '';
-            if ($p) {
+            if ($p && $flags !~ /T/) {
                 $args = @args ? "pTHX_ " : "pTHX";
                 if ($long_args) { print $fh $args; $args = '' }
             }
@@ -261,6 +270,7 @@ removed without notice.\n\n$docs" if $flags =~ /x/;
             if ($long_args) { print $fh "\n", substr $indent, 0, -4 }
             print $fh ")";
         }
+        print $fh ";" if $flags =~ /s/; # semicolon "dTHR;"
         print $fh "\n\n";
     }
     print $fh "=for hackers\nFound in file $file\n\n";
@@ -385,7 +395,7 @@ foreach (sort keys %missing) {
 
 # List of funcs in the public API that aren't also marked as experimental nor
 # deprecated.
-my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /[MD]/ && !$docs{api}{$_}, keys %funcflags;
+my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /[xD]/ && !$docs{api}{$_}, keys %funcflags;
 output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_');
 |=encoding UTF-8
 |
@@ -468,7 +478,7 @@ _EOE_
 
 # List of non-static internal functions
 my @missing_guts =
- grep $funcflags{$_}{flags} !~ /[As]/ && !$docs{guts}{$_}, keys %funcflags;
+ grep $funcflags{$_}{flags} !~ /[AS]/ && !$docs{guts}{$_}, keys %funcflags;
 
 output('perlintern', <<'END', $docs{guts}, \@missing_guts, <<'END');
 |=head1 NAME