In perl.git, the branch smueller/typemapdocs4 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/63436310cb6c5b9f76a94f3c4d3a139ffd30b3bc?hp=39f4ee03071aeb70244888a22b7d0f48e8a21054>
- Log ----------------------------------------------------------------- commit 63436310cb6c5b9f76a94f3c4d3a139ffd30b3bc Author: Steffen Mueller <[email protected]> Date: Thu Jan 26 19:04:23 2012 +0100 XS::Typemap: Tests for the T_PACKEDARRAY typemap ----------------------------------------------------------------------- Summary of changes: ext/XS-Typemap/Typemap.pm | 1 + ext/XS-Typemap/Typemap.xs | 181 ++++++++++++++++++++++++++++++++++++++------ ext/XS-Typemap/t/Typemap.t | 22 +++++- 3 files changed, 180 insertions(+), 24 deletions(-) diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm index dee185b..38c53ce 100644 --- a/ext/XS-Typemap/Typemap.pm +++ b/ext/XS-Typemap/Typemap.pm @@ -76,6 +76,7 @@ $VERSION = '0.08'; T_ARRAY T_STDIO_open T_STDIO_close T_STDIO_print T_PACKED_in T_PACKED_out + T_PACKEDARRAY_in T_PACKEDARRAY_out /); XSLoader::load(); diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs index 1b33b5b..906a66c 100644 --- a/ext/XS-Typemap/Typemap.xs +++ b/ext/XS-Typemap/Typemap.xs @@ -74,7 +74,7 @@ intArray * intArrayPtr( int nelem ) { sv_setsv((out), sv_2mortal(newRV_noinc((SV*)hash))); \ } STMT_END -static anotherstruct * +STATIC anotherstruct * XS_unpack_anotherstructPtr(SV *in) { dTHX; /* rats, this is expensive */ @@ -110,6 +110,93 @@ XS_unpack_anotherstructPtr(SV *in) return out; } +/* test T_PACKEDARRAY */ +#define XS_pack_anotherstructPtrPtr(out, in, cnt) \ + STMT_START { \ + UV i; \ + AV *ary = newAV(); \ + for (i = 0; i < cnt; ++i) { \ + HV *hash = newHV(); \ + hv_stores(hash, "a", newSViv((in)[i]->a)); \ + hv_stores(hash, "b", newSViv((in)[i]->b)); \ + hv_stores(hash, "c", newSVnv((in)[i]->c)); \ + av_push(ary, newRV_noinc((SV*)hash)); \ + } \ + sv_setsv((out), sv_2mortal(newRV_noinc((SV*)ary))); \ + } STMT_END + +STATIC anotherstruct ** +XS_unpack_anotherstructPtrPtr(SV *in) +{ + dTHX; /* rats, this is expensive */ + /* this is similar to T_HVREF since we chose to use a hash */ + HV *inhash; + AV *inary; + SV **elem; + anotherstruct **out; + UV nitems, i; + SV *tmp; + + /* safely deref the input array ref */ + tmp = in; + SvGETMAGIC(tmp); + if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVAV) + inary = (AV*)SvRV(tmp); + else + Perl_croak(aTHX_ "Argument is not an ARRAY reference"); + + nitems = av_len(inary) + 1; + + /* FIXME dunno if supposed to use perl mallocs here */ + /* N+1 elements so we know the last one is NULL */ + Newxz(out, nitems+1, anotherstruct*); + + /* WARNING: in real code, we'd have to Safefree() on exception, but + * since we're testing perl, if we croak() here, stuff is + * rotten anyway! */ + for (i = 0; i < nitems; ++i) { + Newxz(out[i], 1, anotherstruct); + elem = av_fetch(inary, i, 0); + if (elem == NULL) + Perl_croak(aTHX_ "Shouldn't happen: av_fetch returns NULL"); + tmp = *elem; + SvGETMAGIC(tmp); + if (SvROK(tmp) && SvTYPE(SvRV(tmp)) == SVt_PVHV) + inhash = (HV*)SvRV(tmp); + else + Perl_croak(aTHX_ "Array element %u is not a HASH reference", i); + + elem = hv_fetchs(inhash, "a", 0); + if (elem == NULL) + Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); + out[i]->a = SvIV(*elem); + + elem = hv_fetchs(inhash, "b", 0); + if (elem == NULL) + Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); + out[i]->b = SvIV(*elem); + + elem = hv_fetchs(inhash, "c", 0); + if (elem == NULL) + Perl_croak(aTHX_ "Shouldn't happen: hv_fetchs returns NULL"); + out[i]->c = SvNV(*elem); + + } + + return out; +} + +/* no special meaning as far as typemaps are concerned, + * just for convenience */ +void +XS_release_anotherstructPtrPtr(anotherstruct **in) +{ + unsigned int i = 0; + while (in[i] != NULL) + Safefree(in[i++]); + Safefree(in); +} + MODULE = XS::Typemap PACKAGE = XS::Typemap @@ -123,27 +210,28 @@ TYPEMAP: <<END_OF_TYPEMAP # there is not a corresponding type explicitly identified in the standard # typemap -svtype T_ENUM -intRef * T_PTRREF -intRef T_IV -intObj * T_PTROBJ -intObj T_IV -intRefIv * T_REF_IV_PTR -intRefIv T_IV -intArray * T_ARRAY -intOpq T_IV -intOpq * T_OPAQUEPTR -intUnsigned T_U_INT -intTINT T_INT -intTLONG T_LONG -shortOPQ T_OPAQUE -shortOPQ * T_OPAQUEPTR -astruct * T_OPAQUEPTR -anotherstruct * T_PACKED -AV_FIXED * T_AVREF_REFCOUNT_FIXED -HV_FIXED * T_HVREF_REFCOUNT_FIXED -CV_FIXED * T_CVREF_REFCOUNT_FIXED -SVREF_FIXED T_SVREF_REFCOUNT_FIXED +svtype T_ENUM +intRef * T_PTRREF +intRef T_IV +intObj * T_PTROBJ +intObj T_IV +intRefIv * T_REF_IV_PTR +intRefIv T_IV +intArray * T_ARRAY +intOpq T_IV +intOpq * T_OPAQUEPTR +intUnsigned T_U_INT +intTINT T_INT +intTLONG T_LONG +shortOPQ T_OPAQUE +shortOPQ * T_OPAQUEPTR +astruct * T_OPAQUEPTR +anotherstruct * T_PACKED +anotherstruct ** T_PACKEDARRAY +AV_FIXED * T_AVREF_REFCOUNT_FIXED +HV_FIXED * T_HVREF_REFCOUNT_FIXED +CV_FIXED * T_CVREF_REFCOUNT_FIXED +SVREF_FIXED T_SVREF_REFCOUNT_FIXED END_OF_TYPEMAP @@ -1151,6 +1239,55 @@ the example above and C<foo_t **>: The type of the third parameter is arbitrary as far as the typemap is concerned. It just has to be in line with the declared variable. +Of course, unless you know the number of elements in the +C<sometype **> C array, within your XSUB, the return value from +C<foo_t ** XS_unpack_foo_tPtrPtr(...)> will be hard to decypher. +Since the details are all up to the XS author (the typemap user), +there are several solutions, none of which particularly elegant. +The most commonly seen solution has been to allocate memory for +N+1 pointers and assign C<NULL> to the (N+1)th to facilitate +iteration. + +Alternatively, using a customized typemap for your purposes in +the first place is probably preferrable. + +=cut + +void +T_PACKEDARRAY_in(in) + anotherstruct **in; + PREINIT: + unsigned int i = 0; + PPCODE: + while (in[i] != NULL) { + mXPUSHi(in[i]->a); + mXPUSHi(in[i]->b); + mXPUSHn(in[i]->c); + ++i; + } + XS_release_anotherstructPtrPtr(in); + XSRETURN(3*i); + +anotherstruct ** +T_PACKEDARRAY_out(...) + PREINIT: + unsigned int i, nstructs, count_anotherstructPtrPtr; + CODE: + if ((items % 3) != 0) + croak("Need nitems divisible by 3"); + nstructs = (unsigned int)(items / 3); + count_anotherstructPtrPtr = nstructs; + Newxz(RETVAL, nstructs+1, anotherstruct *); + for (i = 0; i < nstructs; ++i) { + Newxz(RETVAL[i], 1, anotherstruct); + RETVAL[i]->a = SvIV(ST(3*i)); + RETVAL[i]->b = SvIV(ST(3*i+1)); + RETVAL[i]->c = SvNV(ST(3*i+2)); + } + OUTPUT: RETVAL + CLEANUP: + XS_release_anotherstructPtrPtr(RETVAL); + =item T_DATAUNIT NOT YET diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t index d2a0d3e..40946f5 100644 --- a/ext/XS-Typemap/t/Typemap.t +++ b/ext/XS-Typemap/t/Typemap.t @@ -6,7 +6,7 @@ BEGIN { } } -use Test::More tests => 105; +use Test::More tests => 108; use strict; use warnings; @@ -287,7 +287,25 @@ is_deeply($struct, {a => -4, b => 3, c => 2.1}); my @rv = T_PACKED_in($struct); is_deeply(\@rv, [-4, 3, 2.1]); -# Skip T_PACKEDARRAY +# T_PACKEDARRAY +SCOPE: { + note("T_PACKED_ARRAY"); + my @d = ( + -4, 3, 2.1, + 2, 1, -15.3, + 1,1,1 + ); + my @out; + push @out, {a => $d[$_*3], b => $d[$_*3+1], c => $d[$_*3+2]} for (0..2); + my $structs = T_PACKEDARRAY_out(@d); + ok(ref($structs) eq 'ARRAY'); + is_deeply( + $structs, + \@out + ); + my @rv = T_PACKEDARRAY_in($structs); + is_deeply(\@rv, \@d); +} # Skip T_DATAUNIT -- Perl5 Master Repository
