This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta for ee3818ca2c5e (Can’t coerce readonly REF)
[perl5.git] / autodoc.pl
index 89b36df..bff2094 100644 (file)
@@ -13,8 +13,7 @@
 # Has an optional arg, which is the directory to chdir to before reading
 # MANIFEST and *.[ch].
 #
-# This script is normally invoked as part of 'make all', but is also
-# called from from regen.pl.
+# This script is invoked as part of 'make all'
 #
 # '=head1' are the only headings looked for.  If the next line after the
 # heading begins with a word character, it is considered to be the first line
 
 use strict;
 
+if (@ARGV) {
+    my $workdir = shift;
+    chdir $workdir
+        or die "Couldn't chdir to '$workdir': $!";
+}
+require 'regen/regen_lib.pl';
+require 'regen/embed_lib.pl';
+
 #
 # See database of global and static function prototypes in embed.fnc
 # This is used to generate prototype headers under various configurations,
@@ -113,6 +120,7 @@ DOC:
            if ($docref and %$docref) {
                $embed_where = $docref->{flags} =~ /A/ ? 'api' : 'guts';
                $embed_may_change = $docref->{flags} =~ /M/;
+                $flags .= 'D' if $docref->{flags} =~ /D/;
            } else {
                $missing{$name} = $file;
            }
