This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ppport.h: Print out more API info
authorKarl Williamson <khw@cpan.org>
Sun, 21 Jul 2019 18:27:21 +0000 (12:27 -0600)
committerNicolas R <atoomic@cpan.org>
Fri, 27 Sep 2019 22:39:33 +0000 (16:39 -0600)
This uses the flags from embed.fnc to enable printing better API info
for elements that are, say, deprecated or core-only.

(cherry picked from commit 1fc2b5279cfb31e354f3bba615df71f721ad071b)
Signed-off-by: Nicolas R <atoomic@cpan.org>
dist/Devel-PPPort/PPPort_pm.PL
dist/Devel-PPPort/parts/inc/ppphbin

index d5b0376..c615dd7 100644 (file)
@@ -131,6 +131,17 @@ for (@perl_api) {
       $line .= 'v' if @$args && $args->[-1][0] eq '...';
     }
     $line .= 'n' if exists $e->{flags}{T};  # No thread context parameter
+    $line .= 'd' if exists $e->{flags}{D};  # deprecated
+    $line .= 'x' if exists $e->{flags}{x};  # experimental
+    $line .= 'c' if        exists $e->{flags}{C}      # core-only
+                   || (    exists $e->{flags}{X}
+                       && (exists $e->{flags}{E} || ! exists $e->{flags}{m}));
+    $line .= 'i' if exists $e->{flags}{A}
+                       || exists $e->{flags}{C}
+                       || (     exists $e->{flags}{X}
+                           && ! exists $e->{flags}{E}
+                           &&   exists $e->{flags}{m});
+    $line .= 'u' unless exists $e->{flags}{d};  # undocumented
   }
   $_ = $line;
 }
index 71b3bde..d1d6531 100644 (file)
@@ -73,6 +73,11 @@ my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
                       (index($4, 'v') >= 0 ? ( varargs  => 1  ) : ()),
                       (index($4, 'p') >= 0 ? ( provided => 1  ) : ()),
                       (index($4, 'n') >= 0 ? ( noTHXarg => 1  ) : ()),
+                      (index($4, 'c') >= 0 ? ( core_only    => 1  ) : ()),
+                      (index($4, 'd') >= 0 ? ( deprecated   => 1  ) : ()),
+                      (index($4, 'i') >= 0 ? ( inaccessible => 1  ) : ()),
+                      (index($4, 'x') >= 0 ? ( experimental => 1  ) : ()),
+                      (index($4, 'u') >= 0 ? ( undocumented => 1  ) : ()),
                     } )
                 : die "invalid spec: $_" } qw(
 __PERL_API__
@@ -191,10 +196,43 @@ if (exists $opt{'api-info'}) {
       print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
       $info++;
     }
-    print "No portability information available.\n" unless $info;
+
+      my $email = "Send email to perl5-porters\@perl.org if you need to have this functionality.\n";
+      if ($API{$f}{inaccessible}) {
+        print "\nThis is not part of the public API, and may not even be accessible to XS code.\n";
+        $info++;
+      }
+      elsif ($API{$f}{core_only}) {
+        print "\nThis is not part of the public API, and should not be used by XS code.\n";
+        $info++;
+      }
+      elsif ($API{$f}{deprecated}) {
+        print "\nThis is deprecated and should not be used.  Convert existing uses.\n";
+        $info++;
+      }
+      elsif ($API{$f}{experimental}) {
+        print "\nThe API for this is unstable and should not be used by XS code.\n", $email;
+        $info++;
+      }
+      elsif ($API{$f}{undocumented}) {
+        print "\nSince this is undocumented, the API should be considered unstable.\n";
+        if ($API{$f}{provided}) {
+            print "Consider bringing this up on the list: perl5-porters\@perl.org.\n";
+        }
+        else {
+            print "It may be that this is not intended for XS use, or it may just be\n",
+                  "that no one has gotten around to documenting it.\n", $email;
+        }
+        $info++;
+      }
+      unless ($info) {
+        print "No portability information available.  Check your spelling; or",
+              " this could be\na bug in Devel::PPPort.  To report an issue:\n",
+              "https://github.com/Dual-Life/Devel-PPPort/issues/new\n";
+      }
     $count++;
   }
-  $count or print "Found no API matching '$opt{'api-info'}'.";
+  $count or print "\nFound no API matching '$opt{'api-info'}'.";
   print "\n";
   exit 0;
 }