(this is primarily a bug report. the patches contained here probably
shouldn't be applied as-is)
ExtUtils::XSBuilder currently recognises (parses) these two C
constructs:
void function(arg[MAXSIZE]);
struct mystruct {
type_t foo[SOMESIZE];
};
the code it generates for them is *completely* wrong. take for
example "errdat1[ERRDATLEN]":
struct tReq {
...
char errdat1 [ERRDATLEN] ; /* Additional error information */
...
} ;
ExtUtils::XSBuilder currently generates lovely code like this:
void Embperl__Req_new_init (pTHX_ Embperl__Req obj, SV * item, int overwrite) {
...
obj -> errdat1[ERRDATLEN] = (char)epxs_sv2_CHAR((tmpsv && *tmpsv?*tm
psv:&PL_sv_undef)) ;
...
}
and:
char
errdat1(obj, val=0)
Embperl::Req obj
char val
PREINIT:
/*nada*/
CODE:
RETVAL = (char) obj->errdat1[ERRDATLEN];
if (items > 1) {
obj->errdat1[ERRDATLEN] = (char) val;
}
OUTPUT:
RETVAL
which are both *completely* wrong.
to partially fix this, I've overridden map_structure so that it
converts "foo[BAR]" to type "foo *" and then overrides the malloc
procedure to use the preallocated "BAR * sizeof(type)" space provided.
currently it only works for char types, since they're null terminated
(hopefully). the more general case (which i recommend we do instead)
needs more extensive changes to the code generated by
TypeMap::get_structures and get_function, so that argument size and
pre-allocated array sizes can be dealt with properly.
(the Debian libembperl-perl package currently has the "errdat1",
"errdat2" and "lastwarn" Request fields disabled entirely)
--- libembperl-perl-2.0b9dev6.orig/xsbuilder/TypeMap.pm
+++ libembperl-perl-2.0b9dev6/xsbuilder/TypeMap.pm
@@ -0,1 +1,38 @@
+package Embperl::TypeMap;
+
+use strict;
+use warnings;
+
+use base qw(ExtUtils::XSBuilder::TypeMap);
+
+sub map_structure {
+ my ($self, $struct) = @_;
+
+ my %fixedsize;
+
+ foreach my $e ( @{$struct->{elts}} ) {
+ $e->{name} =~ s/\[(.*)\]// or next;
+ $fixedsize{$e->{name}} = $1;
+ $e->{type} .= ' *';
+ }
+
+ my $mapped = $self->SUPER::map_structure($struct);
+
+ foreach my $e (@{$mapped->{elts}}) {
+ my $nitems = $fixedsize{$e->{name}} or next;
+ if ($e->{type} eq 'char *') {
+ $e->{malloc} = "strncpy(\$dest, \$src, $nitems-1)";
+ undef $e->{free};
+ } else {
+ # FIXME: need to copy MIN($e->{nitems}, num_given_in_the_first_place)
+ $e->{malloc} = "Copy(\$src, \$dest, $nitems, \$type)";
+ undef $e->{free};
+ warn "WARNING: don't know how to copy $e->{name}";
+ }
+ }
+
+ $mapped;
+}
+
+1;
--- libembperl-perl-2.0b9dev6.orig/xsbuilder/WrapXS.pm
+++ libembperl-perl-2.0b9dev6/xsbuilder/WrapXS.pm
@@ -13,7 +13,8 @@
# ============================================================================
sub new_parsesource { [ Embperl::ParseSource->new ] }
+sub new_typemap { Embperl::TypeMap->new(shift) }
# ============================================================================
--- libembperl-perl-2.0b9dev6.orig/xsbuilder/xs_generate.pl
+++ libembperl-perl-2.0b9dev6/xsbuilder/xs_generate.pl
@@ -1,5 +1,6 @@
use FindBin ;
+require "$FindBin::Bin/TypeMap.pm";
require "$FindBin::Bin/ParseSource.pm" ;
require "$FindBin::Bin/WrapXS.pm" ;
--
- Gus
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
