Object-Pad

 view release on metacpan or  search on metacpan

src/class.c  view on Meta::CPAN


#ifdef HAVE_DMD_HELPER
#  define WANT_DMD_API_044
#  include "DMD_helper.h"
#endif

#include "perl-backcompat.c.inc"
#include "sv_setrv.c.inc"

#include "perl-additions.c.inc"
#include "lexer-additions.c.inc"
#include "forbid_outofblock_ops.c.inc"
#include "force_list_keeping_pushmark.c.inc"
#include "optree-additions.c.inc"
#include "newOP_CUSTOM.c.inc"
#include "cv_copy_flags.c.inc"
#include "OP_HELEMEXISTSOR.c.inc"

#include "object_pad.h"
#include "class.h"
#include "field.h"

#undef register_class_attribute

#ifdef DEBUGGING
#  define DEBUG_OVERRIDE_PLCURCOP
#  define DEBUG_SET_CURCOP_LINE(line)    CopLINE_set(PL_curcop, line)
#else
#  undef  DEBUG_OVERRIDE_PLCURCOP
#  define DEBUG_SET_CURCOP_LINE(line)
#endif

#define COP_SEQ_RANGE_LOW_set(sv,val)  \
    STMT_START { (sv)->xpadn_low = (val); } STMT_END

#ifndef COP_SEQMAX_INC
#define COP_SEQMAX_INC \
    (PL_cop_seqmax++, \
        (void)(PL_cop_seqmax == PERL_PADSEQ_INTRO && PL_cop_seqmax++))
#endif

#define need_PLparser()  ObjectPad__need_PLparser(aTHX)
void ObjectPad__need_PLparser(pTHX); /* in Object/Pad.xs */

/* Empty MGVTBL simply for locating instance backing AV */
static MGVTBL vtbl_backingav = {};

RoleEmbedding ObjectPad__embedding_standalone = {
  LINNET_INIT(LINNET_VAL_ROLEEMBEDDING)
};

typedef struct ClassAttributeRegistration ClassAttributeRegistration;

struct ClassAttributeRegistration {
  ClassAttributeRegistration *next;

  const char *name;
  STRLEN permit_hintkeylen;

  const struct ClassHookFuncs *funcs;
  void *funcdata;
};

static ClassAttributeRegistration *classattrs = NULL;

static void register_class_attribute(const char *name, const struct ClassHookFuncs *funcs, void *funcdata)
{
  ClassAttributeRegistration *reg;
  Newx(reg, 1, struct ClassAttributeRegistration);

  *reg = (struct ClassAttributeRegistration){
    .name     = name,
    .funcs    = funcs,
    .funcdata = funcdata,
  };

  if(funcs->permit_hintkey)
    reg->permit_hintkeylen = strlen(funcs->permit_hintkey);
  else
    reg->permit_hintkeylen = 0;

  reg->next  = classattrs;
  classattrs = reg;
}

struct ClassHookFuncs_v57 {
  U32 ver;
  U32 flags;
  const char *permit_hintkey;
  bool (*apply)(pTHX_ ClassMeta *classmeta, SV *value, SV **hookdata_ptr, void *funcdata);
  /* No pre- or post-seal */
  void (*post_add_field)(pTHX_ ClassMeta *classmeta, SV *hookdata, void *funcdata, FieldMeta *fieldmeta);
};

