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