Support XS written in C++

lib/ExtUtils/MM_Any.pm

@@ -651,11 +651,6 @@ The blibdirs.ts target is deprecated.  Depend on blibdirs instead.
 
 =cut
 
-sub _xs_list_basenames {
-    my ($self) = @_;
-    map { (my $b = $_) =~ s/\.xs$//; $b } sort keys %{ $self->{XS} };
-}
-
 sub blibdirs_target {
     my $self = shift;
 

lib/ExtUtils/MM_Unix.pm

@@ -9,6 +9,26 @@ use ExtUtils::MakeMaker::Config;
 use File::Basename qw(basename dirname);
 
 our %Config_Override;
+our %XS_ext2src = qw(
+    xs c
+    xscc cpp
+    xsm m
+);
+my $xspat = join '|', keys %XS_ext2src;
+our $XS_extRE = qr/\.($xspat)\z/;
+
+sub _xs_list_basenames {
+    my ($self) = @_;
+    map { (my $b = $_) =~ s/$XS_extRE//; $b } sort keys %{ $self->{XS} };
+}
+
+sub _xs_basename2xstype {
+    my ($self, $ext) = @_;
+    for my $xs_ext (keys %XS_ext2src) {
+        return $xs_ext if exists $self->{XS}{"$ext.$xs_ext"};
+    }
+    Carp::confess "PANIC: shouldn't get here";
+}
 
 use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562);
 
@@ -1383,10 +1403,11 @@ sub init_dirscan {	# --- File and Directory Lists (.xs .pm .pod etc)
 	    next if -l $name; # We do not support symlinks at all
             next if $self->{NORECURS};
 	    $dir{$name} = $name if (-f $self->catfile($name,"Makefile.PL"));
-	} elsif ($name =~ /\.xs\z/){
-	    my($c); ($c = $name) =~ s/\.xs\z/.c/;
-	    $xs{$name} = $c;
-	    $c{$c} = 1;
+        } elsif ($name =~ $XS_extRE){
+            my $xs_ext = $1;
+            (my $src = $name) =~ s/\.$xs_ext\z/.$XS_ext2src{$xs_ext}/;
+            $xs{$name} = $src;
+            $c{$src} = 1;
 	} elsif ($name =~ /\.c(pp|xx|c)?\z/i){  # .c .C .cpp .cxx .cc
 	    $c{$name} = 1
 		unless $name =~ m/perlmain\.c/; # See MAP_TARGET
@@ -1631,11 +1652,13 @@ sub init_PM {
 	    $inst = $self->libscan($inst);
 	    print "libscan($path) => '$inst'\n" if ($Verbose >= 2);
 	    return unless $inst;
-	    if ($self->{XSMULTI} and $inst =~ /\.xs\z/) {
-		my($base); ($base = $path) =~ s/\.xs\z//;
-		$self->{XS}{$path} = "$base.c";
-		push @{$self->{C}}, "$base.c";
-		push @{$self->{O_FILES}}, "$base$self->{OBJ_EXT}";
+            if ($self->{XSMULTI} and $inst =~ $XS_extRE) {
+                my $xs_ext = $1;
+                (my $src = $path) =~ s/\.$xs_ext\z/.$XS_ext2src{$xs_ext}/;
+                (my $obj = $path) =~ s/\.$xs_ext\z/$self->{OBJ_EXT}/;
+                $self->{XS}{$path} = $src;
+                push @{$self->{C}}, $src;
+                push @{$self->{O_FILES}}, $obj;
 	    } else {
 		$self->{PM}{$path} = $inst;
 	    }
@@ -3883,28 +3906,18 @@ Defines the suffix rules to compile XS files to C.
 
 sub xs_c {
     my($self) = shift;
-    return '' unless $self->needs_linking();
-    '
-.xs.c:
-	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc
-	$(MV) $*.xsc $*.c
-';
-}
-
-=item xs_cpp (o)
-
-Defines the suffix rules to compile XS files to C++.
-
-=cut
+    return '' unless $self->needs_linking;
+    my @m;
+    for my $xs_ext (keys %XS_ext2src) {
+        #                             1        2
+        push @m, _sprintf562 <<'EOF', $xs_ext, $XS_ext2src{$xs_ext};
 
-sub xs_cpp {
-    my($self) = shift;
-    return '' unless $self->needs_linking();
-    '
-.xs.cpp:
-	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc
-	$(MV) $*.xsc $*.cpp
-';
+.%1$s.%2$s:
+	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.%1$s > $*.xsc
+	$(MV) $*.xsc $*.%2$s
+EOF
+    }
+    join '', @m;
 }
 
 =item xs_o (o)
@@ -3918,39 +3931,47 @@ have an individual C<$(VERSION)>.
 
 sub xs_o {
     my ($self) = @_;
-    return '' unless $self->needs_linking();
+    return '' unless $self->needs_linking;
     my $m_o = $self->{XSMULTI} ? $self->xs_obj_opt('$*$(OBJ_EXT)') : '';
-    my $frag = '';
+    my @m;
     # dmake makes noise about ambiguous rule
-    $frag .= sprintf <<'EOF', $m_o unless $self->is_make_type('dmake');
-.xs$(OBJ_EXT) :
-	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc
-	$(MV) $*.xsc $*.c
-	$(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c %s
+    my @xs_keys = $self->is_make_type('dmake') ? () : keys %XS_ext2src;
+    for my $xs_ext (@xs_keys) {
+        #                             1        2                     3
+        push @m, _sprintf562 <<'EOF', $xs_ext, $XS_ext2src{$xs_ext}, $m_o;
+
+.%1$s$(OBJ_EXT) :
+	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.%1$s > $*.xsc
+	$(MV) $*.xsc $*.%2$s
+	$(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.%2$s %3$s
 EOF
+    }
     if ($self->{XSMULTI}) {
-	for my $ext ($self->_xs_list_basenames) {
-	    my $pmfile = "$ext.pm";
-	    croak "$ext.xs has no matching $pmfile: $!" unless -f $pmfile;
-	    my $version = $self->parse_version($pmfile);
-	    my $cccmd = $self->{CONST_CCCMD};
-	    $cccmd =~ s/^\s*CCCMD\s*=\s*//;
-	    $cccmd =~ s/\$\(DEFINE_VERSION\)/-DVERSION=\\"$version\\"/;
-	    $cccmd =~ s/\$\(XS_DEFINE_VERSION\)/-DXS_VERSION=\\"$version\\"/;
-            $self->_xsbuild_replace_macro($cccmd, 'xs', $ext, 'INC');
+        for my $ext ($self->_xs_list_basenames) {
+            my $pmfile = "$ext.pm";
+            my $xstype = $self->_xs_basename2xstype($ext);
+            my $xs = "$ext.$xstype";
+            croak "$xs has no matching $pmfile: $!" unless -f $pmfile;
+            my $version = $self->parse_version($pmfile);
+            my $cccmd = $self->{CONST_CCCMD};
+            $cccmd =~ s/^\s*CCCMD\s*=\s*//;
+            $cccmd =~ s/\$\(DEFINE_VERSION\)/-DVERSION=\\"$version\\"/;
+            $cccmd =~ s/\$\(XS_DEFINE_VERSION\)/-DXS_VERSION=\\"$version\\"/;
+            my $src = $self->{XS}{$xs};
+            $self->_xsbuild_replace_macro($cccmd, $xstype, $ext, 'INC');
             my $define = '$(DEFINE)';
-            $self->_xsbuild_replace_macro($define, 'xs', $ext, 'DEFINE');
-            #                             1     2       3     4
-            $frag .= _sprintf562 <<'EOF', $ext, $cccmd, $m_o, $define;
-
-%1$s$(OBJ_EXT): %1$s.xs
-	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc
-	$(MV) $*.xsc $*.c
-	%2$s $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) %4$s $*.c %3$s
+            $self->_xsbuild_replace_macro($define, $xstype, $ext, 'DEFINE');
+            #                             1     2       3    4     5     6
+            push @m, _sprintf562 <<'EOF', $ext, $cccmd, $xs, $src, $m_o, $define;
+
+%1$s$(OBJ_EXT) : %3$s
+	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) %3$s > $*.xsc
+	$(MV) $*.xsc %4$s
+	%2$s $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) %6$s %4$s %5$s
 EOF
-	}
+        }
     }
-    $frag;
+    join '', @m;
 }
 
 # param gets modified

lib/ExtUtils/MakeMaker/FAQ.pod

@@ -544,7 +544,17 @@ This tip has been brought to you by Nick Ing-Simmons and Stas Bekman.
 An alternative way to achieve this can be seen in L<Gtk2::CodeGen>
 and L<Glib::CodeGen>.
 
-=back
+=head3 How can I build my XS files as C++
+
+If you want to write XSUBs in C++, put them in a file called (for class
+Foo::Bar) F<lib/Foo/Bar.xscc>, next to F<lib/Foo/Bar.pm>. In your
+F<Makefile.PL>, give C<XSMULTI> as 1. You will make your distribution
+much more portable, with much less effort for yourself, if you use
+L<ExtUtils::CppGuess> for C++ compiler configuration information.
+
+Likewise, if you want XSUBS in Objective C, use the file extension
+F<.xsm>, and they will automatically be converted using C<xsubpp> to a
+F<.m> file. You will have to supply appropriate values for C<CC> etc.
 
 =head1 DESIGN
 

t/04-xscpp.t

@@ -0,0 +1,25 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use Config;
+BEGIN {
+    chdir 't' or die "chdir(t): $!\n";
+    unshift @INC, 'lib/';
+}
+use MakeMaker::Test::Utils;
+use MakeMaker::Test::Setup::XS;
+use Test::More;
+
+plan skip_all => "ExtUtils::CBuilder not installed or no C++ compiler"
+  unless have_cplusplus();
+plan skip_all => 'Dynaloading not enabled' if $Config{usedl} ne 'define';
+plan skip_all => 'No ExtUtils::CppGuess'
+  unless eval { require ExtUtils::CppGuess };
+my @tests = list_cpp();
+plan skip_all => "No tests" unless @tests;
+plan tests => 6 * @tests;
+my $perl = which_perl();
+perl_lib;
+$| = 1;
+run_tests($perl, @$_) for @tests;

t/MM_Unix.t

@@ -12,7 +12,7 @@ BEGIN {
         plan skip_all => 'Non-Unix platform';
     }
     else {
-        plan tests => 110;
+        plan tests => 109;
     }
 }
 
@@ -113,7 +113,6 @@ foreach ( qw /
   top_targets
   writedoc
   xs_c
-  xs_cpp
   xs_o
   / )
   {

t/lib/MakeMaker/Test/Setup/XS.pm

@@ -2,7 +2,7 @@ package MakeMaker::Test::Setup::XS;
 
 @ISA = qw(Exporter);
 require Exporter;
-@EXPORT = qw(run_tests list_dynamic list_static);
+@EXPORT = qw(run_tests list_dynamic list_static list_cpp);
 
 use strict;
 use File::Path;
@@ -292,6 +292,80 @@ END
 
 };
 
+$label2files{cppbasic} = +{
+
+  'lib/XSCPP/Test.pm'     => <<'END',
+package XSCPP::Test;
+require Exporter;
+require DynaLoader;
+$VERSION = 1.02;
+@ISA    = qw(Exporter DynaLoader);
+@EXPORT = qw(is_even);
+bootstrap XSCPP::Test $VERSION;
+1;
+END
+
+  'Makefile.PL'          => <<'END',
+use ExtUtils::MakeMaker;
+use ExtUtils::CppGuess;
+my $guess = ExtUtils::CppGuess->new;
+WriteMakefile(
+    NAME          => 'XSCPP::Test',
+    VERSION_FROM  => 'lib/XSCPP/Test.pm',
+    XSMULTI => 1,
+    $guess->makemaker_options,
+);
+END
+
+  'lib/XSCPP/Test.xscc'              => <<END,
+extern "C" {
+#include "EXTERN.h"
+#include "perl.h"
+}
+#include "XSUB.h"
+class CPPTest {
+    public:
+        CPPTest() { }
+        ~CPPTest() { }
+        int is_even(int num) { return (num % 2) == 0; }
+};
+\nMODULE = XSCPP::Test       PACKAGE = XSCPP::Test
+\nPROTOTYPES: DISABLE
+CPPTest*
+CPPTest::new();
+\nint
+CPPTest::is_even(int input);
+\nvoid
+CPPTest::DESTROY();
+END
+
+  'typemap'              => <<'END',
+TYPEMAP
+CPPTest *   O_OBJECT
+OUTPUT
+O_OBJECT
+    sv_setref_pv( $arg, CLASS, (void*)$var );
+INPUT
+O_OBJECT
+    if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
+        $var = ($type)SvIV((SV*)SvRV( $arg ));
+    else{
+        warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
+        XSRETURN_UNDEF;
+    }
+END
+
+  't/is_even.t'          => <<'END',
+#!/usr/bin/perl -w
+use Test::More tests => 3;
+use_ok "XSCPP::Test";
+my $o = XSCPP::Test->new;
+ok !$o->is_even(1);
+ok $o->is_even(2);
+END
+
+};
+
 sub virtual_rename {
   my ($label, $oldfile, $newfile) = @_;
   $label2files{$label}->{$newfile} = delete $label2files{$label}->{$oldfile};
@@ -338,6 +412,12 @@ sub list_dynamic {
   );
 }
 
+sub list_cpp {
+  (
+    [ 'cppbasic', '', '' ],
+  );
+}
+
 sub run_tests {
   my ($perl, $label, $add_target, $add_testtarget) = @_;
   my $sublabel = $add_target;

t/lib/MakeMaker/Test/Utils.pm

@@ -17,7 +17,7 @@ our $Is_FreeBSD = $^O eq 'freebsd';
 
 our @EXPORT = qw(which_perl perl_lib makefile_name makefile_backup
                  make make_run run make_macro calibrate_mtime
-                 have_compiler slurp
+                 have_compiler have_cplusplus slurp
                  $Is_VMS $Is_MacOS
                  run_ok
                  hash2files
@@ -357,14 +357,27 @@ Returns true if there is a compiler available for XS builds.
 
 =cut
 
-sub have_compiler {
-    my $have_compiler = 0;
+sub have_compiler { run_cbuilder('have_compiler'); }
+
+=item have_cplusplus
+
+  $have_cplusplus = have_cplusplus;
+
+Returns true if there is a C++ compiler available for XS builds.
+
+=cut
+
+sub have_cplusplus { run_cbuilder('have_cplusplus'); }
+
+sub run_cbuilder {
+    my $method = shift;
+    my $retval = 0;
     eval {
         require ExtUtils::CBuilder;
         my $cb = ExtUtils::CBuilder->new(quiet=>1);
-        $have_compiler = $cb->have_compiler;
+        $retval = $cb->$method;
     };
-    return $have_compiler;
+    return $retval;
 }
 
 =item slurp