To save someone else having to download/extract the linked .tar.gz file there, the .xs file in full (I haven't tried it, was looking how to do this for PDL without the Lvalue.pm it currently has):

/* $Id: LV.xs,v 1.3 2003/10/10 13:53:50 godegisel Exp $ */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#ifndef PERL_MAGIC_ext
#define PERL_MAGIC_ext '~'
#endif

/*
try to lvalueize 5.005_03

#ifndef PERL_API_VERSION
#define newSVuv newSViv
#endif

#ifndef CVf_LVALUE
#define CVf_LVALUE    0x0100  / * CV return value can be used as lvalu
+e * /
#endif

#ifndef CvLVALUE_on
#define CvLVALUE_on(cv)        (CvFLAGS(cv) |= CVf_LVALUE)
#endif

*/

struct    {
    int f_int;
} typedef lvtest;

int set_f_int_func(pTHX_ SV *sv, MAGIC* mg)    {
    if(!SvOK(sv))
        croak("only defined value can be assigned to f_int");

    ((lvtest*) SvIV(LvTARG(sv)))->f_int=SvIV(sv);

    return TRUE;
}

static struct mgvtbl set_f_int_vtbl={
    0,    set_f_int_func,
    0,    0,    0,
#if defined(PERL_REVISION) && PERL_VERSION >= 8
    0,    0,
#endif
};

typedef lvtest * Test__XS__LV;

MODULE = Test::XS::LV        PACKAGE = Test::XS::LV

PROTOTYPES: DISABLE

void
new(xclass)
    SV* xclass
    PREINIT:
    lvtest *self;
    PPCODE:
        Newz(0x66, self, 1, lvtest);
#if GDSL_DEBUG
    warn("new: xs::lv=%p [%i]",self,self);
#endif
    ST(0) = sv_newmortal();
    sv_setref_pv(ST(0), "Test::XS::LV", self);
    XSRETURN(1);

void
DESTROY(self)
    Test::XS::LV self
    PPCODE:
#if GDSL_DEBUG
    warn("DESTROY: xs::lv %p [%i]",self,self);
#endif
        Safefree(self);

void
f_int(self)
    Test::XS::LV self
    PPCODE:
    ST(0) = newSVuv( self->f_int );
    sv_2mortal(ST(0));
    XSRETURN(1);

void
lf_int(self)
    Test::XS::LV self
    PREINIT:
    SV *sv;
    PPCODE:
    sv = newSViv( self->f_int );

    sv_upgrade(sv, SVt_PVLV);
    sv_magic(sv, Nullsv, PERL_MAGIC_ext, Nullch, 0);
    SvSMAGICAL_on(sv);
    LvTYPE(sv)='~';
    LvTARG(sv)=SvREFCNT_inc(SvRV(ST(0)));

    SvMAGIC(sv)->mg_virtual=&set_f_int_vtbl;
//    sv_dump(sv);
    sv_2mortal(sv);
    ST(0) = sv;
    XSRETURN(1);

BOOT:
    {
    HV* stash;
    SV **meth;
    CV *cv;
    stash = gv_stashpvn("Test::XS::LV", 12, TRUE);
//    sv_dump((SV*)stash);
    meth=hv_fetch(stash, "lf_int", 6, 0);
    if(!meth)
        croak("lost method 'lf_int'");
    cv=GvCV(*meth);
    CvLVALUE_on(cv);
    }
[download]

The key being CvLVALUE_on(cv).

Perfect! Change

-$obj->lf_int=444;
+sub lf_int :lvalue { $obj->lf_int }
+lf_int=444;
[download]

and you get

Can't return a temporary from lvalue subroutine
[download]

That's the bug. It's a spurious exception (not a warning!) when the temp has set magic.

Obscure, yes, but I want to change the lvalue ops to return a temp which would cause the following to give the same error:

sub foo :lvalue { substr(...) }
[download]

Make an XS sub that returns a reference and wrap it with a perl lvalue sub.

LVRET detects if a sub is called as an lvalue (or something like that). I have no problem putting an SV on the stack, the problem is getting the following to compile

sub foo :lvalue { lvalue_xs_sub() }
[download]

I could avoid it with something like

sub foo :lvalue { out_param_xs_sub(my $x); $x }
[download]

but the point is to create a test for a bug I want to fix so I can fix another bug (delayed object destruction) in substr, pos and vec.

Hmm
Read more... (1461 Bytes)
CvLVALUE_on maybe?