Returning a magical SV to Perl

[Steve Hay]

Why is it that when I create an SV and assign magic to it in an XSUB, 
and then return the magical SV to Perl code, I find that the scalar in 
the Perl code no longer seems to have magic?

The attached sample module has XSUB's to create a magical SV (fooalloc 
and fooallocext), an XSUB to use the magical SV created (foo) and 
another to free it (foofree, not strictly necessary since the SV here is 
mortal anyway).

I was intending that when I run

perl -Mblib -MFoo -e "$a=Foo::fooalloc();Foo::foo($a);Foo::foofree($a)"

it would print "Hello, world.".

But it doesn't.  It croak()'s in foo() claiming that it can't find the 
magic on the SV passed in.

I've added some sv_dump()'s into the allocators to look at the SV being 
returned; using Devel::Peek::Dump() in the Perl code I can also look at 
what it received, and I find that they're completely different:

perl -Mblib -MFoo -MDevel::Peek -e "$a=Foo::fooalloc();Dump($a)"

outputs this:

SV = PVMG(0x1835170) at 0x1820184
  REFCNT = 1
  FLAGS = (TEMP,RMG)
  IV = 0
  NV = 0
  PV = 0
  MAGIC = 0x182a188
    MG_VIRTUAL = 0x354410
    MG_TYPE = PERL_MAGIC_ext(~)
    MG_PTR = 0x185a738 ""
SV = PVMG(0x1835190) at 0x183578c
  REFCNT = 1
  FLAGS = ()
  IV = 0
  NV = 0
  PV = 0

Where has all the magic gone?

- Steve


------------------------------------------------
Radan Computational Ltd.

The information contained in this message and any files transmitted with it are 
confidential and intended for the addressee(s) only.  If you have received this 
message in error or there are any problems, please notify the sender immediately.  The 
unauthorized use, disclosure, copying or alteration of this message is strictly 
forbidden.  Note that any views or opinions presented in this email are solely those 
of the author and do not necessarily represent those of Radan Computational Ltd.  The 
recipient(s) of this message should check it and any attached files for viruses: Radan 
Computational will accept no liability for any damage caused by any virus transmitted 
by this email.

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

typedef struct {
  MAGIC *mg;
  char *buf;
} Foo;

static Foo *FooAlloc(pTHX);
static void FooFree(pTHX_ Foo *foo);
static int MagicFooFree(pTHX_ SV *sv, MAGIC *mg);

static MGVTBL Foo_vtbl = {
  NULL,
  NULL,
  NULL,
  NULL,
  MagicFooFree
};

static Foo *FooAlloc(pTHX) {
  Foo *foo;
  Newz(0, foo, 1, Foo);
  Newz(0, foo->buf, 1024, char);
  strcpy(foo->buf, "Hello, world.");
  return foo;
}

static void FooFree(pTHX_ Foo *foo) {
  Safefree(foo->buf);
  Safefree(foo);
}

static int MagicFooFree(pTHX_ SV *sv, MAGIC *mg) {
  Foo *foo;
  if (foo = (Foo *)(mg->mg_ptr))
    FooFree(aTHX_ foo);
  return 1;
}

MODULE = Foo            PACKAGE = Foo           

void
fooalloc()
PPCODE:
{
  Foo *foo;
  SV *sv;
  MAGIC *mg;
  foo = FooAlloc(aTHX);
  sv = sv_newmortal();
  sv_magic(sv, NULL, PERL_MAGIC_ext, (char *)foo, 0);
  if (!(mg = mg_find(sv, PERL_MAGIC_ext)))
    croak("Can't add magic");
  mg->mg_virtual = &Foo_vtbl;
  foo->mg = mg;
  sv_dump(sv);
  EXTEND(SP, 1);
  PUSHs(sv);
  XSRETURN(1);
}

void
fooallocext()
PPCODE:
{
  Foo *foo;
  SV *sv;
  MAGIC *mg;
  foo = FooAlloc(aTHX);
  sv = sv_newmortal();
  if (!(mg = sv_magicext(sv, NULL, PERL_MAGIC_ext, &Foo_vtbl, (char *)foo, 0)))
    croak("Can't add magic");
  foo->mg = mg;
  sv_dump(sv);
  EXTEND(SP, 1);
  PUSHs(sv);
  XSRETURN(1);
}

void
foofree(sv)
  SV *sv;
PPCODE:
{
  SvREFCNT_dec(sv);
}

void
foo(sv)
  SV *sv;
PPCODE:
{
  MAGIC *mg;
  Foo *foo;
  if (!(mg = mg_find(sv, PERL_MAGIC_ext)) ||
      !(foo = (Foo *)(mg->mg_ptr))        ||
      foo->mg != mg)
    croak("Can't find our magic");
  printf("%s\n", foo->buf);
}