jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added Perl support for member pointers. Some reorganization of other runtime code

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@5436 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley 2003-11-28 20:56:17 +00:00
commit 1bb91ece90
7 changed files with 111 additions and 85 deletions
Download patch file Download diff file Expand all files Collapse all files

28
Lib/perl5/perl5.swg
View file

@ -54,6 +54,12 @@
$1 = *argp;
}
/* Pointer to a class member */
%typemap(in) SWIGTYPE (CLASS::*) {
if ((SWIG_ConvertPacked($input, (void *) &$1, sizeof($1_type), $1_descriptor,0)) < 0) {
SWIG_croak("Type error in argument $argnum of $symname. Expected $&1_mangle");
}
}
/* Const primitive references. Passed by value */
@ -160,6 +166,13 @@
SWIG_MakePtr(ST(argvi++), (void *) $1, ty, $shadow|$owner);
}
/* Member pointer */
%typemap(out) SWIGTYPE (CLASS::*) {
ST(argvi) = sv_newmortal();
SWIG_MakePackedObj(ST(argvi), (void *) &$1, sizeof($1_type), $1_descriptor);
argvi++;
}
%typemap(out) void "";
/* Typemap for character array returns */
@ -266,6 +279,15 @@
$1 = *argp;
}
/* Member pointer */
%typemap(varin) SWIGTYPE (CLASS::*) {
char temp[sizeof($1_type)];
if (SWIG_ConvertPacked($input, (void *) temp, sizeof($1_type), $1_descriptor, 0) < 0) {
croak("Type error in argument $argnum of $symname. Expected $&1_mangle");
}
memmove((void *) &$1, temp, sizeof($1_type));
}
/* Const primitive references. Passed by value */
%typemap(varin) const int & (int temp),
@ -390,6 +412,10 @@
%typemap(varout,type="$&1_descriptor") SWIGTYPE
"sv_setiv(SvRV($result), (IV) &$1);";
%typemap(varout,type="$1_descriptor") SWIGTYPE (CLASS::*) {
SWIG_MakePackedObj($result, (void *) &$1, sizeof($1_type), $1_descriptor);
}
/* --- Typemaps for constants --- *
/* --- Constants --- */
@ -585,7 +611,7 @@ XS(SWIG_init) {
SWIG_MakePtr(sv, swig_constants[i].pvalue, *(swig_constants[i].ptype),0);
break;
case SWIG_BINARY:
/* obj = SWIG_NewPackedObj(swig_constants[i].pvalue, swig_constants[i].lvalue, *(swig_constants[i].ptype)); */
SWIG_MakePackedObj(sv, swig_constants[i].pvalue, swig_constants[i].lvalue, *(swig_constants[i].ptype));
break;
default:
break;

41
Lib/perl5/perlrun.swg
View file

@ -126,11 +126,20 @@ extern "C" {
SWIG_Perl_ConvertPtr(pPerl, obj, pp, type, flags)
# define SWIG_NewPointerObj(p, type, flags) \
SWIG_Perl_NewPointerObj(pPerl, p, type, flags)
# define SWIG_MakePackedObj(sv, p, s, type) \
SWIG_Perl_MakePackedObj(pPerl, sv, p, s, type)
# define SWIG_ConvertPacked(obj, p, s, type, flags) \
SWIG_Perl_ConvertPacked(pPerl, obj, p, s, type, flags)
#else
# define SWIG_ConvertPtr(obj, pp, type, flags) \
SWIG_Perl_ConvertPtr(obj, pp, type, flags)
# define SWIG_NewPointerObj(p, type, flags) \
SWIG_Perl_NewPointerObj(p, type, flags)
# define SWIG_MakePackedObj(sv, p, s, type) \
SWIG_Perl_MakePackedObj(sv, p, s, type )
# define SWIG_ConvertPacked(obj, p, s, type, flags) \
SWIG_Perl_ConvertPacked(obj, p, s, type, flags)
#endif
/* Perl-specific API */
@ -166,6 +175,8 @@ extern "C" {
SWIGIMPORT(int) SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *, void **, swig_type_info *, int flags);
SWIGIMPORT(void) SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *, void *, swig_type_info *, int flags);
SWIGIMPORT(SV *) SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *, swig_type_info *, int flags);
SWIGIMPORT(void) SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *, void *, int, swig_type_info *);
SWIGIMPORT(int) SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *, void *, int, swig_type_info *, int flags);
SWIGIMPORT(swig_type_info *) SWIG_Perl_TypeCheckRV(SWIG_MAYBE_PERL_OBJECT SV *rv, swig_type_info *ty);
SWIGIMPORT(SV *) SWIG_Perl_SetError(SWIG_MAYBE_PERL_OBJECT char *);
@ -295,6 +306,36 @@ SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *ptr, swig_type_info *t, int
return result;
}
SWIGRUNTIME(void)
SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, int sz, swig_type_info *type) {
char result[1024];
char *r = result;
if ((2*sz + 1 + strlen(type->name)) > 1000) return;
*(r++) = '_';
r = SWIG_PackData(r,ptr,sz);
strcpy(r,type->name);
sv_setpv(sv, result);
}
/* Convert a packed value value */
SWIGRUNTIME(int)
SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *obj, void *ptr, int sz, swig_type_info *ty, int flags) {
swig_type_info *tc;
char *c = 0;
if ((!obj) || (!SvOK(obj))) return -1;
c = SvPV(obj, PL_na);
/* Pointer values must start with leading underscore */
if (*c != '_') return -1;
c++;
c = SWIG_UnpackData(c,ptr,sz);
if (ty) {
tc = SWIG_TypeCheck(c,ty);
if (!tc) return -1;
}
return 0;
}
SWIGRUNTIME(void)
SWIG_Perl_SetError(SWIG_MAYBE_PERL_OBJECT const char *error) {
if (error) sv_setpv(get_sv("@", TRUE), error);