[Kde-perl] Method returning non-scalar

Ole Christensen Ole.Christensen at web.de
Tue Nov 23 21:58:36 CET 2004


Germain,

I have applied the patch to 3.008. Works fine for me. I have tried it 
with my program and it runs without problem. In my special case I'll 
leave it with returning a reference to a lists anyway, since it is 
faster and it is in an inner loop.

Thanks for your help!

Regards, Ole.

Germain Garand wrote:
> Le Mardi 23 Novembre 2004 07:41, Ole Christensen a écrit :
> 
> Hi again,
> are you able to test the attached? That's what I intend to commit if all is 
> fine.
> I figured we were doing some useless stack copy instead of just proxying, so 
> that should even be faster.
> 
> 
> Greetings,
> Germain
> 
> 
> ------------------------------------------------------------------------
> 
> Index: Qt.xs
> ===================================================================
> RCS file: /cvsroot/perlqt/PerlQt-3/PerlQt/Qt.xs,v
> retrieving revision 1.87
> diff -u -3 -p -r1.87 Qt.xs
> --- Qt.xs	29 Mar 2004 20:31:31 -0000	1.87
> +++ Qt.xs	23 Nov 2004 07:50:55 -0000
> @@ -993,17 +993,16 @@ XS(XS_AUTOLOAD) {
>  	    sv_this = newSVsv(ST(0));
>  	}
>  
> -	ENTER;
> -	SAVETMPS;
>  	PUSHMARK(SP - items + withObject);
>  	PUTBACK;
> -	int count = call_sv((SV*)GvCV(gv), G_SCALAR|G_EVAL);
> +        I32 gimme = GIMME_V;
> +	int count = call_sv((SV*)GvCV(gv), gimme|G_EVAL);
>  	SPAGAIN;
> -	SV *ret = newSVsv(TOPs);
> -	SP -= count;
> -	PUTBACK;
> -	FREETMPS;
> -	LEAVE;
> +        SP -= count;
> +        if (withObject) // shift the stack
> +            for (int i=0; i<count; i++)
> +                ST(i) = ST(i+1);
> +        PUTBACK;
>  
>  	if(withObject && !isSuper) {
>  	    SvREFCNT_dec(sv_this);
> @@ -1014,8 +1013,10 @@ XS(XS_AUTOLOAD) {
>  
>          if(SvTRUE(ERRSV))
>              croak(SvPV_nolen(ERRSV));
> -	ST(0) = sv_2mortal(ret);
> -	XSRETURN(1);
> +        if (gimme == G_VOID)
> +            XSRETURN_UNDEF;
> +        else
> +	    XSRETURN(count);
>      }
>      else if(!strcmp(method, "DESTROY")) {
>          SV *old_this;
> 
> 
> ------------------------------------------------------------------------


More information about the Kde-perl mailing list