ParseXS - Disable alias value collision warnings by default

demerphq · demerphq · commit 40db0ddf6975 · 2022-11-16T13:14:20.000+01:00
We always had a bug with the value 0, when fixing it, we discovered a lot
of people were doing duplicate aliases with 0. This patch disables the warnings
except when in a special author mode, as it makes no sense to show these warnings
to end users. It would seem most times creating such aliases is not an issue and
is entirely deliberate. So showing such warnings only to module authors and only
on request also makes sense.
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -11,7 +11,7 @@ use Symbol;
 
 our $VERSION;
 BEGIN {
-  $VERSION = '3.48';
+  $VERSION = '3.49';
   require ExtUtils::ParseXS::Constants; ExtUtils::ParseXS::Constants->VERSION($VERSION);
   require ExtUtils::ParseXS::CountLines; ExtUtils::ParseXS::CountLines->VERSION($VERSION);
   require ExtUtils::ParseXS::Utilities; ExtUtils::ParseXS::Utilities->VERSION($VERSION);
@@ -49,6 +49,9 @@ our @EXPORT_OK = qw(
 ##############################
 # A number of "constants"
 our $DIE_ON_ERROR;
+our $AUTHOR_WARNINGS;
+$AUTHOR_WARNINGS = ($ENV{AUTHOR_WARNINGS} || 0)
+    unless defined $AUTHOR_WARNINGS;
 our ($C_group_rex, $C_arg);
 # Group in C (no support for comments or literals)
 $C_group_rex = qr/ [({\[]
@@ -105,6 +108,7 @@ sub process_file {
     versioncheck    => 1,
     FH              => Symbol::gensym(),
     die_on_error    => $DIE_ON_ERROR, # if true we die() and not exit() after errors
+    author_warnings    => $AUTHOR_WARNINGS,
     %options,
   );
   $args{except} = $args{except} ? ' TRY' : '';
@@ -136,6 +140,7 @@ sub process_file {
   $self->{IncludedFiles} = {};
 
   $self->{die_on_error} = $args{die_on_error};
+  $self->{author_warnings} = $args{author_warnings};
 
   die "Missing required parameter 'filename'" unless $args{filename};
   $self->{filepathname} = $args{filename};
@@ -1372,7 +1377,10 @@ sub get_aliases {
       # yet as 0 is the default for the base function ($fname)
       push @keys, $fname
         if $value eq "0" and !defined $self->{XsubAlias}{$fname};
-      if (@keys) {
+      if (@keys and $self->{author_warnings}) {
+        # We do not warn about value collisions unless author_warnings
+        # are enabled. They aren't helpful to a module consumer, only
+        # the module author.
         @keys= map { "'$_'" }
                map { my $copy= $_;
                      $copy=~s/^$self->{Packprefix}//;
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use Symbol;
 
-our $VERSION = '3.48';
+our $VERSION = '3.49';
 
 =head1 NAME
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
@@ -1,7 +1,7 @@
 package ExtUtils::ParseXS::CountLines;
 use strict;
 
-our $VERSION = '3.48';
+our $VERSION = '3.49';
 
 our $SECTION_END_MARKER;
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm
@@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Eval;
 use strict;
 use warnings;
 
-our $VERSION = '3.48';
+our $VERSION = '3.49';
 
 =head1 NAME
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
@@ -5,7 +5,7 @@ use Exporter;
 use File::Spec;
 use ExtUtils::ParseXS::Constants ();
 
-our $VERSION = '3.48';
+our $VERSION = '3.49';
 
 our (@ISA, @EXPORT_OK);
 @ISA = qw(Exporter);
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.48';
+our $VERSION = '3.49';
 
 require ExtUtils::ParseXS;
 require ExtUtils::ParseXS::Constants;
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.48';
+our $VERSION = '3.49';
 
 use ExtUtils::Typemaps;
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.48';
+our $VERSION = '3.49';
 
 =head1 NAME
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap;
 use 5.006001;
 use strict;
 use warnings;
-our $VERSION = '3.48';
+our $VERSION = '3.49';
 
 =head1 NAME
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 require ExtUtils::Typemaps;
 
-our $VERSION = '3.48';
+our $VERSION = '3.49';
 
 =head1 NAME
 
diff --git a/dist/ExtUtils-ParseXS/lib/perlxs.pod b/dist/ExtUtils-ParseXS/lib/perlxs.pod
@@ -2409,7 +2409,18 @@ or use the methods given in L<perlcall>.
 =head1 XS VERSION
 
 This document covers features supported by C<ExtUtils::ParseXS>
-(also known as C<xsubpp>) 3.48
+(also known as C<xsubpp>) 3.49
+
+=head1 AUTHOR DIAGNOSTICS
+
+As of version 3.49 certain warnings are disabled by default. While developing
+you can set C<$ENV{AUTHOR_WARNINGS}> to true in your environment or in your
+Makefile.PL, or set C<$ExtUtils::ParseXS::AUTHOR_WARNINGS> to true via code, or
+pass C<< author_warnings=>1 >> into process_file() explicitly.  Currently this will
+enable stricter alias checking but more warnings might be added in the future.
+The kind of warnings this will enable are only helpful to the author of the XS
+file, and the diagnostics produced will not include installation specific
+details so they are only useful to the maintainer of the XS code itself.
 
 =head1 AUTHOR
 
diff --git a/dist/ExtUtils-ParseXS/t/001-basic.t b/dist/ExtUtils-ParseXS/t/001-basic.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl
 
 use strict;
-use Test::More tests => 26;
+use Test::More tests => 28;
 use Config;
 use DynaLoader;
 use ExtUtils::CBuilder;
@@ -16,6 +16,7 @@ chdir('t') if -d 't';
 push @INC, '.';
 
 $ExtUtils::ParseXS::DIE_ON_ERROR = 1;
+$ExtUtils::ParseXS::AUTHOR_WARNINGS = 1;
 
 use Carp; #$SIG{__WARN__} = \&Carp::cluck;
 
@@ -262,6 +263,48 @@ like $stderr, '/No INPUT definition/', "Exercise typemap error";
     . " identical values of 1 in XSAlias.xs, line 11\n"
     . "Warning: Aliases 'xunx' and 'do' have identical values"
     . " of 0 - the base function in XSAlias.xs, line 13\n",
+    "Saw expected warnings from XSAlias.xs in AUTHOR_WARNINGS mode";
+
+  my $expect = quotemeta(<<'EOF_CONTENT');
+         cv = newXSproto_portable("My::dachs", XS_My_do, file, "$");
+         XSANY.any_i32 = 1;
+         cv = newXSproto_portable("My::do", XS_My_do, file, "$");
+         XSANY.any_i32 = 0;
+         cv = newXSproto_portable("My::docks", XS_My_do, file, "$");
+         XSANY.any_i32 = 1;
+         cv = newXSproto_portable("My::dox", XS_My_do, file, "$");
+         XSANY.any_i32 = 1;
+         cv = newXSproto_portable("My::lox", XS_My_do, file, "$");
+         XSANY.any_i32 = 1;
+         cv = newXSproto_portable("My::pox", XS_My_do, file, "$");
+         XSANY.any_i32 = 2;
+         cv = newXSproto_portable("My::xukes", XS_My_do, file, "$");
+         XSANY.any_i32 = 0;
+         cv = newXSproto_portable("My::xunx", XS_My_do, file, "$");
+         XSANY.any_i32 = 0;
+EOF_CONTENT
+  $expect=~s/(?:\\[ ])+/\\s+/g;
+  $expect=qr/$expect/;
+  like $content, $expect, "Saw expected alias initialization";
+
+  #diag $content;
+}
+{ # Alias check with no dev warnings.
+  my $pxs = ExtUtils::ParseXS->new;
+  tie *FH, 'Foo';
+  my $stderr = PrimitiveCapture::capture_stderr(sub {
+    $pxs->process_file(
+      filename => 'XSAlias.xs',
+      output => \*FH,
+      prototypes => 1,
+      author_warnings => 0);
+  });
+  my $content = tied(*FH)->{buf};
+  my $count = 0;
+  $count++ while $content=~/^XS_EUPXS\(XS_My_do\)\n\{/mg;
+  is $stderr,
+    "Warning: Conflicting duplicate alias 'pox' changes"
+    . " definition from '1' to '2' in XSAlias.xs, line 10\n",
     "Saw expected warnings from XSAlias.xs";
 
   my $expect = quotemeta(<<'EOF_CONTENT');
