Refactor XS code ready for XS C++/Obj-C

Author: mohawk2

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

@@ -10,6 +10,24 @@ use File::Basename qw(basename dirname);
 use DirHandle;
 
 our %Config_Override;
+our %XS_ext2src = qw(
+    xs c
+);
+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_basename2xs {
+    my ($self, $ext) = @_;
+    for my $xs_ext (keys %XS_ext2src) {
+        return "$ext.$xs_ext" if exists $self->{XS}{"$ext.$xs_ext"};
+    }
+    Carp::confess "PANIC: shouldn't get here";
+}
 
 use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562);
 
@@ -1369,10 +1387,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 File::Spec->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); ($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
@@ -1617,11 +1636,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); ($src = $path) =~ s/\.$xs_ext\z/.$XS_ext2src{$xs_ext}/;
+                my($obj); ($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;
 	    }
@@ -3873,28 +3894,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, sprintf <<'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)
@@ -3908,16 +3919,21 @@ have an individual C<$(VERSION)>.
 
 sub xs_o {
     my ($self) = @_;
-    return '' unless $self->needs_linking();
+    return '' unless $self->needs_linking;
     my $minus_o = $self->xs_obj_opt('$*$(OBJ_EXT)');
-    my $frag = '';
+    my @m;
     # dmake makes noise about ambiguous rule
-    $frag .= sprintf <<'EOF', $minus_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, sprintf <<'EOF', $xs_ext, $XS_ext2src{$xs_ext}, $minus_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";
@@ -3927,17 +3943,19 @@ EOF
 	    $cccmd =~ s/^\s*CCCMD\s*=\s*//;
 	    $cccmd =~ s/\$\(DEFINE_VERSION\)/-DVERSION=\\"$version\\"/;
 	    $cccmd =~ s/\$\(XS_DEFINE_VERSION\)/-DXS_VERSION=\\"$version\\"/;
-	    #                             1     2       3
-	    $frag .= _sprintf562 <<'EOF', $ext, $cccmd, $minus_o;
-
-%1$s$(OBJ_EXT): %1$s.xs
-	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc
-	$(MV) $*.xsc $*.c
-	%2$s $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c %3$s
+            my $xs = $self->_xs_basename2xs($ext);
+            my $src = $self->{XS}{$xs};
+	    #                             1     2       3    4     5
+	    push @m, _sprintf562 <<'EOF', $ext, $cccmd, $xs, $src, $minus_o;
+
+%1$s$(OBJ_EXT) : %3$s
+	$(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) %3$s > $*.xsc
+	$(MV) $*.xsc %4$s
+	%2$s $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) %4$s %5$s
 EOF
 	}
     }
-    $frag;
+    join '', @m;
 }
 
 

t/MM_Unix.t

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