Support for embedded typemaps in XS

This implements embedded typemap documents with a heredoc-like
syntax. In your XS, use a block like the following:

TYPEMAP: <<END
Foo* T_SOMETHING

INPUT
T_SOMETHING
	code
END

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index 456fb07..9199881 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -1648,6 +1648,29 @@ sub fetch_para {
       chomp $self->{lastline};
       $self->{lastline} =~ s/^\s+$//;
     }
+
+    # This chunk of code strips out (and parses) embedded TYPEMAP blocks
+    # which support a HEREdoc-alike block syntax.
+    # This is special cased from the usual paragraph-handler logic
+    # due to the HEREdoc-ish syntax.
+    if ($self->{lastline} =~ /^TYPEMAP\s*:\s*<<\s*(?:(["'])(.+?)\1|([^\s'"]+))\s*;?\s*$/) {
+      my $end_marker = quotemeta(defined($1) ? $2 : $3);
+      my @tmaplines;
+      while (1) {
+        $self->{lastline} = <$FH>;
+        death("Error: Unterminated typemap") if not defined $self->{lastline};
+        last if $self->{lastline} =~ /^$end_marker\s*$/;
+        push @tmaplines, $self->{lastline};
+      }
+
+      my $tmapcode = join "", @tmaplines;
+      my $tmap = ExtUtils::Typemaps->new(string => $tmapcode);
+      $self->{typemap}->merge(typemap => $tmap, replace => 1);
+
+      last unless defined($self->{lastline} = <$FH>);
+      next;
+    }
+
     if ($self->{lastline} !~ /^\s*#/ ||
     # CPP directives:
     #    ANSI:    if ifdef ifndef elif else endif define undef

diff --git a/dist/ExtUtils-ParseXS/t/002-more.t b/dist/ExtUtils-ParseXS/t/002-more.t
index e3a6d12..04bd296 100644 (file)
--- 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 => 25;
+plan tests => 28;
 
 my ($source_file, $obj_file, $lib_file);
 
@@ -43,7 +43,7 @@ SKIP: {
 }
 
 SKIP: {
-  skip "no dynamic loading", 21
+  skip "no dynamic loading", 24
     if !$b->have_compiler || !$Config{usedl};
   my $module = 'XSMore';
   $lib_file = $b->link( objects => $obj_file, module_name => $module );
@@ -91,6 +91,11 @@ SKIP: {
 
   is XSMore::sum(5, 9), 14, 'the INCLUDE_COMMAND directive';
 
+  # Tests for embedded typemaps
+  is XSMore::typemaptest1(), 42, 'Simple embedded typemap works';
+  is XSMore::typemaptest2(), 42, 'Simple embedded typemap works with funny end marker';
+  is XSMore::typemaptest3(12), 12, 'Simple embedded typemap works for input, too';
+
   # 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
index 0777f89..d0a1f3c 100644 (file)
--- a/dist/ExtUtils-ParseXS/t/XSMore.xs
+++ b/dist/ExtUtils-ParseXS/t/XSMore.xs
@@ -2,6 +2,12 @@
 #include "perl.h"
 #include "XSUB.h"
 
+typedef IV MyType;
+typedef IV MyType2;
+typedef IV MyType3;
+typedef IV MyType4;
+
+
 =for testing
 
 This parts are ignored.
@@ -42,6 +48,53 @@ BOOT:
        sv_setiv(get_sv("XSMore::boot_ok", TRUE), 100);
 
 
+TYPEMAP: <<END
+MyType T_IV
+END
+
+TYPEMAP: <<"  FOO BAR BAZ";
+MyType2        T_FOOOO
+
+OUTPUT
+T_FOOOO
+       sv_setiv($arg, (IV)$var);
+  FOO BAR BAZ
+
+TYPEMAP: <<'END'
+MyType3        T_BAAR
+MyType4        T_BAAR
+
+OUTPUT
+T_BAAR
+       sv_setiv($arg, (IV)$var);
+
+INPUT
+T_BAAR
+       $var = ($type)SvIV($arg)
+END
+
+
+MyType
+typemaptest1()
+  CODE:
+    RETVAL = 42;
+  OUTPUT:
+    RETVAL
+
+MyType2
+typemaptest2()
+  CODE:
+    RETVAL = 42;
+  OUTPUT:
+    RETVAL
+
+MyType3
+typemaptest3(MyType4 foo)
+  CODE:
+    RETVAL = foo;
+  OUTPUT:
+    RETVAL
+
 void
 prototype_ssa()
 PROTOTYPE: $$@