diff --git a/ExtUtils-ParseXS-3.44-Upgrade-to-3.45.patch b/ExtUtils-ParseXS-3.44-Upgrade-to-3.45.patch deleted file mode 100644 index 158adea..0000000 --- a/ExtUtils-ParseXS-3.44-Upgrade-to-3.45.patch +++ /dev/null @@ -1,335 +0,0 @@ -From ec9e3382bde7b18e432021e9a0ccd1c8c3dc5e9f Mon Sep 17 00:00:00 2001 -From: Jitka Plesnikova -Date: Wed, 11 May 2022 16:22:18 +0200 -Subject: [PATCH] Upgrade to 3.45 - ---- - Changes | 3 ++ - lib/ExtUtils/ParseXS.pm | 53 +++++++++++++++++++----------- - lib/ExtUtils/ParseXS/Constants.pm | 2 +- - lib/ExtUtils/ParseXS/CountLines.pm | 2 +- - lib/ExtUtils/ParseXS/Eval.pm | 2 +- - lib/ExtUtils/ParseXS/Utilities.pm | 2 +- - lib/ExtUtils/Typemaps.pm | 2 +- - lib/ExtUtils/Typemaps/Cmd.pm | 2 +- - lib/ExtUtils/Typemaps/InputMap.pm | 2 +- - lib/ExtUtils/Typemaps/OutputMap.pm | 2 +- - lib/ExtUtils/Typemaps/Type.pm | 2 +- - t/002-more.t | 7 ++-- - t/XSMore.xs | 14 ++++++++ - 13 files changed, 65 insertions(+), 30 deletions(-) - -diff --git a/Changes b/Changes -index c4da004..8a30751 100644 ---- a/Changes -+++ b/Changes -@@ -1,5 +1,8 @@ - Revision history for Perl extension ExtUtils::ParseXS. - -+3.45 - Fri Mar 4 22:42:03 2022 -+ - GH #19320: Fix OVERLOAD and FALLBACK handling. -+ - 3.44 - Thu Jan 6 23:49:25 2022 - - GH #19054: Always XSprePUSH when producing an output list. - - Use more descriptive variable names. -diff --git a/lib/ExtUtils/ParseXS.pm b/lib/ExtUtils/ParseXS.pm -index c3e8220..b9a9a79 100644 ---- a/lib/ExtUtils/ParseXS.pm -+++ b/lib/ExtUtils/ParseXS.pm -@@ -11,7 +11,7 @@ use Symbol; - - our $VERSION; - BEGIN { -- $VERSION = '3.44'; -+ $VERSION = '3.45'; - 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); -@@ -119,9 +119,9 @@ sub process_file { - } - @{ $self->{XSStack} } = ({type => 'none'}); - $self->{InitFileCode} = [ @ExtUtils::ParseXS::Constants::InitFileCode ]; -- $self->{Overload} = 0; # bool -+ $self->{Overloaded} = {}; # hashref of Package => Packid -+ $self->{Fallback} = {}; # hashref of Package => fallback setting - $self->{errors} = 0; # count -- $self->{Fallback} = '&PL_sv_undef'; - - # Most of the 1500 lines below uses these globals. We'll have to - # clean this up sometime, probably. For now, we just pull them out -@@ -301,6 +301,7 @@ EOM - $self->{interface_macro_set} = 'XSINTERFACE_FUNC_SET'; - $self->{ProtoThisXSUB} = $self->{WantPrototypes}; # states 0 (none), 1 (yes), 2 (empty prototype) - $self->{ScopeThisXSUB} = 0; # bool -+ $self->{OverloadsThisXSUB} = {}; # overloaded operators (as hash keys, to de-dup) - - my $xsreturn = 0; - -@@ -871,12 +872,20 @@ EOF - push(@{ $self->{InitFileCode} }, - " (void)$self->{newXS}(\"$self->{pname}\", XS_$self->{Full_func_name}$self->{file}$self->{proto});\n"); - } -+ -+ for my $operator (keys %{ $self->{OverloadsThisXSUB} }) { -+ $self->{Overloaded}->{$self->{Package}} = $self->{Packid}; -+ my $overload = "$self->{Package}\::($operator"; -+ push(@{ $self->{InitFileCode} }, -+ " (void)$self->{newXS}(\"$overload\", XS_$self->{Full_func_name}$self->{file}$self->{proto});\n"); -+ } - } # END 'PARAGRAPH' 'while' loop - -- if ($self->{Overload}) { # make it findable with fetchmethod -+ for my $package (keys %{ $self->{Overloaded} }) { # make them findable with fetchmethod -+ my $packid = $self->{Overloaded}->{$package}; - print Q(<<"EOF"); --#XS_EUPXS(XS_$self->{Packid}_nil); /* prototype to pass -Wmissing-prototypes */ --#XS_EUPXS(XS_$self->{Packid}_nil) -+#XS_EUPXS(XS_${packid}_nil); /* prototype to pass -Wmissing-prototypes */ -+#XS_EUPXS(XS_${packid}_nil) - #{ - # dXSARGS; - # PERL_UNUSED_VAR(items); -@@ -884,11 +893,11 @@ EOF - #} - # - EOF -- unshift(@{ $self->{InitFileCode} }, <<"MAKE_FETCHMETHOD_WORK"); -- /* Making a sub named "$self->{Package}::()" allows the package */ -- /* to be findable via fetchmethod(), and causes */ -- /* overload::Overloaded("$self->{Package}") to return true. */ -- (void)$self->{newXS}("$self->{Package}::()", XS_$self->{Packid}_nil$self->{file}$self->{proto}); -+ unshift(@{ $self->{InitFileCode} }, Q(<<"MAKE_FETCHMETHOD_WORK")); -+# /* Making a sub named "${package}::()" allows the package */ -+# /* to be findable via fetchmethod(), and causes */ -+# /* overload::Overloaded("$package") to return true. */ -+# (void)newXS_deffile("${package}::()", XS_${packid}_nil); - MAKE_FETCHMETHOD_WORK - } - -@@ -959,19 +968,28 @@ EOF - # - EOF - -- print Q(<<"EOF") if ($self->{Overload}); -+ if (%{ $self->{Overloaded} }) { -+ # once if any overloads -+ print Q(<<"EOF"); - # /* register the overloading (type 'A') magic */ - ##if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */ - # PL_amagic_generation++; - ##endif -+EOF -+ for my $package (keys %{ $self->{Overloaded} }) { -+ # once for each package with overloads -+ my $fallback = $self->{Fallback}->{$package} || "&PL_sv_undef"; -+ print Q(<<"EOF"); - # /* The magic for overload gets a GV* via gv_fetchmeth as */ - # /* mentioned above, and looks in the SV* slot of it for */ - # /* the "fallback" status. */ - # sv_setsv( --# get_sv( "$self->{Package}::()", TRUE ), --# $self->{Fallback} -+# get_sv( "${package}::()", TRUE ), -+# $fallback - # ); - EOF -+ } -+ } - - print @{ $self->{InitFileCode} }; - -@@ -1348,10 +1366,7 @@ sub OVERLOAD_handler { - next unless /\S/; - trim_whitespace($_); - while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}\=]+)\s*//) { -- $self->{Overload} = 1 unless $self->{Overload}; -- my $overload = "$self->{Package}\::(".$1; -- push(@{ $self->{InitFileCode} }, -- " (void)$self->{newXS}(\"$overload\", XS_$self->{Full_func_name}$self->{file}$self->{proto});\n"); -+ $self->{OverloadsThisXSUB}->{$1} = 1; - } - } - } -@@ -1374,7 +1389,7 @@ sub FALLBACK_handler { - # check for valid FALLBACK value - $self->death("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{$setting}; - -- $self->{Fallback} = $map{$setting}; -+ $self->{Fallback}->{$self->{Package}} = $map{$setting}; - } - - -diff --git a/lib/ExtUtils/ParseXS/Constants.pm b/lib/ExtUtils/ParseXS/Constants.pm -index 5b73795..09f1432 100644 ---- a/lib/ExtUtils/ParseXS/Constants.pm -+++ b/lib/ExtUtils/ParseXS/Constants.pm -@@ -3,7 +3,7 @@ use strict; - use warnings; - use Symbol; - --our $VERSION = '3.44'; -+our $VERSION = '3.45'; - - =head1 NAME - -diff --git a/lib/ExtUtils/ParseXS/CountLines.pm b/lib/ExtUtils/ParseXS/CountLines.pm -index a5b71f6..7611a85 100644 ---- a/lib/ExtUtils/ParseXS/CountLines.pm -+++ b/lib/ExtUtils/ParseXS/CountLines.pm -@@ -1,7 +1,7 @@ - package ExtUtils::ParseXS::CountLines; - use strict; - --our $VERSION = '3.44'; -+our $VERSION = '3.45'; - - our $SECTION_END_MARKER; - -diff --git a/lib/ExtUtils/ParseXS/Eval.pm b/lib/ExtUtils/ParseXS/Eval.pm -index 8a3bd00..c01c5ea 100644 ---- a/lib/ExtUtils/ParseXS/Eval.pm -+++ b/lib/ExtUtils/ParseXS/Eval.pm -@@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Eval; - use strict; - use warnings; - --our $VERSION = '3.44'; -+our $VERSION = '3.45'; - - =head1 NAME - -diff --git a/lib/ExtUtils/ParseXS/Utilities.pm b/lib/ExtUtils/ParseXS/Utilities.pm -index 574031d..c5f2b67 100644 ---- a/lib/ExtUtils/ParseXS/Utilities.pm -+++ b/lib/ExtUtils/ParseXS/Utilities.pm -@@ -5,7 +5,7 @@ use Exporter; - use File::Spec; - use ExtUtils::ParseXS::Constants (); - --our $VERSION = '3.44'; -+our $VERSION = '3.45'; - - our (@ISA, @EXPORT_OK); - @ISA = qw(Exporter); -diff --git a/lib/ExtUtils/Typemaps.pm b/lib/ExtUtils/Typemaps.pm -index c6d5430..12d5902 100644 ---- a/lib/ExtUtils/Typemaps.pm -+++ b/lib/ExtUtils/Typemaps.pm -@@ -2,7 +2,7 @@ package ExtUtils::Typemaps; - use 5.006001; - use strict; - use warnings; --our $VERSION = '3.44'; -+our $VERSION = '3.45'; - - require ExtUtils::ParseXS; - require ExtUtils::ParseXS::Constants; -diff --git a/lib/ExtUtils/Typemaps/Cmd.pm b/lib/ExtUtils/Typemaps/Cmd.pm -index 3c4b4e5..7bfa29c 100644 ---- a/lib/ExtUtils/Typemaps/Cmd.pm -+++ b/lib/ExtUtils/Typemaps/Cmd.pm -@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd; - use 5.006001; - use strict; - use warnings; --our $VERSION = '3.44'; -+our $VERSION = '3.45'; - - use ExtUtils::Typemaps; - -diff --git a/lib/ExtUtils/Typemaps/InputMap.pm b/lib/ExtUtils/Typemaps/InputMap.pm -index 102fc9e..a10f527 100644 ---- a/lib/ExtUtils/Typemaps/InputMap.pm -+++ b/lib/ExtUtils/Typemaps/InputMap.pm -@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap; - use 5.006001; - use strict; - use warnings; --our $VERSION = '3.44'; -+our $VERSION = '3.45'; - - =head1 NAME - -diff --git a/lib/ExtUtils/Typemaps/OutputMap.pm b/lib/ExtUtils/Typemaps/OutputMap.pm -index f9b5a86..990901b 100644 ---- a/lib/ExtUtils/Typemaps/OutputMap.pm -+++ b/lib/ExtUtils/Typemaps/OutputMap.pm -@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap; - use 5.006001; - use strict; - use warnings; --our $VERSION = '3.44'; -+our $VERSION = '3.45'; - - =head1 NAME - -diff --git a/lib/ExtUtils/Typemaps/Type.pm b/lib/ExtUtils/Typemaps/Type.pm -index 1a78c17..94f2345 100644 ---- a/lib/ExtUtils/Typemaps/Type.pm -+++ b/lib/ExtUtils/Typemaps/Type.pm -@@ -4,7 +4,7 @@ use strict; - use warnings; - require ExtUtils::Typemaps; - --our $VERSION = '3.44'; -+our $VERSION = '3.45'; - - =head1 NAME - -diff --git a/t/002-more.t b/t/002-more.t -index 1ed93a0..ee3bf9b 100644 ---- a/t/002-more.t -+++ b/t/002-more.t -@@ -9,7 +9,7 @@ use ExtUtils::CBuilder; - use attributes; - use overload; - --plan tests => 32; -+plan tests => 33; - - my ($source_file, $obj_file, $lib_file); - -@@ -47,7 +47,7 @@ SKIP: { - } - - SKIP: { -- skip "no dynamic loading", 28 -+ skip "no dynamic loading", 29 - if !$b->have_compiler || !$Config{usedl}; - my $module = 'XSMore'; - $lib_file = $b->link( objects => $obj_file, module_name => $module ); -@@ -85,6 +85,9 @@ SKIP: { - ok overload::Overloaded(XSMore->new), 'the FALLBACK keyword'; - is abs(XSMore->new), 42, 'the OVERLOAD keyword'; - -+ my $overload_sub_name = "XSMore::More::(+"; -+ is prototype(\&$overload_sub_name), "", 'OVERLOAD following prototyped xsub'; -+ - my @a; - XSMore::hook(\@a); - is_deeply \@a, [qw(INIT CODE POSTCALL CLEANUP)], 'the INIT & POSTCALL & CLEANUP keywords'; -diff --git a/t/XSMore.xs b/t/XSMore.xs -index f8413f4..938fa79 100644 ---- a/t/XSMore.xs -+++ b/t/XSMore.xs -@@ -251,3 +251,17 @@ INCLUDE: XSInclude.xsh - # for testing #else directive - - #endif -+ -+MODULE=XSMore PACKAGE=XSMore::More -+ -+void -+dummy() -+PROTOTYPE: $$$$$ -+CODE: -+ NOOP; -+ -+void -+should_not_have_prototype() -+OVERLOAD: + -+CODE: -+ NOOP; --- -2.34.3 - diff --git a/ExtUtils-ParseXS-3.44-Upgrade-to-3.50.patch b/ExtUtils-ParseXS-3.44-Upgrade-to-3.50.patch new file mode 100644 index 0000000..36e7e43 --- /dev/null +++ b/ExtUtils-ParseXS-3.44-Upgrade-to-3.50.patch @@ -0,0 +1,1164 @@ +From 2f9bbf8d0bd95bb60498d0fe8b37ded3f5ac42f1 Mon Sep 17 00:00:00 2001 +From: Jitka Plesnikova +Date: Wed, 17 May 2023 09:25:56 +0200 +Subject: [PATCH] Upgrade to 3.50 + +--- + Changes | 3 + + lib/ExtUtils/ParseXS.pm | 201 ++++++++++++++++++++++++----- + lib/ExtUtils/ParseXS.pod | 10 ++ + lib/ExtUtils/ParseXS/Constants.pm | 2 +- + lib/ExtUtils/ParseXS/CountLines.pm | 2 +- + lib/ExtUtils/ParseXS/Eval.pm | 2 +- + lib/ExtUtils/ParseXS/Utilities.pm | 81 +++++++++++- + lib/ExtUtils/Typemaps.pm | 4 +- + lib/ExtUtils/Typemaps/Cmd.pm | 2 +- + lib/ExtUtils/Typemaps/InputMap.pm | 2 +- + lib/ExtUtils/Typemaps/OutputMap.pm | 2 +- + lib/ExtUtils/Typemaps/Type.pm | 2 +- + lib/perlxs.pod | 53 +++++++- + t/001-basic.t | 166 +++++++++++++++++++++++- + t/002-more.t | 9 +- + t/003-usage.t | 2 +- + t/XSAlias.xs | 19 +++ + t/XSFalsePositive.xs | 23 ++++ + t/XSFalsePositive2.xs | 23 ++++ + t/XSMore.xs | 18 +++ + t/XSTightDirectives.xs | 21 +++ + 21 files changed, 596 insertions(+), 51 deletions(-) + create mode 100644 t/XSAlias.xs + create mode 100644 t/XSFalsePositive.xs + create mode 100644 t/XSFalsePositive2.xs + create mode 100644 t/XSTightDirectives.xs + +diff --git a/Changes b/Changes +index c4da004..8a30751 100644 +--- a/Changes ++++ b/Changes +@@ -1,5 +1,8 @@ + Revision history for Perl extension ExtUtils::ParseXS. + ++3.45 - Fri Mar 4 22:42:03 2022 ++ - GH #19320: Fix OVERLOAD and FALLBACK handling. ++ + 3.44 - Thu Jan 6 23:49:25 2022 + - GH #19054: Always XSprePUSH when producing an output list. + - Use more descriptive variable names. +diff --git a/lib/ExtUtils/ParseXS.pm b/lib/ExtUtils/ParseXS.pm +index c3e8220..3975dd4 100644 +--- a/lib/ExtUtils/ParseXS.pm ++++ b/lib/ExtUtils/ParseXS.pm +@@ -11,7 +11,7 @@ use Symbol; + + our $VERSION; + BEGIN { +- $VERSION = '3.44'; ++ $VERSION = '3.50'; + 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); +@@ -31,6 +31,7 @@ use ExtUtils::ParseXS::Utilities qw( + analyze_preprocessor_statements + set_cond + Warn ++ WarnHint + current_line_number + blurt + death +@@ -47,7 +48,10 @@ 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/ [({\[] +@@ -103,6 +107,8 @@ sub process_file { + typemap => [], + 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' : ''; +@@ -119,9 +125,9 @@ sub process_file { + } + @{ $self->{XSStack} } = ({type => 'none'}); + $self->{InitFileCode} = [ @ExtUtils::ParseXS::Constants::InitFileCode ]; +- $self->{Overload} = 0; # bool ++ $self->{Overloaded} = {}; # hashref of Package => Packid ++ $self->{Fallback} = {}; # hashref of Package => fallback setting + $self->{errors} = 0; # count +- $self->{Fallback} = '&PL_sv_undef'; + + # Most of the 1500 lines below uses these globals. We'll have to + # clean this up sometime, probably. For now, we just pull them out +@@ -133,6 +139,9 @@ sub process_file { + $self->{WantLineNumbers} = $args{linenumbers}; + $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}; + ($self->{dir}, $self->{filename}) = +@@ -301,6 +310,7 @@ EOM + $self->{interface_macro_set} = 'XSINTERFACE_FUNC_SET'; + $self->{ProtoThisXSUB} = $self->{WantPrototypes}; # states 0 (none), 1 (yes), 2 (empty prototype) + $self->{ScopeThisXSUB} = 0; # bool ++ $self->{OverloadsThisXSUB} = {}; # overloaded operators (as hash keys, to de-dup) + + my $xsreturn = 0; + +@@ -626,7 +636,16 @@ EOF + $self->print_section(); + $self->death("PPCODE must be last thing") if @{ $self->{line} }; + print "\tLEAVE;\n" if $self->{ScopeThisXSUB}; ++ print "#if defined(__HP_cc) || defined(__HP_aCC)\n", ++ "#pragma diag_suppress 2111\n", ++ "#endif\n" ++ if $^O eq "hpux"; + print "\tPUTBACK;\n\treturn;\n"; ++ print "#if defined(__HP_cc) || defined(__HP_aCC)\n", ++ "#pragma diag_default 2111\n", ++ "#endif\n" ++ if $^O eq "hpux"; ++ + } + elsif ($self->check_keyword("CODE")) { + my $consumed_code = $self->print_section(); +@@ -788,6 +807,10 @@ EOF + # if (errbuf[0]) + # Perl_croak(aTHX_ errbuf); + EOF ++ print "#if defined(__HP_cc) || defined(__HP_aCC)\n", ++ "#pragma diag_suppress 2128\n", ++ "#endif\n" ++ if $^O eq "hpux"; + + if ($xsreturn) { + print Q(<<"EOF") unless $PPCODE; +@@ -799,6 +822,10 @@ EOF + # XSRETURN_EMPTY; + EOF + } ++ print "#if defined(__HP_cc) || defined(__HP_aCC)\n", ++ "#pragma diag_default 2128\n", ++ "#endif\n" ++ if $^O eq "hpux"; + + print Q(<<"EOF"); + #]] +@@ -871,12 +898,20 @@ EOF + push(@{ $self->{InitFileCode} }, + " (void)$self->{newXS}(\"$self->{pname}\", XS_$self->{Full_func_name}$self->{file}$self->{proto});\n"); + } ++ ++ for my $operator (sort keys %{ $self->{OverloadsThisXSUB} }) { ++ $self->{Overloaded}->{$self->{Package}} = $self->{Packid}; ++ my $overload = "$self->{Package}\::($operator"; ++ push(@{ $self->{InitFileCode} }, ++ " (void)$self->{newXS}(\"$overload\", XS_$self->{Full_func_name}$self->{file}$self->{proto});\n"); ++ } + } # END 'PARAGRAPH' 'while' loop + +- if ($self->{Overload}) { # make it findable with fetchmethod ++ for my $package (sort keys %{ $self->{Overloaded} }) { # make them findable with fetchmethod ++ my $packid = $self->{Overloaded}->{$package}; + print Q(<<"EOF"); +-#XS_EUPXS(XS_$self->{Packid}_nil); /* prototype to pass -Wmissing-prototypes */ +-#XS_EUPXS(XS_$self->{Packid}_nil) ++#XS_EUPXS(XS_${packid}_nil); /* prototype to pass -Wmissing-prototypes */ ++#XS_EUPXS(XS_${packid}_nil) + #{ + # dXSARGS; + # PERL_UNUSED_VAR(items); +@@ -884,11 +919,11 @@ EOF + #} + # + EOF +- unshift(@{ $self->{InitFileCode} }, <<"MAKE_FETCHMETHOD_WORK"); +- /* Making a sub named "$self->{Package}::()" allows the package */ +- /* to be findable via fetchmethod(), and causes */ +- /* overload::Overloaded("$self->{Package}") to return true. */ +- (void)$self->{newXS}("$self->{Package}::()", XS_$self->{Packid}_nil$self->{file}$self->{proto}); ++ unshift(@{ $self->{InitFileCode} }, Q(<<"MAKE_FETCHMETHOD_WORK")); ++# /* Making a sub named "${package}::()" allows the package */ ++# /* to be findable via fetchmethod(), and causes */ ++# /* overload::Overloaded("$package") to return true. */ ++# (void)newXS_deffile("${package}::()", XS_${packid}_nil); + MAKE_FETCHMETHOD_WORK + } + +@@ -959,19 +994,28 @@ EOF + # + EOF + +- print Q(<<"EOF") if ($self->{Overload}); ++ if (keys %{ $self->{Overloaded} }) { ++ # once if any overloads ++ print Q(<<"EOF"); + # /* register the overloading (type 'A') magic */ + ##if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */ + # PL_amagic_generation++; + ##endif ++EOF ++ for my $package (sort keys %{ $self->{Overloaded} }) { ++ # once for each package with overloads ++ my $fallback = $self->{Fallback}->{$package} || "&PL_sv_undef"; ++ print Q(<<"EOF"); + # /* The magic for overload gets a GV* via gv_fetchmeth as */ + # /* mentioned above, and looks in the SV* slot of it for */ + # /* the "fallback" status. */ + # sv_setsv( +-# get_sv( "$self->{Package}::()", TRUE ), +-# $self->{Fallback} ++# get_sv( "${package}::()", TRUE ), ++# $fallback + # ); + EOF ++ } ++ } + + print @{ $self->{InitFileCode} }; + +@@ -1292,26 +1336,89 @@ sub get_aliases { + my ($line) = @_; + my ($orig) = $line; + ++ # we use this later for symbolic aliases ++ my $fname = $self->{Packprefix} . $self->{func_name}; ++ + # Parse alias definitions + # format is +- # alias = value alias = value ... +- +- while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) { +- my ($alias, $value) = ($1, $2); ++ # alias = value Pack::alias = value ... ++ # or ++ # alias => other ++ # or ++ # alias => Pack::other ++ # or ++ # Pack::alias => Other::alias ++ ++ while ($line =~ s/^\s*([\w:]+)\s*=(>?)\s*([\w:]+)\s*//) { ++ my ($alias, $is_symbolic, $value) = ($1, $2, $3); + my $orig_alias = $alias; + ++ blurt( $self, "Error: In alias definition for '$alias' the value may not" ++ . " contain ':' unless it is symbolic.") ++ if !$is_symbolic and $value=~/:/; ++ + # check for optional package definition in the alias + $alias = $self->{Packprefix} . $alias if $alias !~ /::/; + ++ if ($is_symbolic) { ++ my $orig_value = $value; ++ $value = $self->{Packprefix} . $value if $value !~ /::/; ++ if (defined $self->{XsubAliases}->{$value}) { ++ $value = $self->{XsubAliases}->{$value}; ++ } elsif ($value eq $fname) { ++ $value = 0; ++ } else { ++ blurt( $self, "Error: Unknown alias '$value' in symbolic definition for '$orig_alias'"); ++ } ++ } ++ + # check for duplicate alias name & duplicate value +- Warn( $self, "Warning: Ignoring duplicate alias '$orig_alias'") +- if defined $self->{XsubAliases}->{$alias}; ++ my $prev_value = $self->{XsubAliases}->{$alias}; ++ if (defined $prev_value) { ++ if ($prev_value eq $value) { ++ Warn( $self, "Warning: Ignoring duplicate alias '$orig_alias'") ++ } else { ++ Warn( $self, "Warning: Conflicting duplicate alias '$orig_alias'" ++ . " changes definition from '$prev_value' to '$value'"); ++ delete $self->{XsubAliasValues}->{$prev_value}{$alias}; ++ } ++ } + +- Warn( $self, "Warning: Aliases '$orig_alias' and '$self->{XsubAliasValues}->{$value}' have identical values") +- if $self->{XsubAliasValues}->{$value}; ++ # Check and see if this alias results in two aliases having the same ++ # value, we only check non-symbolic definitions as the whole point of ++ # symbolic definitions is to say we want to duplicate the value and ++ # it is NOT a mistake. ++ unless ($is_symbolic) { ++ my @keys= sort keys %{$self->{XsubAliasValues}->{$value}||{}}; ++ # deal with an alias of 0, which might not be in the XsubAlias dataset ++ # 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 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}//; ++ $copy ++ } @keys; ++ WarnHint( $self, ++ "Warning: Aliases '$orig_alias' and " ++ . join(", ", @keys) ++ . " have identical values of $value" ++ . ( $value eq "0" ++ ? " - the base function" ++ : "" ), ++ !$self->{XsubAliasValueClashHinted}++ ++ ? "If this is deliberate use a symbolic alias instead." ++ : undef ++ ); ++ } ++ } + + $self->{XsubAliases}->{$alias} = $value; +- $self->{XsubAliasValues}->{$value} = $orig_alias; ++ $self->{XsubAliasValues}->{$value}{$alias}++; + } + + blurt( $self, "Error: Cannot parse ALIAS definitions from '$orig'") +@@ -1348,10 +1455,7 @@ sub OVERLOAD_handler { + next unless /\S/; + trim_whitespace($_); + while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}\=]+)\s*//) { +- $self->{Overload} = 1 unless $self->{Overload}; +- my $overload = "$self->{Package}\::(".$1; +- push(@{ $self->{InitFileCode} }, +- " (void)$self->{newXS}(\"$overload\", XS_$self->{Full_func_name}$self->{file}$self->{proto});\n"); ++ $self->{OverloadsThisXSUB}->{$1} = 1; + } + } + } +@@ -1374,7 +1478,7 @@ sub FALLBACK_handler { + # check for valid FALLBACK value + $self->death("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{$setting}; + +- $self->{Fallback} = $map{$setting}; ++ $self->{Fallback}->{$self->{Package}} = $map{$setting}; + } + + +@@ -1785,11 +1889,17 @@ sub fetch_para { + $self->_process_module_xs_line($1, $2, $3); + } + ++ # count how many #ifdef levels we see in this paragraph ++ # decrementing when we see an endif. if we see an elsif ++ # or endif without a corresponding #ifdef then we dont ++ # consider it part of this paragraph. ++ my $if_level = 0; + for (;;) { + $self->_maybe_skip_pod; + + $self->_maybe_parse_typemap_block; + ++ my $final; + if ($self->{lastline} !~ /^\s*#/ # not a CPP directive + # CPP directives: + # ANSI: if ifdef ifndef elif else endif define undef +@@ -1799,7 +1909,7 @@ sub fetch_para { + # others: ident (gcc notes that some cpps have this one) + || $self->{lastline} =~ /^\#[ \t]* + (?: +- (?:if|ifn?def|elif|else|endif| ++ (?:if|ifn?def|elif|else|endif|elifn?def| + define|undef|pragma|error| + warning|line\s+\d+|ident) + \b +@@ -1810,6 +1920,31 @@ sub fetch_para { + ) + { + last if $self->{lastline} =~ /^\S/ && @{ $self->{line} } && $self->{line}->[-1] eq ""; ++ if ($self->{lastline}=~/^#[ \t]*(if|ifn?def|elif|else|endif|elifn?def)\b/) { ++ my $type = $1; # highest defined capture buffer, "if" for any if like condition ++ if ($type =~ /^if/) { ++ if (@{$self->{line}}) { ++ # increment level ++ $if_level++; ++ } else { ++ $final = 1; ++ } ++ } elsif ($type eq "endif") { ++ if ($if_level) { # are we in an if that was started in this paragraph? ++ $if_level--; # yep- so decrement to end this if block ++ } else { ++ $final = 1; ++ } ++ } elsif (!$if_level) { ++ # not in an #ifdef from this paragraph, thus ++ # this directive should not be part of this paragraph. ++ $final = 1; ++ } ++ } ++ if ($final and @{$self->{line}}) { ++ return 1; ++ } ++ + push(@{ $self->{line} }, $self->{lastline}); + push(@{ $self->{line_no} }, $self->{lastline_no}); + } +@@ -1823,6 +1958,9 @@ sub fetch_para { + + chomp $self->{lastline}; + $self->{lastline} =~ s/^\s+$//; ++ if ($final) { ++ last; ++ } + } + + # Nuke trailing "line" entries until there's one that's not empty +@@ -2028,8 +2166,9 @@ sub generate_output { + (my $ntype = $type) =~ s/\s*\*/Ptr/g; + $ntype =~ s/\(\)//g; + (my $subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//; ++ $type =~ tr/:/_/ unless $self->{RetainCplusplusHierarchicalTypes}; + +- my $eval_vars = {%$argsref, subtype => $subtype, ntype => $ntype, arg => $arg}; ++ my $eval_vars = {%$argsref, subtype => $subtype, ntype => $ntype, arg => $arg, type => $type }; + my $expr = $outputmap->cleaned_code; + if ($expr =~ /DO_ARRAY_ELEM/) { + my $subtypemap = $typemaps->get_typemap(ctype => $subtype); +diff --git a/lib/ExtUtils/ParseXS.pod b/lib/ExtUtils/ParseXS.pod +index 80bf13f..093a317 100644 +--- a/lib/ExtUtils/ParseXS.pod ++++ b/lib/ExtUtils/ParseXS.pod +@@ -19,6 +19,7 @@ ExtUtils::ParseXS - converts Perl XS code into C code + linenumbers => 1, + optimize => 1, + prototypes => 1, ++ die_on_error => 0, + ); + + # Legacy non-OO interface using a singleton: +@@ -119,6 +120,15 @@ Default is true. + + I I have no clue what this does. Strips function prefixes? + ++=item B ++ ++Normally ExtUtils::ParseXS will terminate the program with an C after ++printing the details of the exception to STDERR via (warn). This can be awkward ++when it is used programmatically and not via xsubpp, so this option can be used ++to cause it to die instead by providing a true value. When not provided this ++defaults to the value of C<$ExtUtils::ParseXS::DIE_ON_ERROR> which in turn ++defaults to false. ++ + =back + + =item $pxs->report_error_count() +diff --git a/lib/ExtUtils/ParseXS/Constants.pm b/lib/ExtUtils/ParseXS/Constants.pm +index 5b73795..5acd1b0 100644 +--- a/lib/ExtUtils/ParseXS/Constants.pm ++++ b/lib/ExtUtils/ParseXS/Constants.pm +@@ -3,7 +3,7 @@ use strict; + use warnings; + use Symbol; + +-our $VERSION = '3.44'; ++our $VERSION = '3.50'; + + =head1 NAME + +diff --git a/lib/ExtUtils/ParseXS/CountLines.pm b/lib/ExtUtils/ParseXS/CountLines.pm +index a5b71f6..0282372 100644 +--- a/lib/ExtUtils/ParseXS/CountLines.pm ++++ b/lib/ExtUtils/ParseXS/CountLines.pm +@@ -1,7 +1,7 @@ + package ExtUtils::ParseXS::CountLines; + use strict; + +-our $VERSION = '3.44'; ++our $VERSION = '3.50'; + + our $SECTION_END_MARKER; + +diff --git a/lib/ExtUtils/ParseXS/Eval.pm b/lib/ExtUtils/ParseXS/Eval.pm +index 8a3bd00..da323cf 100644 +--- a/lib/ExtUtils/ParseXS/Eval.pm ++++ b/lib/ExtUtils/ParseXS/Eval.pm +@@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Eval; + use strict; + use warnings; + +-our $VERSION = '3.44'; ++our $VERSION = '3.50'; + + =head1 NAME + +diff --git a/lib/ExtUtils/ParseXS/Utilities.pm b/lib/ExtUtils/ParseXS/Utilities.pm +index 574031d..054cbb2 100644 +--- a/lib/ExtUtils/ParseXS/Utilities.pm ++++ b/lib/ExtUtils/ParseXS/Utilities.pm +@@ -5,7 +5,7 @@ use Exporter; + use File::Spec; + use ExtUtils::ParseXS::Constants (); + +-our $VERSION = '3.44'; ++our $VERSION = '3.50'; + + our (@ISA, @EXPORT_OK); + @ISA = qw(Exporter); +@@ -21,6 +21,7 @@ our (@ISA, @EXPORT_OK); + analyze_preprocessor_statements + set_cond + Warn ++ WarnHint + current_line_number + blurt + death +@@ -654,18 +655,85 @@ sub current_line_number { + + =item * Purpose + ++Print warnings with line number details at the end. ++ + =item * Arguments + ++List of text to output. ++ + =item * Return Value + ++None. ++ + =back + + =cut + + sub Warn { ++ my ($self)=shift; ++ $self->WarnHint(@_,undef); ++} ++ ++=head2 C ++ ++=over 4 ++ ++=item * Purpose ++ ++Prints warning with line number details. The last argument is assumed ++to be a hint string. ++ ++=item * Arguments ++ ++List of strings to warn, followed by one argument representing a hint. ++If that argument is defined then it will be split on newlines and output ++line by line after the main warning. ++ ++=item * Return Value ++ ++None. ++ ++=back ++ ++=cut ++ ++sub WarnHint { ++ warn _MsgHint(@_); ++} ++ ++=head2 C<_MsgHint()> ++ ++=over 4 ++ ++=item * Purpose ++ ++Constructs an exception message with line number details. The last argument is ++assumed to be a hint string. ++ ++=item * Arguments ++ ++List of strings to warn, followed by one argument representing a hint. ++If that argument is defined then it will be split on newlines and concatenated ++line by line (parenthesized) after the main message. ++ ++=item * Return Value ++ ++The constructed string. ++ ++=back ++ ++=cut ++ ++ ++sub _MsgHint { + my $self = shift; ++ my $hint = pop; + my $warn_line_number = $self->current_line_number(); +- print STDERR "@_ in $self->{filename}, line $warn_line_number\n"; ++ my $ret = join("",@_) . " in $self->{filename}, line $warn_line_number\n"; ++ if ($hint) { ++ $ret .= " ($_)\n" for split /\n/, $hint; ++ } ++ return $ret; + } + + =head2 C +@@ -703,8 +771,13 @@ sub blurt { + =cut + + sub death { +- my $self = shift; +- $self->Warn(@_); ++ my $self = (@_); ++ my $message = _MsgHint(@_,""); ++ if ($self->{die_on_error}) { ++ die $message; ++ } else { ++ warn $message; ++ } + exit 1; + } + +diff --git a/lib/ExtUtils/Typemaps.pm b/lib/ExtUtils/Typemaps.pm +index c6d5430..5d5aadb 100644 +--- a/lib/ExtUtils/Typemaps.pm ++++ b/lib/ExtUtils/Typemaps.pm +@@ -2,7 +2,7 @@ package ExtUtils::Typemaps; + use 5.006001; + use strict; + use warnings; +-our $VERSION = '3.44'; ++our $VERSION = '3.49'; + + require ExtUtils::ParseXS; + require ExtUtils::ParseXS::Constants; +@@ -378,7 +378,7 @@ sub remove_inputmap { + return $self->_remove($xstype, $self->{input_section}, $self->{input_lookup}); + } + +-=head2 remove_inputmap ++=head2 remove_outputmap + + Removes an C entry from the typemap. + +diff --git a/lib/ExtUtils/Typemaps/Cmd.pm b/lib/ExtUtils/Typemaps/Cmd.pm +index 3c4b4e5..0958920 100644 +--- a/lib/ExtUtils/Typemaps/Cmd.pm ++++ b/lib/ExtUtils/Typemaps/Cmd.pm +@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd; + use 5.006001; + use strict; + use warnings; +-our $VERSION = '3.44'; ++our $VERSION = '3.49'; + + use ExtUtils::Typemaps; + +diff --git a/lib/ExtUtils/Typemaps/InputMap.pm b/lib/ExtUtils/Typemaps/InputMap.pm +index 102fc9e..189cd55 100644 +--- a/lib/ExtUtils/Typemaps/InputMap.pm ++++ b/lib/ExtUtils/Typemaps/InputMap.pm +@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap; + use 5.006001; + use strict; + use warnings; +-our $VERSION = '3.44'; ++our $VERSION = '3.49'; + + =head1 NAME + +diff --git a/lib/ExtUtils/Typemaps/OutputMap.pm b/lib/ExtUtils/Typemaps/OutputMap.pm +index f9b5a86..5fadbec 100644 +--- a/lib/ExtUtils/Typemaps/OutputMap.pm ++++ b/lib/ExtUtils/Typemaps/OutputMap.pm +@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap; + use 5.006001; + use strict; + use warnings; +-our $VERSION = '3.44'; ++our $VERSION = '3.49'; + + =head1 NAME + +diff --git a/lib/ExtUtils/Typemaps/Type.pm b/lib/ExtUtils/Typemaps/Type.pm +index 1a78c17..8d049c1 100644 +--- a/lib/ExtUtils/Typemaps/Type.pm ++++ b/lib/ExtUtils/Typemaps/Type.pm +@@ -4,7 +4,7 @@ use strict; + use warnings; + require ExtUtils::Typemaps; + +-our $VERSION = '3.44'; ++our $VERSION = '3.49'; + + =head1 NAME + +diff --git a/lib/perlxs.pod b/lib/perlxs.pod +index f1bd408..0441fcc 100644 +--- a/lib/perlxs.pod ++++ b/lib/perlxs.pod +@@ -1332,6 +1332,46 @@ C for this function. + OUTPUT: + timep + ++A warning will be produced when you create more than one alias to the same ++value. This may be worked around in a backwards compatible way by creating ++multiple defines which resolve to the same value, or with a modern version ++of ExtUtils::ParseXS you can use a symbolic alias, which are denoted with ++a C<< => >> instead of a C<< = >>. For instance you could change the above ++so that the alias section looked like this: ++ ++ ALIAS: ++ FOO::gettime = 1 ++ BAR::getit = 2 ++ BAZ::gettime => FOO::gettime ++ ++this would have the same effect as this: ++ ++ ALIAS: ++ FOO::gettime = 1 ++ BAR::getit = 2 ++ BAZ::gettime = 1 ++ ++except that the latter will produce warnings during the build process. A ++mechanism that would work in a backwards compatible way with older ++versions of our tool chain would be to do this: ++ ++ #define FOO_GETTIME 1 ++ #define BAR_GETIT 2 ++ #define BAZ_GETTIME 1 ++ ++ bool_t ++ rpcb_gettime(host,timep) ++ char *host ++ time_t &timep ++ ALIAS: ++ FOO::gettime = FOO_GETTIME ++ BAR::getit = BAR_GETIT ++ BAZ::gettime = BAZ_GETTIME ++ INIT: ++ printf("# ix = %d\n", ix ); ++ OUTPUT: ++ timep ++ + =head2 The OVERLOAD: Keyword + + Instead of writing an overloaded interface using pure Perl, you +@@ -2369,7 +2409,18 @@ or use the methods given in L. + =head1 XS VERSION + + This document covers features supported by C +-(also known as C) 3.13_01. ++(also known as C) 3.50 ++ ++=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/t/001-basic.t b/t/001-basic.t +index 6651809..d983476 100644 +--- a/t/001-basic.t ++++ b/t/001-basic.t +@@ -1,7 +1,7 @@ + #!/usr/bin/perl + + use strict; +-use Test::More tests => 18; ++use Test::More tests => 28; + use Config; + use DynaLoader; + use ExtUtils::CBuilder; +@@ -15,7 +15,10 @@ require_ok( 'ExtUtils::ParseXS' ); + chdir('t') if -d 't'; + push @INC, '.'; + +-use Carp; $SIG{__WARN__} = \&Carp::cluck; ++$ExtUtils::ParseXS::DIE_ON_ERROR = 1; ++$ExtUtils::ParseXS::AUTHOR_WARNINGS = 1; ++ ++use Carp; #$SIG{__WARN__} = \&Carp::cluck; + + # The linker on some platforms doesn't like loading libraries using relative + # paths. Android won't find relative paths, and system perl on macOS will +@@ -91,6 +94,7 @@ is( $seen, 1, "Line numbers created in output file, as intended" ); + local $/ = undef; + seek($IN, 0, 0); + my $filecontents = <$IN>; ++ $filecontents =~ s/^#if defined\(__HP_cc\).*\n#.*\n#endif\n//gm; + my $good_T_BOOL_re = + qr|\QXS_EUPXS(XS_XSTest_T_BOOL)\E + .+? +@@ -190,6 +194,164 @@ like $stderr, '/No INPUT definition/', "Exercise typemap error"; + } + ##################################################################### + ++{ # fourth block: https://github.com/Perl/perl5/issues/19661 ++ my $pxs = ExtUtils::ParseXS->new; ++ tie *FH, 'Foo'; ++ my ($stderr, $filename); ++ { ++ $filename = 'XSFalsePositive.xs'; ++ $stderr = PrimitiveCapture::capture_stderr(sub { ++ $pxs->process_file(filename => $filename, output => \*FH, prototypes => 1); ++ }); ++ TODO: { ++ local $TODO = 'GH 19661'; ++ unlike $stderr, ++ qr/Warning: duplicate function definition 'do' detected in \Q$filename\E/, ++ "No 'duplicate function definition' warning observed in $filename"; ++ } ++ } ++ { ++ $filename = 'XSFalsePositive2.xs'; ++ $stderr = PrimitiveCapture::capture_stderr(sub { ++ $pxs->process_file(filename => $filename, output => \*FH, prototypes => 1); ++ }); ++ TODO: { ++ local $TODO = 'GH 19661'; ++ unlike $stderr, ++ qr/Warning: duplicate function definition 'do' detected in \Q$filename\E/, ++ "No 'duplicate function definition' warning observed in $filename"; ++ } ++ } ++} ++ ++##################################################################### ++ ++{ # tight cpp directives ++ my $pxs = ExtUtils::ParseXS->new; ++ tie *FH, 'Foo'; ++ my $stderr = PrimitiveCapture::capture_stderr(sub { eval { ++ $pxs->process_file( ++ filename => 'XSTightDirectives.xs', ++ output => \*FH, ++ prototypes => 1); ++ } or warn $@ }); ++ my $content = tied(*FH)->{buf}; ++ my $count = 0; ++ $count++ while $content=~/^XS_EUPXS\(XS_My_do\)\n\{/mg; ++ is $stderr, undef, "No error expected from TightDirectives.xs"; ++ is $count, 2, "Saw XS_MY_do definition the expected number of times"; ++} ++ ++{ # Alias check ++ my $pxs = ExtUtils::ParseXS->new; ++ tie *FH, 'Foo'; ++ my $stderr = PrimitiveCapture::capture_stderr(sub { ++ $pxs->process_file( ++ filename => 'XSAlias.xs', ++ output => \*FH, ++ prototypes => 1); ++ }); ++ my $content = tied(*FH)->{buf}; ++ my $count = 0; ++ $count++ while $content=~/^XS_EUPXS\(XS_My_do\)\n\{/mg; ++ is $stderr, ++ "Warning: Aliases 'pox' and 'dox', 'lox' have" ++ . " identical values of 1 in XSAlias.xs, line 9\n" ++ . " (If this is deliberate use a symbolic alias instead.)\n" ++ . "Warning: Conflicting duplicate alias 'pox' changes" ++ . " definition from '1' to '2' in XSAlias.xs, line 10\n" ++ . "Warning: Aliases 'docks' and 'dox', 'lox' have" ++ . " 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'); ++ 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; ++} ++{ ++ my $file = $INC{"ExtUtils/ParseXS.pm"}; ++ $file=~s!ExtUtils/ParseXS\.pm\z!perlxs.pod!; ++ open my $fh, "<", $file ++ or die "Failed to open '$file' for read:$!"; ++ my $pod_version = ""; ++ while (defined(my $line= readline($fh))) { ++ if ($line=~/\(also known as C\)\s+(\d+\.\d+)/) { ++ $pod_version = $1; ++ last; ++ } ++ } ++ close $fh; ++ ok($pod_version, "Found the version from perlxs.pod"); ++ is($pod_version, $ExtUtils::ParseXS::VERSION, ++ "The version in perlxs.pod should match the version of ExtUtils::ParseXS"); ++} ++ ++##################################################################### ++ + sub Foo::TIEHANDLE { bless {}, 'Foo' } + sub Foo::PRINT { shift->{buf} .= join '', @_ } + sub Foo::content { shift->{buf} } +diff --git a/t/002-more.t b/t/002-more.t +index 1ed93a0..f118f2c 100644 +--- a/t/002-more.t ++++ b/t/002-more.t +@@ -9,7 +9,7 @@ use ExtUtils::CBuilder; + use attributes; + use overload; + +-plan tests => 32; ++plan tests => 33; + + my ($source_file, $obj_file, $lib_file); + +@@ -19,7 +19,7 @@ ExtUtils::ParseXS->import('process_file'); + chdir 't' if -d 't'; + push @INC, '.'; + +-use Carp; $SIG{__WARN__} = \&Carp::cluck; ++use Carp; #$SIG{__WARN__} = \&Carp::cluck; + + # See the comments about this in 001-basics.t + @INC = map { File::Spec->rel2abs($_) } @INC; +@@ -47,7 +47,7 @@ SKIP: { + } + + SKIP: { +- skip "no dynamic loading", 28 ++ skip "no dynamic loading", 29 + if !$b->have_compiler || !$Config{usedl}; + my $module = 'XSMore'; + $lib_file = $b->link( objects => $obj_file, module_name => $module ); +@@ -85,6 +85,9 @@ SKIP: { + ok overload::Overloaded(XSMore->new), 'the FALLBACK keyword'; + is abs(XSMore->new), 42, 'the OVERLOAD keyword'; + ++ my $overload_sub_name = "XSMore::More::(+"; ++ is prototype(\&$overload_sub_name), "", 'OVERLOAD following prototyped xsub'; ++ + my @a; + XSMore::hook(\@a); + is_deeply \@a, [qw(INIT CODE POSTCALL CLEANUP)], 'the INIT & POSTCALL & CLEANUP keywords'; +diff --git a/t/003-usage.t b/t/003-usage.t +index 52b9903..f33e3e0 100644 +--- a/t/003-usage.t ++++ b/t/003-usage.t +@@ -20,7 +20,7 @@ require_ok( 'ExtUtils::ParseXS' ); + chdir('t') if -d 't'; + push @INC, '.'; + +-use Carp; $SIG{__WARN__} = \&Carp::cluck; ++use Carp; #$SIG{__WARN__} = \&Carp::cluck; + + # See the comments about this in 001-basics.t + @INC = map { File::Spec->rel2abs($_) } @INC; +diff --git a/t/XSAlias.xs b/t/XSAlias.xs +new file mode 100644 +index 0000000..fcd98e2 +--- /dev/null ++++ b/t/XSAlias.xs +@@ -0,0 +1,19 @@ ++MODULE = My PACKAGE = My ++ ++void ++do(dbh) ++ SV *dbh ++ALIAS: ++ dox = 1 ++ lox => dox ++ pox = 1 ++ pox = 2 ++ docks = 1 ++ dachs => lox ++ xunx = 0 ++ xukes => do ++CODE: ++{ ++ int x; ++ ++x; ++} +diff --git a/t/XSFalsePositive.xs b/t/XSFalsePositive.xs +new file mode 100644 +index 0000000..87a9330 +--- /dev/null ++++ b/t/XSFalsePositive.xs +@@ -0,0 +1,23 @@ ++MODULE = My PACKAGE = My ++ ++#ifdef MYDEF123 ++ ++void ++do(dbh) ++ SV *dbh ++CODE: ++{ ++ int x; ++ ++x; ++} ++ ++#endif ++ ++void ++do(dbh) ++ SV *dbh ++CODE: ++{ ++ int x; ++ ++x; ++} +diff --git a/t/XSFalsePositive2.xs b/t/XSFalsePositive2.xs +new file mode 100644 +index 0000000..4e0ca7e +--- /dev/null ++++ b/t/XSFalsePositive2.xs +@@ -0,0 +1,23 @@ ++MODULE = My PACKAGE = My ++ ++#ifdef MYDEF123 ++ ++void ++do(xdbh) ++ SV *xdbh ++CODE: ++{ ++ int x; ++ ++x; ++} ++ ++#endif ++ ++void ++do(dbh) ++ SV *dbh ++CODE: ++{ ++ int x; ++ ++x; ++} +diff --git a/t/XSMore.xs b/t/XSMore.xs +index f8413f4..b48cfa2 100644 +--- a/t/XSMore.xs ++++ b/t/XSMore.xs +@@ -30,6 +30,10 @@ This parts are ignored. + # define PERL_UNUSED_VAR(x) ((void)x) + #endif + ++/* Newx was introduced in 5.8.8, would also be in ppport.h */ ++#ifndef Newx ++# define Newx(v,n,t) New(0,v,n,t) ++#endif + + + STATIC void +@@ -251,3 +255,17 @@ INCLUDE: XSInclude.xsh + # for testing #else directive + + #endif ++ ++MODULE=XSMore PACKAGE=XSMore::More ++ ++void ++dummy() ++PROTOTYPE: $$$$$ ++CODE: ++ NOOP; ++ ++void ++should_not_have_prototype() ++OVERLOAD: + ++CODE: ++ NOOP; +diff --git a/t/XSTightDirectives.xs b/t/XSTightDirectives.xs +new file mode 100644 +index 0000000..aa83f12 +--- /dev/null ++++ b/t/XSTightDirectives.xs +@@ -0,0 +1,21 @@ ++MODULE = My PACKAGE = My ++ ++#ifdef MYDEF123 ++void ++do(dbh) ++ SV *dbh ++CODE: ++{ ++ int x; ++ ++x; ++} ++#else ++void ++do(dbh) ++ SV *dbh ++CODE: ++{ ++ int x; ++ ++x; ++} ++#endif +-- +2.40.1 + diff --git a/perl-ExtUtils-ParseXS.spec b/perl-ExtUtils-ParseXS.spec index 87841f3..e69b2d6 100644 --- a/perl-ExtUtils-ParseXS.spec +++ b/perl-ExtUtils-ParseXS.spec @@ -2,16 +2,16 @@ Name: perl-ExtUtils-ParseXS # Epoch to compete with perl.spec Epoch: 1 -Version: 3.45 -Release: 490%{?dist} +Version: 3.50 +Release: 1%{?dist} Summary: Module and a script for converting Perl XS code into C code License: GPL-1.0-or-later OR Artistic-1.0-Perl URL: https://metacpan.org/release/ExtUtils-ParseXS Source0: https://cpan.metacpan.org/authors/id/X/XS/XSAWYERX/ExtUtils-ParseXS-%{base_version}.tar.gz # Added man page perlxs* which are missing in tarball Patch0: ExtUtils-ParseXS-3.44-Add-perlxs-man-pages.patch -# Unbundled from perl 5.35.11 -Patch1: ExtUtils-ParseXS-3.44-Upgrade-to-3.45.patch +# Unbundled from perl 5.37.11 +Patch1: ExtUtils-ParseXS-3.44-Upgrade-to-3.50.patch BuildArch: noarch BuildRequires: coreutils BuildRequires: make @@ -52,7 +52,8 @@ the glue necessary to let Perl access those functions. %prep %setup -q -n ExtUtils-ParseXS-%{base_version} -%patch0 -p1 +%patch -P0 -p1 +%patch -P1 -p1 %build perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 @@ -70,12 +71,17 @@ make test %files %doc Changes -%{_bindir}/* -%{perl_vendorlib}/* -%{_mandir}/man1/* -%{_mandir}/man3/* +%{_bindir}/xsubpp +%{perl_vendorlib}/ExtUtils* +%{perl_vendorlib}/perlxs* +%{_mandir}/man1/xsubpp* +%{_mandir}/man3/ExtUtils* +%{_mandir}/man3/perlxs* %changelog +* Wed May 17 2023 Jitka Plesnikova - 1:3.50-1 +- Upgrade to 3.50 as provided in perl-5.37.11 + * Fri Jan 20 2023 Fedora Release Engineering - 1:3.45-490 - Rebuilt for https://fedoraproject.org/wiki/Fedora_38_Mass_Rebuild