diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index 026f7248f9f7..6573ed2538c5 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -64,7 +64,7 @@ use Symbol; our $VERSION; BEGIN { - $VERSION = '3.59'; + $VERSION = '3.60'; require ExtUtils::ParseXS::Constants; ExtUtils::ParseXS::Constants->VERSION($VERSION); require ExtUtils::ParseXS::CountLines; ExtUtils::ParseXS::CountLines->VERSION($VERSION); require ExtUtils::ParseXS::Node; ExtUtils::ParseXS::Node->VERSION($VERSION); diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm index 5779fe2639e9..3ead8417bc5e 100644 --- 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.59'; +our $VERSION = '3.60'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm index 17ec1e17378e..6908c6e01306 100644 --- 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.59'; +our $VERSION = '3.60'; our $SECTION_END_MARKER; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm index a4d6eee6cb06..5b91d39f7f44 100644 --- 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.59'; +our $VERSION = '3.60'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Node.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Node.pm index 708d3f92cc36..b1436f2f668b 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Node.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Node.pm @@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Node; use strict; use warnings; -our $VERSION = '3.59'; +our $VERSION = '3.60'; =head1 NAME @@ -593,9 +593,14 @@ EOF | dXSI32; EOF - print ExtUtils::ParseXS::Q(<<"EOF") if $self->{seen_INTERFACE}; - | dXSFUNCTION($self->{decl}{return_type}{type}); + if ($self->{seen_INTERFACE}) { + my $type = $self->{decl}{return_type}{type}; + $type =~ tr/:/_/ + unless $pxs->{config_RetainCplusplusHierarchicalTypes}; + print ExtUtils::ParseXS::Q(<<"EOF") if $self->{seen_INTERFACE}; + | dXSFUNCTION($type); EOF + } { @@ -2564,14 +2569,18 @@ sub usage_string { # $self->C_func_signature(): # -# return a string containing the arguments to pass to an autocall C -# function, e.g. 'a, &b, c'. +# return two arrays +# the first contains the arguments to pass to an autocall C +# function, e.g. ['a', '&b', 'c']; +# the second contains the types of those args, for use in declaring +# a function pointer type, e.g. ['int', 'char*', 'long']. sub C_func_signature { my __PACKAGE__ $self = shift; my ExtUtils::ParseXS $pxs = shift; my @args; + my @types; for my $param (@{$self->{kids}}) { next if $param->{is_synthetic} # THIS/CLASS/RETVAL # if a synthetic RETVAL has acquired an arg_num, then @@ -2581,6 +2590,7 @@ sub C_func_signature { if ($param->{is_length}) { push @args, "XSauto_length_of_$param->{len_name}"; + push @types, $param->{type}; next; } @@ -2601,9 +2611,11 @@ sub C_func_signature { my $a = $param->{var}; $a = "&$a" if $param->{is_addr} or $io =~ /OUT/; push @args, $a; + my $t = $param->{type}; + push @types, defined $t ? $t : 'void*'; } - return join(", ", @args); + return \@args, \@types; } @@ -3320,7 +3332,8 @@ package ExtUtils::ParseXS::Node::autocall; # name BEGIN { $build_subclass->( - 'args', # Str: text to use for auto function call arguments + 'args', # Str: text to use for auto function call arguments + 'types', # Str: text to use for auto function type declaration )}; @@ -3335,10 +3348,35 @@ sub parse { $xbody->{seen_autocall} = 1; my $ioparams = $xbody->{ioparams}; - my $args = $ioparams->{auto_function_sig_override}; # C_ARGS - $args = $ioparams->C_func_signature($pxs) - unless defined $args; - $self->{args} = $args; + my ($args, $types); + $args = $ioparams->{auto_function_sig_override}; # C_ARGS + if (defined $args) { + # Try to determine the C_ARGS types; for example, with + # + # foo(short s, int i, long l) + # C_ARGS: s, l + # + # set $types to ['short', 'long']. May give the wrong results if + # C_ARGS isn't just a simple list of parameter names + for my $var (split /,/, $args) { + $var =~ s/^\s+//; + $var =~ s/\s+$//; + my $param = $ioparams->{names}{$var}; + # 'void*' is a desperate guess if no such parameter + push @$types, ($param && defined $param->{type}) + ? $param->{type} : 'void*'; + } + $self->{args} = $args; + } + else { + ($args, $types) = $ioparams->C_func_signature($pxs); + $self->{args} = join ', ', @$args; + } + + unless ($pxs->{config_RetainCplusplusHierarchicalTypes}) { + s/:/_/g for @$types; + } + $self->{types} = join ', ', @$types; 1; } @@ -3370,7 +3408,8 @@ sub as_code { print "\n\t"; - if ($xsub->{decl}{return_type}{type} ne "void") { + my $ret_type = $xsub->{decl}{return_type}{type}; + if ($ret_type ne "void") { print "RETVAL = "; } @@ -3399,9 +3438,13 @@ sub as_code { $name =~ s/^\Q$strip// if defined $strip; - $name = 'XSFUNCTION' - if $xsub->{seen_INTERFACE} - or $xsub->{seen_INTERFACE_MACRO}; + if ( $xsub->{seen_INTERFACE} + or $xsub->{seen_INTERFACE_MACRO}) + { + $ret_type =~ s/:/_/g + unless $pxs->{config_RetainCplusplusHierarchicalTypes}; + $name = "(($ret_type (*)($self->{types}))(XSFUNCTION))"; + } print "$name($self->{args});\n"; @@ -3724,8 +3767,11 @@ sub as_code { my $macro = $xsub->{interface_macro}; $macro = 'XSINTERFACE_FUNC' unless defined $macro; + my $type = $xsub->{decl}{return_type}{type}; + $type =~ tr/:/_/ + unless $pxs->{config_RetainCplusplusHierarchicalTypes}; print <<"EOF"; - XSFUNCTION = $macro($xsub->{decl}{return_type}{type},cv,XSANY.any_dptr); + XSFUNCTION = $macro($type,cv,XSANY.any_dptr); EOF } diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm index cf92780b6881..2e8efcc92368 100644 --- 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.59'; +our $VERSION = '3.60'; 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 index f26a32979dd7..3d6c4b4f1e39 100644 --- 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.59'; +our $VERSION = '3.60'; 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 index 927b2c6a6aa8..dfe51adab9af 100644 --- 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.59'; +our $VERSION = '3.60'; use ExtUtils::Typemaps; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm index b981ee45067e..20fa69fb3b5c 100644 --- 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.59'; +our $VERSION = '3.60'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm index 6ba1d936918f..40d323eb0076 100644 --- 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.59'; +our $VERSION = '3.60'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm index ed2b52aefcbe..e6e8dbb31e2f 100644 --- 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.59'; +our $VERSION = '3.60'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/perlxs.pod b/dist/ExtUtils-ParseXS/lib/perlxs.pod index 2e87b45346f8..26b8e19a06d3 100644 --- a/dist/ExtUtils-ParseXS/lib/perlxs.pod +++ b/dist/ExtUtils-ParseXS/lib/perlxs.pod @@ -2231,7 +2231,7 @@ this model, the less likely conflicts will occur. =head1 XS VERSION This document covers features supported by C -(also known as C) 3.59. +(also known as C) 3.60. =head1 AUTHOR DIAGNOSTICS diff --git a/dist/ExtUtils-ParseXS/t/001-basic.t b/dist/ExtUtils-ParseXS/t/001-basic.t index 3b84dbc31443..f2455e3c35a1 100644 --- a/dist/ExtUtils-ParseXS/t/001-basic.t +++ b/dist/ExtUtils-ParseXS/t/001-basic.t @@ -4811,6 +4811,10 @@ EOF | |PROTOTYPES: DISABLE | + |TYPEMAP: < 33; +plan tests => 35; my ($source_file, $obj_file, $lib_file); @@ -47,7 +47,7 @@ SKIP: { } SKIP: { - skip "no dynamic loading", 29 + skip "no dynamic loading", 31 if !$b->have_compiler || !$Config{usedl}; my $module = 'XSMore'; $lib_file = $b->link( objects => $obj_file, module_name => $module ); @@ -113,6 +113,9 @@ SKIP: { is XSMore::typemaptest3(12, 13, 14), 12, 'Simple embedded typemap works for input, too'; is XSMore::typemaptest6(5), 5, '<