diff options
author | Steffen Mueller <smueller@cpan.org> | 2011-04-16 15:39:18 +0200 |
---|---|---|
committer | Steffen Mueller <smueller@cpan.org> | 2011-07-12 20:54:50 +0200 |
commit | 16c87200414bef0a11c26022e1e4bc345bba7501 (patch) | |
tree | d2652a22fc8be061601706929fc3346a84d73b25 /dist | |
parent | 147664cedc925c4096ea2de971418e7ce6374bd0 (diff) | |
download | perl-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
Diffstat (limited to 'dist')
-rw-r--r-- | dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 23 | ||||
-rw-r--r-- | dist/ExtUtils-ParseXS/t/002-more.t | 9 | ||||
-rw-r--r-- | dist/ExtUtils-ParseXS/t/XSMore.xs | 53 |
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: $$@ |