void ObjectPad_register_class_attribute(pTHX_ const char *name, const struct ClassHookFuncs *funcs, void *funcdata)
{
  if(funcs->ver < 57)
    croak("Mismatch in third-party class attribute ABI version field: module wants %d, we require >= 57\n",
        funcs->ver);
  if(funcs->ver > OBJECTPAD_ABIVERSION)
    croak("Mismatch in third-party class attribute ABI version field: attribute supplies %d, module wants %d\n",
        funcs->ver, OBJECTPAD_ABIVERSION);

  if(!name || !(name[0] >= 'A' && name[0] <= 'Z'))
    croak("Third-party class attribute names must begin with a capital letter");

  if(!funcs->permit_hintkey)
    croak("Third-party class attributes require a permit hinthash key");

  if(funcs->ver < OBJECTPAD_ABIVERSION) {
    const struct ClassHookFuncs_v57 *funcs_v57 = (const struct ClassHookFuncs_v57 *)funcs;

    struct ClassHookFuncs *funcs_v76;
    Newx(funcs_v76, 1, struct ClassHookFuncs);

    *funcs_v76 = (struct ClassHookFuncs){
      .ver            = OBJECTPAD_ABIVERSION,
      .flags          = funcs_v57->flags,
      .permit_hintkey = funcs_v57->permit_hintkey,
      .apply          = funcs_v57->apply,
      .post_add_field = funcs_v57->post_add_field,
    };

    funcs = funcs_v76;
  }

  register_class_attribute(name, funcs, funcdata);
}

void ObjectPad_mop_class_apply_attribute(pTHX_ ClassMeta *classmeta, const char *name, SV *value)
{
  HV *hints = GvHV(PL_hintgv);

  if(value && (!SvPOK(value) || !SvCUR(value)))
    value = NULL;

  ClassAttributeRegistration *reg;
  for(reg = classattrs; reg; reg = reg->next) {
    if(!strEQ(name, reg->name))
      continue;

    if(reg->funcs->permit_hintkey &&
        (!hints || !hv_fetch(hints, reg->funcs->permit_hintkey, reg->permit_hintkeylen, 0)))
      continue;

    if((reg->funcs->flags & OBJECTPAD_FLAG_ATTR_NO_VALUE) && value)
      croak("Attribute :%s does not permit a value", name);
    if((reg->funcs->flags & OBJECTPAD_FLAG_ATTR_MUST_VALUE) && !value)
      croak("Attribute :%s requires a value", name);

    SV *attrdata = value;

    if(reg->funcs->apply) {
      if(!(*reg->funcs->apply)(aTHX_ classmeta, value, &attrdata, reg->funcdata))
        return;
    }

    if(!classmeta->hooks)
      classmeta->hooks = newAV();

    struct ClassHook *hook;
    Newx(hook, 1, struct ClassHook);

    *hook = (struct ClassHook){
      .funcs    = reg->funcs,
      .funcdata = reg->funcdata,
      .attrdata = attrdata,
    };

    av_push(classmeta->hooks, (SV *)hook);

    if(value && value != attrdata)
      SvREFCNT_dec(value);

    return;
  }

  croak("Unrecognised class attribute :%s", name);
}

static ClassAttributeRegistration *get_active_registration(pTHX_ const char *name)
{
  COPHH *cophh = CopHINTHASH_get(PL_curcop);

  for(ClassAttributeRegistration *reg = classattrs; reg; reg = reg->next) {
    if(!strEQ(name, reg->name))
      continue;

    if(reg->funcs->permit_hintkey &&
        !cophh_fetch_pvn(cophh, reg->funcs->permit_hintkey, reg->permit_hintkeylen, 0, 0))
      continue;

    return reg;
  }

  return NULL;
}

struct ClassHook *ObjectPad_mop_class_get_attribute(pTHX_ ClassMeta *classmeta, const char *name)
{
  /* First, work out what hookfuncs the name maps to */
  ClassAttributeRegistration *reg = get_active_registration(aTHX_ name);

  if(!reg)
    return NULL;

  /* Now lets see if classmeta has one */

  if(!classmeta->hooks)
    return NULL;

  U32 hooki;
  for(hooki = 0; hooki < av_count(classmeta->hooks); hooki++) {
    struct ClassHook *hook = (struct ClassHook *)AvARRAY(classmeta->hooks)[hooki];

    if(hook->funcs == reg->funcs)
      return hook;
  }

  return NULL;
}

