Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ use strict;
use warnings;
use Symbol;

our $VERSION = '3.59';
our $VERSION = '3.60';

=head1 NAME

Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
package ExtUtils::ParseXS::CountLines;
use strict;

our $VERSION = '3.59';
our $VERSION = '3.60';

our $SECTION_END_MARKER;

Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Eval;
use strict;
use warnings;

our $VERSION = '3.59';
our $VERSION = '3.60';

=head1 NAME

Expand Down
78 changes: 62 additions & 16 deletions dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Node.pm
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Node;
use strict;
use warnings;

our $VERSION = '3.59';
our $VERSION = '3.60';

=head1 NAME

Expand Down Expand Up @@ -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
}


{
Expand Down Expand Up @@ -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
Expand All @@ -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;
}

Expand All @@ -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;
}


Expand Down Expand Up @@ -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
)};


Expand All @@ -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;
}
Expand Down Expand Up @@ -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 = ";
}

Expand Down Expand Up @@ -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";

Expand Down Expand Up @@ -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
}

Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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;

Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ use strict;
use warnings;
require ExtUtils::Typemaps;

our $VERSION = '3.59';
our $VERSION = '3.60';

=head1 NAME

Expand Down
2 changes: 1 addition & 1 deletion dist/ExtUtils-ParseXS/lib/perlxs.pod
Original file line number Diff line number Diff line change
Expand Up @@ -2231,7 +2231,7 @@ this model, the less likely conflicts will occur.
=head1 XS VERSION

This document covers features supported by C<ExtUtils::ParseXS>
(also known as C<xsubpp>) 3.59.
(also known as C<xsubpp>) 3.60.

=head1 AUTHOR DIAGNOSTICS

Expand Down
35 changes: 34 additions & 1 deletion dist/ExtUtils-ParseXS/t/001-basic.t
Original file line number Diff line number Diff line change
Expand Up @@ -4811,6 +4811,10 @@ EOF
|
|PROTOTYPES: DISABLE
|
|TYPEMAP: <<EOTM
|X::Y T_IV
|EOTM
|
EOF

my @test_fns = (
Expand All @@ -4825,7 +4829,36 @@ EOF
"got XSFUNCTION declaration" ],
[ 0, 0, qr{\QXSFUNCTION = XSINTERFACE_FUNC(void,cv,XSANY.any_dptr);},
"got XSFUNCTION assign" ],
[ 0, 0, qr{\bXSFUNCTION\(\)},
[ 0, 0, qr{\Q((void (*)())(XSFUNCTION))();},
"got XSFUNCTION call" ],
],
[
'INTERFACE with perl package name',
[ Q(<<'EOF') ],
|X::Y
|foo(X::Y a, char *b)
| INTERFACE: f1
EOF
[ 0, 0, qr{\b\QdXSFUNCTION(X__Y)},
"got XSFUNCTION declaration" ],
[ 0, 0, qr{\QXSFUNCTION = XSINTERFACE_FUNC(X__Y,cv,XSANY.any_dptr);},
"got XSFUNCTION assign" ],
[ 0, 0, qr{\QRETVAL = ((X__Y (*)(X__Y, char *))(XSFUNCTION))(a, b);},
"got XSFUNCTION call" ],
],
[
'INTERFACE with C_ARGS',
[ Q(<<'EOF') ],
|char *
|foo(X::Y a, int b, char *c)
| INTERFACE: f1
| C_ARGS: a, c
EOF
[ 0, 0, qr{\b\QdXSFUNCTION(char *)},
"got XSFUNCTION declaration" ],
[ 0, 0, qr{\QXSFUNCTION = XSINTERFACE_FUNC(char *,cv,XSANY.any_dptr);},
"got XSFUNCTION assign" ],
[ 0, 0, qr{\QRETVAL = ((char * (*)(X__Y, char *))(XSFUNCTION))(a, c);},
"got XSFUNCTION call" ],
],
);
Expand Down
7 changes: 5 additions & 2 deletions dist/ExtUtils-ParseXS/t/002-more.t
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ use ExtUtils::CBuilder;
use attributes;
use overload;

plan tests => 33;
plan tests => 35;

my ($source_file, $obj_file, $lib_file);

Expand Down Expand Up @@ -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 );
Expand Down Expand Up @@ -113,6 +113,9 @@ SKIP: {
is XSMore::typemaptest3(12, 13, 14), 12, 'Simple embedded typemap works for input, too';
is XSMore::typemaptest6(5), 5, '<<END; (with semicolon) matches delimiter "END"';

is XSMore::myadd1(5,7), 12, 'INTERFACE: myadd1';
is XSMore::myadd2(5,99,13), 18, 'INTERFACE: myadd2, C_ARGS';

# Win32 needs to close the DLL before it can unlink it, but unfortunately
# dl_unload_file was missing on Win32 prior to perl change #24679!
if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) {
Expand Down
18 changes: 18 additions & 0 deletions dist/ExtUtils-ParseXS/t/XSMore.xs
Original file line number Diff line number Diff line change
Expand Up @@ -78,6 +78,15 @@ len(const char* const s, int const l){
return l;
}

STATIC int
myadd1(int a, int b)
{ return a + b; }

STATIC int
myadd2(int a, int b)
{ return a + b; }


MODULE = XSMore PACKAGE = XSMore

=for testing
Expand Down Expand Up @@ -244,6 +253,15 @@ outlist_int(const char *a, const char *b, OUTLIST char *c)
int
len(char* s, int length(s))

int
interface1(int a, int b)
INTERFACE: myadd1

int
interface2(int a, int b, int c)
INTERFACE: myadd2
C_ARGS: a, c

INCLUDE_COMMAND: $^X -Ilib -It/lib -MIncludeTester -e IncludeTester::print_xs

#if 1
Expand Down
Loading