/* $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).

As threatened/promised, this is now implemented in PDL's master branch, with https://github.com/PDLPorters/pdl/commit/ecae7aa64a0fa727ab76dad5401b7ed73150a1aa, and that PP key with https://github.com/PDLPorters/pdl/commit/a2f518f982b8de34180489f37aa1826ca85ace89.

As noted elsewhere on the thread. But without knowing to put that in a BOOT section, and to get the CV of the sub first, that's not actionable (i.e. useful) by itself. The code above one can just copy-paste from (and then, when I get to it, make a PDL::PP key that will do it all automatically).

Speaking of, there's a few other things done with boilerplate within a couple of the modules (overloading in PDL::Ops, PDL::Primitive, also PDL::LinearAlgebra and PDL::Complex, some parameter-handling) that should become PP features too. Ars longa, vita brevis!

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

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]