AV *ObjectPad_mop_class_get_attribute_values(pTHX_ ClassMeta *classmeta, const char *name)
{
  /* First, work out what hookfuncs the name maps to */

src/class.c  view on Meta::CPAN

    ClassMeta *supermeta = meta->cls.supermeta;
    if(!supermeta->pending_submeta)
      supermeta->pending_submeta = newAV();
    av_push(supermeta->pending_submeta, (SV *)meta);
    return;
  }

  if(meta->type == METATYPE_CLASS)
    S_apply_roles(aTHX_ meta, meta);

  if(!meta->abstract) {
    U32 nmethods = av_count(meta->requiremethods);
    U32 i;
    for(i = 0; i < nmethods; i++) {
      SV *mname = AvARRAY(meta->requiremethods)[i];

      GV *gv = gv_fetchmeth_sv(meta->stash, mname, 0, 0);
      if(gv && GvCV(gv))
        continue;

      croak("Class %" SVf " does not provide a required method named '%" SVf "'",
        SVfARG(meta->name), SVfARG(mname));
    }
  }

  if(meta->type == METATYPE_CLASS) {
    GV *gv = gv_fetchmeth_pvs(meta->stash, "BUILDARGS", -1, 0);
    assert(gv); assert(SvTYPE(gv) == SVt_PVGV);

    if(GvSTASH(gv) != gv_stashpvs("Object::Pad::UNIVERSAL", 0))
      meta->has_buildargs = true;
  }

  if(meta->strict_params && meta->buildcvs)
    croak("Class %" SVf " cannot be :strict(params) because it has BUILD phasers",
      SVfARG(meta->name));

  {
    AV *fields = meta->fields;
    U32 nfields = av_count(fields);

    U32 i;
    for(i = 0; i < nfields; i++) {
      FieldMeta *fieldmeta = MUST_FIELDMETA(AvARRAY(fields)[i]);

      U32 hooki;
      for(hooki = 0; fieldmeta->hooks && hooki < av_count(fieldmeta->hooks); hooki++) {
        struct FieldHook *h = (struct FieldHook *)AvARRAY(fieldmeta->hooks)[hooki];

        if(*h->funcs->post_makefield) {
          if(!meta->fieldhooks_makefield)
            meta->fieldhooks_makefield = newAV();

          struct FieldHook *fasth;
          Newx(fasth, 1, struct FieldHook);

          *fasth = (struct FieldHook){
            .fieldix   = fieldmeta->fieldix,
            .fieldmeta = fieldmeta,
            .funcs     = h->funcs,
            .funcdata  = h->funcdata,
            .attrdata  = h->attrdata,
          };

          av_push(meta->fieldhooks_makefield, (SV *)fasth);
        }

        if(*h->funcs->post_construct) {
          if(!meta->fieldhooks_construct)
            meta->fieldhooks_construct = newAV();

          struct FieldHook *fasth;
          Newx(fasth, 1, struct FieldHook);

          *fasth = (struct FieldHook){
            .fieldix   = fieldmeta->fieldix,
            .fieldmeta = fieldmeta,
            .funcs     = h->funcs,
            .funcdata  = h->funcdata,
            .attrdata  = h->attrdata,
          };

          av_push(meta->fieldhooks_construct, (SV *)fasth);
        }
      }
    }
  }

  S_generate_initfields_method(aTHX_ meta);

  if(meta->adjust_lines) {
    ENTER;

    need_PLparser();

    I32 floor_ix = PL_savestack_ix;
    {
      SAVEI32(PL_subline);
      save_item(PL_subname);

      resume_compcv(&meta->adjust_compcv);
    }

    SvREFCNT_inc(PL_compcv);

    OP *body = finish_adjust_params(meta, meta->adjust_params, meta->adjust_lines);

    meta->methodscope = meta->adjust_methodscope;

    body = finish_method_parse(meta, FALSE, body);

    CV *adjustcv = newATTRSUB(floor_ix, NULL, NULL, NULL, body);

    mop_class_add_ADJUST(meta, adjustcv);

    LEAVE;
  }

  meta->sealed = true;

  MOP_CLASS_RUN_HOOKS_NOARGS(meta, post_seal);

  if(meta->pending_submeta) {
    int i;
    SV **arr = AvARRAY(meta->pending_submeta);
    for(i = 0; i < av_count(meta->pending_submeta); i++) {
      ClassMeta *submeta = MUST_CLASSMETA(arr[i]);
      arr[i] = &PL_sv_undef;

      mop_class_seal(submeta);
    }

    SvREFCNT_dec(meta->pending_submeta);
    meta->pending_submeta = NULL;
  }
}

