# indented. The next input line that is a pod directive terminates this
# heading-level documentation.
+# The meanings of the flags fields in embed.fnc and the source code is
+# documented at the top of embed.fnc.
+
use strict;
if (@ARGV) {
require './regen/regen_lib.pl';
require './regen/embed_lib.pl';
+my @specialized_docs = sort qw( perlguts
+ perlxs
+ perlxstut
+ perlclib
+ warnings
+ perlapio
+ perlcall
+ perlfilter
+ perlmroapi
+ config.h
+ );
+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 { name_in_pod($_) } sort @specialized_docs;
+$specialized_docs[-1] =~ s/^/and /;
+my $specialized_docs = join ", ", @specialized_docs;
+
#
# See database of global and static function prototypes in embed.fnc
# This is used to generate prototype headers under various configurations,
#
my %docs;
+my %seen;
my %funcflags;
-my %macro = (
- ax => 1,
- items => 1,
- ix => 1,
- svtype => 1,
- );
my %missing;
my $curheader = "Unknown section";
FUNC:
while (defined($in = $get_next_line->())) {
- if ($in =~ /^#\s*define\s+([A-Za-z_][A-Za-z_0-9]+)\(/ &&
- ($file ne 'embed.h' || $file ne 'proto.h')) {
- $macro{$1} = $file;
- next FUNC;
- }
if ($in=~ /^=head1 (.*)/) {
$curheader = $1;
# If the next non-space line begins with a word char, then it is
- # the start of heading-ldevel documentation.
- if (defined($doc = $get_next_line->())) {
+ # the start of heading-level documentation.
+ if (defined($doc = $get_next_line->())) {
# Skip over empty lines
while ($doc =~ /^\s+$/) {
if (! defined($doc = $get_next_line->())) {
}
next FUNC;
}
- if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
- my $proto = $1;
- $proto = "||$proto" unless $proto =~ /\|/;
- my($flags, $ret, $name, @args) = split /\|/, $proto;
- my $docs = "";
+
+ # 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 && $is_in_proper_form or die <<EOS;
+Bad apidoc at $file line $.:
+ $in
+Expected:
+ =for apidoc flags|returntype|name|arg|arg|...
+ =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->())) {
+ while (defined($doc = $get_next_line->())) {
# Other pod commands are considered part of the current
# function's docs, so can have lists, etc.
last DOC if $doc =~ /^=(cut|for\s+apidoc|head)/;
- if ($doc =~ m:^\*/$:) {
- warn "=cut missing? $file:$line:$doc";;
- last DOC;
+ if ($doc =~ m:^\*/$:) {
+ warn "=cut missing? $file:$line:$doc";;
+ last DOC;
}
- $docs .= $doc;
- }
- $docs = "\n$docs" if $docs and $docs !~ /^\n/;
-
- # Check the consistency of the flags
- my ($embed_where, $inline_where);
- my ($embed_may_change, $inline_may_change);
-
- 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/;
- $flags .= 'D' if $embed_docref->{flags} =~ /D/;
- } else {
- $missing{$name} = $file;
- }
- if ($flags =~ /m/) {
- $inline_where = $flags =~ /A/ ? 'api' : 'guts';
- $inline_may_change = $flags =~ /x/;
-
- if (defined $embed_where && $inline_where ne $embed_where) {
- warn "Function '$name' inconsistency: embed.fnc says $embed_where, Pod says $inline_where";
- }
-
- if (defined $embed_may_change
- && $inline_may_change ne $embed_may_change) {
- my $message = "Function '$name' inconsistency: ";
- if ($embed_may_change) {
- $message .= "embed.fnc says 'may change', Pod does not";
- } else {
- $message .= "Pod says 'may change', embed.fnc does not";
- }
- warn $message;
- }
- } elsif (!defined $embed_where) {
- warn "Unable to place $name!\n";
- next;
- } else {
- $inline_where = $embed_where;
- $flags .= 'x' if $embed_may_change;
- @args = @{$embed_docref->{args}};
- $ret = $embed_docref->{retval};
- }
-
- if (exists $docs{$inline_where}{$curheader}{$name}) {
+ $docs .= $doc;
+ }
+ $docs = "\n$docs" if $docs and $docs !~ /^\n/;
+
+ # If the entry is also in embed.fnc, it should be defined
+ # completely there, but not here
+ my $embed_docref = delete $funcflags{$name};
+ if ($embed_docref and %$embed_docref) {
+ warn "embed.fnc entry overrides redundant information in"
+ . " '$proto_in_file' in $file" if $flags || $ret || @args;
+ $flags = $embed_docref->{'flags'};
+ warn "embed.fnc entry '$name' missing 'd' flag"
+ unless $flags =~ /d/;
+ next FUNC if $flags =~ /h/;
+ $ret = $embed_docref->{'retval'};
+ @args = @{$embed_docref->{args}};
+ } elsif ($flags !~ /m/) { # Not in embed.fnc, is missing if not a
+ # macro
+ $missing{$name} = $file;
+ }
+
+ my $inline_where = $flags =~ /A/ ? 'api' : 'guts';
+
+ if (exists $docs{$inline_where}{$curheader}{$name}) {
warn "$0: duplicate API entry for '$name' in $inline_where/$curheader\n";
next;
}
- $docs{$inline_where}{$curheader}{$name}
- = [$flags, $docs, $ret, $file, @args];
+ $docs{$inline_where}{$curheader}{$name}
+ = [$flags, $docs, $ret, $file, @args];
# Create a special entry with an empty-string name for the
# heading-level documentation.
- if (defined $header_doc) {
+ if (defined $header_doc) {
$docs{$inline_where}{$curheader}{""} = $header_doc;
undef $header_doc;
}
- if (defined $doc) {
- if ($doc =~ /^=(?:for|head)/) {
- $in = $doc;
- redo FUNC;
- }
- } else {
- warn "$file:$line:$in";
- }
- }
+ if (defined $doc) {
+ if ($doc =~ /^=(?:for|head)/) {
+ $in = $doc;
+ redo FUNC;
+ }
+ } else {
+ warn "$file:$line:$in";
+ }
+ }
}
}
$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";
}
$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/)
+ || ($flags =~ /f/ && $flags !~ /T/)); # Can't handle threaded varargs
+
$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
- # nothing
+ 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
- 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
- +8+($large_ret ? 1 + length $ret : 8)
- +length($n) + 1;
- my $indent;
- print $fh "\t$ret" . ($large_ret ? ' ' : "\t") . "$n(";
- my $long_args;
- for (@args) {
- if ($indent_size + 2 + length > 79) {
- $long_args=1;
- $indent_size -= length($n) - 3;
- last;
- }
- }
- my $args = '';
- if ($p) {
- $args = @args ? "pTHX_ " : "pTHX";
- if ($long_args) { print $fh $args; $args = '' }
- }
- $long_args and print $fh "\n";
- my $first = !$long_args;
- while () {
- if (!@args or
- length $args
- && $indent_size + 3 + length($args[0]) + length $args > 79
- ) {
- print $fh
- $first ? '' : (
- $indent //=
- "\t".($large_ret ? " " x (1+length $ret) : "\t")
- ." "x($long_args ? 4 : 1 + length $n)
- ),
- $args, (","x($args ne 'pTHX_ ') . "\n")x!!@args;
- $args = $first = '';
- }
- @args or last;
- $args .= ", "x!!(length $args && $args ne 'pTHX_ ')
- . shift @args;
- }
- if ($long_args) { print $fh "\n", substr $indent, 0, -4 }
- print $fh ")";
- }
- print $fh "\n\n";
+ if ($flags =~ /n/) { # no args
+ warn("n flag without m") unless $flags =~ /m/;
+ warn("n flag but apparently has args") if @args;
+ print $fh "\t$ret\t$name";
+ } else { # full usage
+ my $n = "Perl_"x$p . $name;
+ my $large_ret = length $ret > 7;
+ my $indent_size = 7+8 # nroff: 7 under =head + 8 under =item
+ +8+($large_ret ? 1 + length $ret : 8)
+ +length($n) + 1;
+ my $indent;
+ print $fh "\t$ret" . ($large_ret ? ' ' : "\t") . "$n(";
+ my $long_args;
+ for (@args) {
+ if ($indent_size + 2 + length > 79) {
+ $long_args=1;
+ $indent_size -= length($n) - 3;
+ last;
+ }
+ }
+ my $args = '';
+ if ($flags !~ /T/ && ($p || ($flags =~ /m/ && $name =~ /^Perl_/))) {
+ $args = @args ? "pTHX_ " : "pTHX";
+ if ($long_args) { print $fh $args; $args = '' }
+ }
+ $long_args and print $fh "\n";
+ my $first = !$long_args;
+ while () {
+ if (!@args or
+ length $args
+ && $indent_size + 3 + length($args[0]) + length $args > 79
+ ) {
+ print $fh
+ $first ? '' : (
+ $indent //=
+ "\t".($large_ret ? " " x (1+length $ret) : "\t")
+ ." "x($long_args ? 4 : 1 + length $n)
+ ),
+ $args, (","x($args ne 'pTHX_ ') . "\n")x!!@args;
+ $args = $first = '';
+ }
+ @args or last;
+ $args .= ", "x!!(length $args && $args ne 'pTHX_ ')
+ . shift @args;
+ }
+ 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";
}
s/^\|//gm for $header, $footer;
my $fh = open_new("pod/$podname.pod", undef,
- {by => "$0 extracting documentation",
+ {by => "$0 extracting documentation",
from => 'the C source files'}, 1);
print $fh $header;
my $key;
for $key (sort sort_helper keys %$dochash) {
- my $section = $dochash->{$key};
- print $fh "\n=head1 $key\n\n";
+ my $section = $dochash->{$key};
+ print $fh "\n=head1 $key\n\n";
# Output any heading-level documentation and delete so won't get in
# the way later
print $fh $section->{""} . "\n";
delete $section->{""};
}
- print $fh "=over 8\n\n";
+ print $fh "=over 8\n\n";
- for my $key (sort sort_helper keys %$section) {
- docout($fh, $key, $section->{$key});
- }
- print $fh "\n=back\n";
+ for my $key (sort sort_helper keys %$section) {
+ docout($fh, $key, $section->{$key});
+ }
+ print $fh "\n=back\n";
}
if (@$missing) {
s/\b(?:NN|NULLOK)\b\s+//g for @args;
$funcflags{$func} = {
- flags => $flags,
- retval => $retval,
- args => \@args,
- };
+ flags => $flags,
+ retval => $retval,
+ args => \@args,
+ };
}
# glob() picks up docs from extra .c or .h files that may be in unclean
open my $fh, '<', 'MANIFEST'
or die "Can't open MANIFEST: $!";
while (my $line = <$fh>) {
- next unless my ($file) = $line =~ /^(\S+\.[ch])\t/;
+ next unless my ($file) = $line =~ /^(\S+\.(?:[ch]|pod))\t/;
open F, '<', $file or die "Cannot open $file for docs: $!\n";
$curheader = "Functions in file $file\n";
for (sort keys %funcflags) {
next unless $funcflags{$_}{flags} =~ /d/;
+ next if $funcflags{$_}{flags} =~ /h/;
warn "no docs for $_\n"
}
foreach (sort keys %missing) {
- next if $macro{$_};
- # Heuristics for known not-a-function macros:
- next if /^[A-Z]/;
- next if /^dj?[A-Z]/;
-
warn "Function '$_', documented in $missing{$_}, not listed in embed.fnc";
}
# 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.
-my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /[MD]/ && !$docs{api}{$_}, keys %funcflags;
-output('perlapi', <<'_EOB_', $docs{api}, \@missing_api, <<'_EOE_');
+# 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;
+output('perlapi', <<"_EOB_", $docs{api}, \@missing_api, <<"_EOE_");
|=encoding UTF-8
|
|=head1 NAME
|=head1 DESCRIPTION
|X<Perl API> X<API> X<api>
|
-|This file contains the documentation of the perl public API generated by
-|F<embed.pl>, specifically a listing of functions, macros, flags, and variables
-|that may be used by extension writers. L<At the end|/Undocumented functions>
-|is a list of functions which have yet to be documented. The interfaces of
-|those are subject to change without notice. Anything not listed here is
-|not part of the public API, and should not be used by extension writers at
-|all. For these reasons, blindly using functions listed in proto.h is to be
-|avoided when writing extensions.
+|This file contains most of the documentation of the perl public API, as
+|generated by F<embed.pl>. Specifically, it is a listing of functions,
+|macros, flags, and variables that may be used by extension writers. Some
+|specialized items are instead documented in $specialized_docs.
+|
+|L<At the end|/Undocumented functions> is a list of functions which have yet
+|to be documented. Patches welcome! The interfaces of these are subject to
+|change without notice.
+|
+|Anything not listed here is not part of the public API, and should not be
+|used by extension writers at all. For these reasons, blindly using functions
+|listed in proto.h is to be avoided when writing extensions.
|
|In Perl, unlike C, a string of characters may generally contain embedded
|C<NUL> characters. Sometimes in the documentation a Perl string is referred
|=head1 AUTHORS
|
|Until May 1997, this document was maintained by Jeff Okamoto
-|<okamoto@corp.hp.com>. It is now maintained as part of Perl itself.
+|<okamoto\@corp.hp.com>. It is now maintained as part of Perl itself.
|
|With lots of help and suggestions from Dean Roehrich, Malcolm Beattie,
|Andreas Koenig, Paul Hudson, Ilya Zakharevich, Paul Marquess, Neil
|Bowers, Matthew Green, Tim Bunce, Spider Boardman, Ulrich Pfeifer,
|Stephen McCamant, and Gurusamy Sarathy.
|
-|API Listing originally by Dean Roehrich <roehrich@cray.com>.
+|API Listing originally by Dean Roehrich <roehrich\@cray.com>.
|
|Updated to be autogenerated from comments in the source by Benjamin Stuhl.
|
|=head1 SEE ALSO
|
-|L<perlguts>, L<perlxs>, L<perlxstut>, L<perlintern>
-|
+$other_places_api
_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');
+output('perlintern', <<'_EOB_', $docs{guts}, \@missing_guts, <<"_EOE_");
|=head1 NAME
|
|perlintern - autogenerated documentation of purely B<internal>
-| Perl functions
+|Perl functions
|
|=head1 DESCRIPTION
|X<internal Perl functions> X<interpreter functions>
|format but are not marked as part of the Perl API. In other words,
|B<they are not for use in extensions>!
|
-END
+_EOB_
|
|=head1 AUTHORS
|
|
|=head1 SEE ALSO
|
-|L<perlguts>, L<perlapi>
-|
-END
+$other_places_intern
+_EOE_
https://perl5.git.perl.org / perl5.git / blobdiff