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

implement DISOWN, please test it

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@7714 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Marcelo Matus 2005-10-25 10:57:33 +00:00
commit e8535abc5b
1 changed files with 30 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

41
Lib/perl5/perlrun.swg
View file

@ -88,14 +88,14 @@ SWIGRUNTIME int
SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags) { SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags) {
swig_cast_info *tc; swig_cast_info *tc;
void *voidptr = (void *)0; void *voidptr = (void *)0;
SV *tsv = 0;
/* If magical, apply more magic */ /* If magical, apply more magic */
if (SvGMAGICAL(sv)) if (SvGMAGICAL(sv))
mg_get(sv); mg_get(sv);
/* Check to see if this is an object */ /* Check to see if this is an object */
if (sv_isobject(sv)) { if (sv_isobject(sv)) {
SV *tsv = (SV*) SvRV(sv); tsv = (SV*) SvRV(sv);
IV tmp = 0; IV tmp = 0;
if ((SvTYPE(tsv) == SVt_PVHV)) { if ((SvTYPE(tsv) == SVt_PVHV)) {
MAGIC *mg; MAGIC *mg;
@ -104,20 +104,17 @@ SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *
if (mg) { if (mg) {
sv = mg->mg_obj; sv = mg->mg_obj;
if (sv_isobject(sv)) { if (sv_isobject(sv)) {
tmp = SvIV((SV*)SvRV(sv)); tsv = (SV*)SvRV(sv);
tmp = SvIV(tsv);
} }
} }
} else { } else {
return SWIG_ERROR; return SWIG_ERROR;
} }
} else { } else {
tmp = SvIV((SV*)SvRV(sv)); tmp = SvIV(tsv);
} }
voidptr = (void *)tmp; voidptr = (void *)tmp;
if (!_t) {
*(ptr) = voidptr;
return SWIG_OK;
}
} else if (! SvOK(sv)) { /* Check for undef */ } else if (! SvOK(sv)) { /* Check for undef */
*(ptr) = (void *) 0; *(ptr) = (void *) 0;
return SWIG_OK; return SWIG_OK;
@ -134,14 +131,36 @@ SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *
if (_t) { if (_t) {
/* Now see if the types match */ /* Now see if the types match */
char *_c = HvNAME(SvSTASH(SvRV(sv))); char *_c = HvNAME(SvSTASH(SvRV(sv)));
tc = SWIG_TypeCheck(_c,_t); tc = SWIG_TypeCheck(_c,_t);
if (!tc) { if (!tc) {
return SWIG_ERROR; return SWIG_ERROR;
} }
*ptr = SWIG_TypeCast(tc,voidptr); *ptr = SWIG_TypeCast(tc,voidptr);
return SWIG_OK; } else {
*ptr = voidptr;
}
/*
DISOWN implementation: we need a perl guru to check this one.
*/
if (tsv && (flags & SWIG_POINTER_DISOWN)) {
/*
almost copy paste code from bellow SWIG_POINTER_OWN setting
*/
SV *obj = sv;
HV *hv;
HV *stash;
stash=SvSTASH(SvRV(obj));
GV *gv= *(GV**) hv_fetch(stash, "OWNER", 5, TRUE);
if (!isGV(gv))
gv_init(gv, stash, "OWNER", 5, FALSE);
hv = GvHVn(gv);
/*
To set ownership (see bellow), we use newSViv(1). Hence, to
remove ownership, now we use newSViv(0), right?
*/
hv_store_ent(hv, obj, newSViv(0), 0);
} }
*ptr = voidptr;
return SWIG_OK; return SWIG_OK;
} }
@ -154,7 +173,7 @@ SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, swig_type_info *t, i
HV *stash; HV *stash;
sv_setref_pv(obj, (char *) t->name, ptr); sv_setref_pv(obj, (char *) t->name, ptr);
stash=SvSTASH(SvRV(obj)); stash=SvSTASH(SvRV(obj));
if (flags & SWIG_OWNER) { if (flags & SWIG_POINTER_OWN) {
HV *hv; HV *hv;
GV *gv=*(GV**)hv_fetch(stash, "OWNER", 5, TRUE); GV *gv=*(GV**)hv_fetch(stash, "OWNER", 5, TRUE);
if (!isGV(gv)) if (!isGV(gv))