XS_INTERNAL(injected_constructor);
XS_INTERNAL(injected_constructor)

src/class.c  view on Meta::CPAN

        if(SvTYPE(rv) != SVt_PVHV) {
#ifdef DEBUG_OVERRIDE_PLCURCOP
          PL_curcop = prevcop;
#endif
          croak("Expected %" SVf "->SUPER::new to return a blessed HASH reference", class);
        }

        need_makefields = !hv_exists(MUTABLE_HV(rv), "Object::Pad/slots", 17);
        break;

      case REPR_MAGIC:
      case_REPR_MAGIC:
        /* Anything goes */

        need_makefields = !mg_findext(rv, PERL_MAGIC_ext, &vtbl_backingav);
        break;

      case REPR_AUTOSELECT:
        if(SvTYPE(rv) == SVt_PVHV)
          goto case_REPR_HASH;
        goto case_REPR_MAGIC;
    }

    sv_2mortal(self);
  }

  SV *fieldstore;

  if(need_makefields) {
    fieldstore = get_obj_fieldstore(self, meta->repr, TRUE);
    make_instance_fields(meta, fieldstore, 0);
  }
  else {
    fieldstore = get_obj_fieldstore(self, meta->repr, FALSE);
  }

  SV **fieldsvs = fieldstore_fields(fieldstore);

  if(meta->fieldhooks_makefield || meta->fieldhooks_construct) {
    /* We need to set up a fake pad so these hooks can still get PADIX_SELF / PADIX_FIELDS */

    /* This MVP is just sufficient enough to let PAD_SVl(PADIX_SELF) work */
    SAVEVPTR(PL_curpad);
    Newx(PL_curpad, 3, SV *);
    SAVEFREEPV(PL_curpad);

    PAD_SVl(PADIX_SELF)   = self;
    PAD_SVl(PADIX_FIELDS) = fieldstore;
  }

  if(meta->fieldhooks_makefield) {
    DEBUG_SET_CURCOP_LINE(__LINE__);

    AV *fieldhooks = meta->fieldhooks_makefield;

    U32 i;
    for(i = 0; i < av_count(fieldhooks); i++) {
      struct FieldHook *h = (struct FieldHook *)AvARRAY(fieldhooks)[i];
      FIELDOFFSET fieldix = h->fieldix;

      (*h->funcs->post_makefield)(aTHX_ h->fieldmeta, h->attrdata, h->funcdata, fieldsvs[fieldix]);
    }
  }

  HV *paramhv = NULL;
  if(meta->parammap || meta->has_adjust || meta->strict_params) {
    paramhv = newHV();
    SAVEFREESV((SV *)paramhv);

    if(nargs % 2)
      warn("Odd-length list passed to %" SVf " constructor", class);

    /* TODO: I'm sure there's an newHV_from_AV() around somewhere */
    SV **argsv = AvARRAY(args);

    IV idx;
    for(idx = 0; idx < nargs; idx += 2) {
      SV *name  = argsv[idx];
      SV *value = idx < nargs-1 ? argsv[idx+1] : &PL_sv_undef;

      hv_store_ent(paramhv, name, SvREFCNT_inc(value), 0);
    }
  }

  {
    /* Run initfields */
    ENTER;
#ifdef DEBUG_OVERRIDE_PLCURCOP
    SAVEVPTR(PL_curcop);
    PL_curcop = prevcop;
#endif

    EXTEND(SP, 2);
    PUSHMARK(SP);
    PUSHs(self);
    if(paramhv)
      PUSHs((SV *)paramhv);
    else
      PUSHs(&PL_sv_undef);
    PUTBACK;

    assert(meta->initfields);
    call_sv((SV *)meta->initfields, G_VOID);

    LEAVE;
  }

  if(meta->buildcvs) {
    DEBUG_SET_CURCOP_LINE(__LINE__);

    AV *buildcvs = meta->buildcvs;
    SV **argsvs = AvARRAY(args);
    int i;
    for(i = 0; i < av_count(buildcvs); i++) {
      CV *buildcv = (CV *)AvARRAY(buildcvs)[i];

      ENTER;
      SAVETMPS;
      SPAGAIN;

      EXTEND(SP, nargs);

src/class.c  view on Meta::CPAN

  }

  if(meta->adjustcvs) {
    DEBUG_SET_CURCOP_LINE(__LINE__);

    AV *adjustcvs = meta->adjustcvs;
    U32 i;
    for(i = 0; i < av_count(adjustcvs); i++) {
      CV *cv = (CV *)AvARRAY(adjustcvs)[i];

      ENTER;
      SAVETMPS;
      SPAGAIN;

      EXTEND(SP, 1 + !!paramhv);

      PUSHMARK(SP);
      PUSHs(self);
      if(paramhv)
        mPUSHs(newRV_inc((SV *)paramhv));
      PUTBACK;

      assert(cv);
      call_sv((SV *)cv, G_VOID);

      FREETMPS;
      LEAVE;
    }
  }

  if(meta->strict_params && hv_iterinit(paramhv) > 0) {
    HE *he = hv_iternext(paramhv);

    /* Concat all the param names, in no particular order
     * TODO: consider sorting them but that's quite expensive and tricky in XS */

    SV *params = newSVpvn("", 0);
    SAVEFREESV(params);
    sv_catpvf(params, "'%" SVf "'", SVfARG(HeSVKEY_force(he)));

    while((he = hv_iternext(paramhv)))
      sv_catpvf(params, ", '%" SVf "'", SVfARG(HeSVKEY_force(he)));

#ifdef DEBUG_OVERRIDE_PLCURCOP
    PL_curcop = prevcop;
#endif
    croak("Unrecognised parameters for %" SVf " constructor: %" SVf,
      SVfARG(meta->name), SVfARG(params));
  }

  if(meta->fieldhooks_construct) {
    DEBUG_SET_CURCOP_LINE(__LINE__);

    AV *fieldhooks = meta->fieldhooks_construct;

    U32 i;
    for(i = 0; i < av_count(fieldhooks); i++) {
      struct FieldHook *h = (struct FieldHook *)AvARRAY(fieldhooks)[i];
      FIELDOFFSET fieldix = h->fieldix;

      (*h->funcs->post_construct)(aTHX_ h->fieldmeta, h->attrdata, h->funcdata, fieldsvs[fieldix]);
    }
  }

#ifdef DEBUG_OVERRIDE_PLCURCOP
  PL_curcop = prevcop;
#endif
  ST(0) = self;
  XSRETURN(1);
}

