This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
parts/apicheck.pl: Don't skip some cases
authorKarl Williamson <khw@cpan.org>
Sun, 28 Jul 2019 19:45:25 +0000 (13:45 -0600)
committerNicolas R <atoomic@cpan.org>
Fri, 27 Sep 2019 22:51:27 +0000 (16:51 -0600)
We only should create a single test for a given function.  But if that
function is like this:

  #if foo
    int bar(...)
  #else
    char bar(...)
  #endif

We would only generate a test for the 'foo' case.  Uniqueness of a
function includes the compile time conditional expression for it.

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

index ccd541c..6799ff5 100644 (file)
@@ -160,6 +160,7 @@ for (@perl_api) {   # $_ is the item name
       my $args = $e->{args};
       $line .= 'v' if @$args && $args->[-1][0] eq '...';
     }
+    $line .= 'o' if exists $e->{ppport_fnc};
     $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
index f51bb11..26c3e2a 100644 (file)
@@ -137,9 +137,11 @@ my %stack = (
    pMY_CXT     => [ @my_cxt_prereqs ],
 );
 
+# The entries in %ignore have two components, separated by this.
+my $sep = '~';
 
-# Things to not try to check.
-my %ignore = map { ("$_" => 1) } keys %{&known_but_hard_to_test_for()};
+# Things to not try to check.  (The component after $sep is empty.)
+my %ignore = map { ("$_$sep" => 1) } keys %{&known_but_hard_to_test_for()};
 
 # XXX The NEED_foo lines should be autogenerated
 print OUT <<HEAD;
@@ -228,10 +230,14 @@ if (@ARGV) {
 
 my $f;
 for $f (@f) {   # Loop through all the tests to add
-  $ignore{$f->{'name'}} and next;
+
+  # Just the name isn't unique;  We also need the #if or #else condition
+  my $unique = "$f->{'name'}$sep$f->{'cond'}";
+  $ignore{$unique} and next;
+
   $f->{'flags'}{'A'} or next;  # only public API members
 
-  $ignore{$f->{'name'}} = 1; # ignore duplicates
+  $ignore{$unique} = 1; # ignore duplicates
 
   my $Perl_ = $f->{'flags'}{'p'} ? 'Perl_' : '';
 
index 038945e..10f7d5d 100644 (file)
@@ -84,6 +84,7 @@ my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
                       (index($4, 'i') >= 0 ? ( inaccessible => 1  ) : ()),
                       (index($4, 'x') >= 0 ? ( experimental => 1  ) : ()),
                       (index($4, 'u') >= 0 ? ( undocumented => 1  ) : ()),
+                      (index($4, 'o') >= 0 ? ( ppport_fnc => 1  ) : ()),
                     } )
                 : die "invalid spec: $_" } qw(
 __PERL_API__
@@ -255,8 +256,13 @@ if (exists $opt{'api-info'}) {
     print "\n=== $f ===\n\n";
     my $info = 0;
     if ($API{$f}{base} || $API{$f}{todo}) {
-      my $base = format_version($API{$f}{base} || $API{$f}{todo});
-      print "Supported at least starting from perl-$base.\n";
+      if ($API{$f}{ppport_fnc}) {
+        print "This is only supported by ppport.h, and NOT by ANY perl version.\n";
+      }
+      else {
+        my $base = format_version($API{$f}{base} || $API{$f}{todo});
+        print "Supported at least starting from perl-$base.\n";
+      }
       $info++;
     }
     if ($API{$f}{provided}) {
@@ -280,6 +286,7 @@ if (exists $opt{'api-info'}) {
       $info++;
     }
 
+    if (! $API{$f}{ppport_fnc}) {
       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";
@@ -313,8 +320,10 @@ if (exists $opt{'api-info'}) {
               " 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 "\nFound no API matching '$opt{'api-info'}'.";
   print "\n";
   exit 0;
index 94ad122..d9fce1f 100644 (file)
@@ -349,6 +349,7 @@ sub parse_embed
               args  => \@args,
               cond  => ppcond(\@pps),
             };
+            $func[-1]{'ppport_fnc'} = 1 if $file =~ /ppport\.fnc/;
           }
           else {
             warn "mysterious name [$name] in $file, line $.\n";