summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteffen Mueller <smueller@cpan.org>2011-04-16 15:39:18 +0200
committerSteffen Mueller <smueller@cpan.org>2011-07-12 20:54:50 +0200
commit16c87200414bef0a11c26022e1e4bc345bba7501 (patch)
treed2652a22fc8be061601706929fc3346a84d73b25
parent147664cedc925c4096ea2de971418e7ce6374bd0 (diff)
downloadperl-16c87200414bef0a11c26022e1e4bc345bba7501.tar.gz
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
-rw-r--r--dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm23
-rw-r--r--dist/ExtUtils-ParseXS/t/002-more.t9
-rw-r--r--dist/ExtUtils-ParseXS/t/XSMore.xs53
3 files changed, 83 insertions, 2 deletions
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index 456fb0763a..9199881d4b 100644
--- 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 e3a6d1288e..04bd296fc9 100644
--- 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 0777f89eac..d0a1f3cabe 100644
--- 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: $$@