XS_INTERNAL(injected_constructor_role);
XS_INTERNAL(injected_constructor_role)
{
  const ClassMeta *meta = MUST_CLASSMETA(XSANY.any_ptr);
  croak("Cannot directly construct an instance of role '%" SVf "'",
    SVfARG(meta->name));
}

XS_INTERNAL(injected_DOES)
{
  dXSARGS;
  const ClassMeta *meta = MUST_CLASSMETA(XSANY.any_ptr);
  SV *self = ST(0);
  SV *wantrole = ST(1);

  PERL_UNUSED_ARG(items);

  CV *cv_does = NULL;

  while(meta != NULL) {
    AV *roles = meta->type == METATYPE_CLASS ? meta->cls.direct_roles : NULL;
    I32 nroles = roles ? av_count(roles) : 0;

    if(!cv_does && meta->cls.foreign_does)
      cv_does = meta->cls.foreign_does;

    if(sv_eq(meta->name, wantrole)) {
      XSRETURN_YES;
    }

    int i;
    for(i = 0; i < nroles; i++) {
      RoleEmbedding *embedding = MUST_ROLEEMBEDDING(AvARRAY(roles)[i]);
      if(sv_eq(embedding->rolemeta->name, wantrole)) {
        XSRETURN_YES;
      }
    }

    meta = meta->type == METATYPE_CLASS ? meta->cls.supermeta : NULL;
  }

  if (cv_does) {
    /* return $self->DOES(@_); */
    dSP;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    EXTEND(SP, 2);

src/class.c  view on Meta::CPAN


  if(meta->type == METATYPE_CLASS && !meta->cls.supermeta) {
    av_push(meta->isa, newSVpvs("Object::Pad::UNIVERSAL"));
  }

  if(meta->type == METATYPE_CLASS &&
      meta->repr == REPR_AUTOSELECT && !meta->cls.foreign_new)
    meta->repr = REPR_NATIVE;

  meta->begun = true;
  meta->next_fieldix = meta->start_fieldix;
}

/*******************
 * Attribute hooks *
 *******************/

#ifndef isSPACE_utf8_safe
   /* this isn't really safe but it's the best we can do */
#  define isSPACE_utf8_safe(p, e)  (PERL_UNUSED_ARG(e), isSPACE_utf8(p))
#endif

#define split_package_ver(value, pkgname, pkgversion)  S_split_package_ver(aTHX_ value, pkgname, pkgversion)
static const char *S_split_package_ver(pTHX_ SV *value, SV *pkgname, SV *pkgversion)
{
  const char *start = SvPVX(value), *p = start, *end = start + SvCUR(value);

  while(*p && !isSPACE_utf8_safe(p, end))
    p += UTF8SKIP(p);

  sv_setpvn(pkgname, start, p - start);
  if(SvUTF8(value))
    SvUTF8_on(pkgname);

  while(*p && isSPACE_utf8_safe(p, end))
    p += UTF8SKIP(p);

  if(*p) {
    /* scan_version() gets upset about trailing content. We need to extract
     * exactly what it wants
     */
    start = p;
    if(*p == 'v')
      p++;
    while(*p && strchr("0123456789._", *p))
      p++;
    SV *tmpsv = newSVpvn(start, p - start);
    SAVEFREESV(tmpsv);

    scan_version(SvPVX(tmpsv), pkgversion, FALSE);
  }

  while(*p && isSPACE_utf8_safe(p, end))
    p += UTF8SKIP(p);

  return p;
}

/* :isa */

static bool classhook_isa_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata, void *_funcdata)
{
  SV *superclassname = newSV(0), *superclassver = newSV(0);
  SAVEFREESV(superclassname);
  SAVEFREESV(superclassver);

  const char *end = split_package_ver(value, superclassname, superclassver);

  if(*end)
    croak("Unexpected characters while parsing :isa() attribute: %s", end);

  mop_class_load_and_set_superclass(classmeta, superclassname, superclassver);

  return FALSE;
}