@@ -171,8 +179,15 @@ sub docout ($$$) { # output the docs for one function
     my($flags, $docs, $ret, $file, @args) = @$docref;
     $name =~ s/\s*$//;
 
-    $docs .= "NOTE: this function is experimental and may change or be
-removed without notice.\n\n" if $flags =~ /x/;
+    if ($flags =~ /D/) {
+        $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";
+    }
+    else {
+        $docs = "\n\nNOTE: this function is experimental and may change or be
+removed without notice.\n\n$docs" if $flags =~ /x/;
+    }
     $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"
@@ -197,7 +212,7 @@ removed without notice.\n\n" if $flags =~ /x/;
        print $fh "\t$ret" . ($large_ret ? ' ' : "\t") . "$n(";
        my $long_args;
        for (@args) {
-           if ($indent_size + 2 + length > 80) {
+           if ($indent_size + 2 + length > 79) {
                $long_args=1;
                $indent_size -= length($n) - 3;
                last;
@@ -213,7 +228,7 @@ removed without notice.\n\n" if $flags =~ /x/;
        while () {
            if (!@args or
                 length $args
-                && $indent_size + 3 + length($args[0]) + length $args > 80
+                && $indent_size + 3 + length($args[0]) + length $args > 79
            ) {
                print $fh
                  $first ? '' : (
@@ -236,17 +251,11 @@ removed without notice.\n\n" if $flags =~ /x/;
 
 sub output {
     my ($podname, $header, $dochash, $missing, $footer) = @_;
-    my $filename = "pod/$podname.pod";
-    open my $fh, '>', $filename or die "Can't open $filename: $!";
-
-    print $fh <<"_EOH_", $header;
--*- buffer-read-only: t -*-
+    my $fh = open_new("pod/$podname.pod", undef,
+                     {by => "$0 extracting documentation",
+                       from => 'the C source files'}, 1);
 
-!!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
-This file is built by $0 extracting documentation from the C source
-files.
-
-_EOH_
+    print $fh $header;
 
     my $key;
     # case insensitive sort, with fallback for determinacy
@@ -271,14 +280,24 @@ _EOH_
 
     if (@$missing) {
         print $fh "\n=head1 Undocumented functions\n\n";
-    print $fh <<'_EOB_';
+    print $fh $podname eq 'perlapi' ? <<'_EOB_' : <<'_EOB_';
 The following functions have been flagged as part of the public API,
 but are currently undocumented. Use them at your own risk, as the
-interfaces are subject to change.
+interfaces are subject to change.  Functions that are not listed in this
+document are not intended for public use, and should NOT be used under any
+circumstances.
+
+If you use one of the undocumented functions below, you may wish to consider
+creating and submitting documentation for it. If your patch is accepted, this
+will indicate that the interface is stable (unless it is explicitly marked
+otherwise).
 
-If you use one of them, you may wish to consider creating and submitting
-documentation for it. If your patch is accepted, this will indicate that
-the interface is stable (unless it is explicitly marked otherwise).
+=over
+
+_EOB_
+The following functions are currently undocumented.  If you use one of
+them, you may wish to consider creating and submitting documentation for
+it.
 
 =over
 
@@ -288,41 +307,15 @@ _EOB_
     }
     print $fh "=back\n\n";
 }
+    print $fh $footer, "=cut\n";
 
-print $fh $footer, <<'_EOF_';
-=cut
-
- ex: set ro:
-_EOF_
-
-    close $fh or die "Can't close $filename: $!";
-}
-
-if (@ARGV) {
-    my $workdir = shift;
-    chdir $workdir
-        or die "Couldn't chdir to '$workdir': $!";
+    read_only_bottom_close_and_rename($fh);
 }
 
-open IN, "embed.fnc" or die $!;
-
-while (<IN>) {
-    chomp;
-    next if /^:/;
-    while (s|\\\s*$||) {
-       $_ .= <IN>;
-       chomp;
-    }
-    s/\s+$//;
-    next if /^\s*(#|$)/;
-
-    my ($flags, $retval, $func, @args) = split /\s*\|\s*/, $_;
-
-    next unless $func;
-
-    s/\b(NN|NULLOK)\b\s+//g for @args;
-    $func =~ s/\t//g; # clean up fields from embed.pl
-    $retval =~ s/\t//;
+foreach (@{(setup_embed())[0]}) {
+    next if @$_ < 2;
+    my ($flags, $retval, $func, @args) = @$_;
+    s/\b(?:NN|NULLOK)\b\s+//g for @args;
 
     $funcflags{$func} = {
                         flags => $flags,
@@ -331,21 +324,19 @@ while (<IN>) {
                        };
 }
 
-my $file;
 # glob() picks up docs from extra .c or .h files that may be in unclean
 # development trees.
-my $MANIFEST = do {
-  local ($/, *FH);
-  open FH, "MANIFEST" or die "Can't open MANIFEST: $!";
-  <FH>;
-};
+open my $fh, '<', 'MANIFEST'
+    or die "Can't open MANIFEST: $!";
+while (my $line = <$fh>) {
+    next unless my ($file) = $line =~ /^(\S+\.[ch])\t/;
 
-for $file (($MANIFEST =~ /^(\S+\.c)\t/gm), ($MANIFEST =~ /^(\S+\.h)\t/gm)) {
     open F, "< $file" or die "Cannot open $file for docs: $!\n";
     $curheader = "Functions in file $file\n";
     autodoc(\*F,$file);
     close F or die "Error closing $file: $!\n";
 }
+close $fh or die "Error whilst reading MANIFEST: $!";
 
 for (sort keys %funcflags) {
     next unless $funcflags{$_}{flags} =~ /d/;
@@ -364,8 +355,9 @@ 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.
-my @missing_api = grep $funcflags{$_}{flags} =~ /A/ && $funcflags{$_}{flags} !~ /M/ && !$docs{api}{$_}, keys %funcflags;
+# 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_');
 =head1 NAME
 
@@ -375,7 +367,7 @@ perlapi - autogenerated documentation for the perl public API
 X<Perl API> X<API> X<api>
 
 This file contains the documentation of the perl public API generated by
-embed.pl, specifically a listing of functions, macros, flags, and variables
+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.  Any functions not listed here are
@@ -405,11 +397,6 @@ But the ordinals of characters differ between ASCII, EBCDIC, and
 the UTF- encodings, and a string encoded in UTF-EBCDIC may occupy more bytes
 than in UTF-8.
 
-Also, on some EBCDIC machines, functions that are documented as operating on
-US-ASCII (or Basic Latin in Unicode terminology) may in fact operate on all
-256 characters in the EBCDIC range, not just the subset corresponding to
-US-ASCII.
-
 The listing below is alphabetical, case insensitive.
 
 _EOB_
@@ -434,7 +421,9 @@ L<perlguts>, L<perlxs>, L<perlxstut>, L<perlintern>
 
 _EOE_
 
-my @missing_guts = grep $funcflags{$_}{flags} !~ /A/ && !$docs{guts}{$_}, keys %funcflags;
+# List of non-static internal functions
+my @missing_guts =
+ grep $funcflags{$_}{flags} !~ /[As]/ && !$docs{guts}{$_}, keys %funcflags;
 
 output('perlintern', <<'END', $docs{guts}, \@missing_guts, <<'END');
 =head1 NAME