[MERGE] fix two XS INTERFACE keyword issues

iabyn · iabyn · commit ba3d80bcbc58 · 2025-08-30T14:55:51.000+01:00
First, INTERFACE didn't support Perl package names as C types (i.e. Foo::Bar not getting auto-converted to Foo__Bar). Secondly, XS code using INTERFACE was starting to fail on picky C compilers due to type-casting issues (GH #23192).
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
 
diff --git a/dist/ExtUtils-ParseXS/t/001-basic.t b/dist/ExtUtils-ParseXS/t/001-basic.t
@@ -4811,6 +4811,10 @@ EOF
         |
         |PROTOTYPES:  DISABLE
         |
+        |TYPEMAP: <<EOTM
+        |X::Y T_IV
+        |EOTM
+        |
 EOF
 
     my @test_fns = (
@@ -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" ],
         ],
     );
diff --git a/dist/ExtUtils-ParseXS/t/002-more.t b/dist/ExtUtils-ParseXS/t/002-more.t
@@ -9,7 +9,7 @@ use ExtUtils::CBuilder;
 use attributes;
 use overload;
 
-plan tests => 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, '<<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) {
diff --git a/dist/ExtUtils-ParseXS/t/XSMore.xs b/dist/ExtUtils-ParseXS/t/XSMore.xs
@@ -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
@@ -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