static const struct ClassHookFuncs classhooks_isa = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
  .apply = &classhook_isa_apply,
};

/* :does */

static bool classhook_does_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata, void *_funcdata)
{
  SV *rolename = newSV(0), *rolever = newSV(0);
  SAVEFREESV(rolename);
  SAVEFREESV(rolever);

  const char *end = split_package_ver(value, rolename, rolever);

  if(*end)
    croak("Unexpected characters while parsing :does() attribute: %s", end);

  mop_class_begin(classmeta);

  mop_class_load_and_add_role(classmeta, rolename, rolever);

  return FALSE;
}

static const struct ClassHookFuncs classhooks_does = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
  .apply = &classhook_does_apply,
};

/* :abstract */

static bool classhook_abstract_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  if(classmeta->type == METATYPE_ROLE)
    warn("All roles are already abstract; there is no need to declare them as such");

  classmeta->abstract = TRUE;

  return FALSE;
}

static const struct ClassHookFuncs classhooks_abstract = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_NO_VALUE,
  .apply = &classhook_abstract_apply,
};

/* :repr */

static bool classhook_repr_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata, void *_funcdata)
{
  char *val = SvPV_nolen(value); /* all comparisons are ASCII */

  if(strEQ(val, "native")) {
    if(classmeta->type == METATYPE_CLASS && classmeta->cls.foreign_new)
      croak("Cannot switch a subclass of a foreign superclass type to :repr(native)");
    classmeta->repr = REPR_NATIVE;
  }
  else if(strEQ(val, "HASH"))
    classmeta->repr = REPR_HASH;
  else if(strEQ(val, "magic")) {
    if(classmeta->type != METATYPE_CLASS || !classmeta->cls.foreign_new)
      croak("Cannot switch to :repr(magic) without a foreign superclass");
    classmeta->repr = REPR_MAGIC;
  }
  else if(strEQ(val, "keys"))
    classmeta->repr = REPR_KEYS;
  else if(strEQ(val, "pvobj")) {
    if(classmeta->type == METATYPE_CLASS && classmeta->cls.foreign_new)
      croak("Cannot switch a subclass of a foreign superclass type to :repr(pvobj)");
#ifdef HAVE_SVt_PVOBJ
    classmeta->repr = REPR_PVOBJ;
#else
    croak("Cannot switch to :repr(pvobj) on Perl " PERL_VERSION_STRING);
#endif
  }
  else if(strEQ(val, "default") || strEQ(val, "autoselect"))
    classmeta->repr = REPR_AUTOSELECT;
  else
    croak("Unrecognised class representation type %" SVf, SVfARG(value));

  return FALSE;
}

static const struct ClassHookFuncs classhooks_repr = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
  .apply = &classhook_repr_apply,
};

/* :compat */

static bool classhook_compat_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata, void *_funcdata)
{
  if(strEQ(SvPV_nolen(value), "invokable")) {
    if(classmeta->type != METATYPE_ROLE)
      croak(":compat(invokable) only applies to a role");

    classmeta->role_is_invokable = true;
  }
  else
    croak("Unrecognised class compatibility argument %" SVf, SVfARG(value));

  return FALSE;
}

static const struct ClassHookFuncs classhooks_compat = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
  .apply = &classhook_compat_apply,
};

/* :strict */

static bool classhook_strict_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  if(strEQ(SvPV_nolen(value), "params"))
    classmeta->strict_params = TRUE;
  else
    croak("Unrecognised class strictness type %" SVf, SVfARG(value));

  return FALSE;
}

static const struct ClassHookFuncs classhooks_strict = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
  .apply = &classhook_strict_apply,
};

/* :lexical_new */

static bool classhook_lexicalnew_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  classmeta->lexical_new = TRUE;

  return FALSE;
}

static const struct ClassHookFuncs classhooks_lexicalnew = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_NO_VALUE,
  .apply = &classhook_lexicalnew_apply,
};

void ObjectPad__boot_classes(pTHX)
{
  register_class_attribute("isa",         &classhooks_isa,        NULL);
  register_class_attribute("does",        &classhooks_does,       NULL);
  register_class_attribute("abstract",    &classhooks_abstract,   NULL);
  register_class_attribute("repr",        &classhooks_repr,       NULL);
  register_class_attribute("compat",      &classhooks_compat,     NULL);
  register_class_attribute("strict",      &classhooks_strict,     NULL);
  register_class_attribute("lexical_new", &classhooks_lexicalnew, NULL);

#ifdef HAVE_DMD_HELPER
  DMD_ADD_ROOT((SV *)&vtbl_backingav, "the Object::Pad backing AV VTBL");
#endif
}



( run in 0.541 second using v1.01-cache-2.11-cpan-39bf76dae61 )