Object-Pad
view release on metacpan or search on metacpan
src/class.c view on Meta::CPAN
/* vi: set ft=xs : */
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#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");
src/class.c view on Meta::CPAN
assert(classmeta->type == METATYPE_CLASS);
assert(classmeta->cls.supermeta->sealed);
make_instance_fields(classmeta->cls.supermeta, fieldstore, 0);
}
AV *fields = classmeta->fields;
I32 nfields = av_count(fields);
if(SvTYPE(fieldstore) == SVt_PVAV)
av_extend((AV *)fieldstore, classmeta->next_fieldix - 1 + roleoffset);
I32 i;
for(i = 0; i < nfields; i++) {
FieldMeta *fieldmeta = MUST_FIELDMETA(AvARRAY(fields)[i]);
if(!fieldmeta->is_direct)
continue;
char sigil = SvPV_nolen(fieldmeta->name)[0];
FIELDOFFSET fieldix = fieldmeta->fieldix + roleoffset;
/* We can't av_push() because REPR_KEYS would break here */
SV **svp;
#ifdef HAVE_SVt_PVOBJ
if(SvTYPE(fieldstore) == SVt_PVOBJ) {
svp = &ObjectFIELDS(fieldstore)[fieldix];
*svp = newSV(0);
}
else
#endif
{
svp = av_fetch_simple((AV *)fieldstore, fieldix, TRUE);
}
assert(svp);
switch(sigil) {
case '$':
/* simply fetching will create the SV */
break;
case '@':
sv_setrv_noinc(*svp, (SV *)newAV());
break;
case '%':
sv_setrv_noinc(*svp, (SV *)newHV());
break;
default:
croak("ARGH: not sure how to handle a slot sigil %c\n", sigil);
}
}
if(classmeta->type == METATYPE_CLASS) {
U32 nroles;
RoleEmbedding **embeddings = mop_class_get_direct_roles(classmeta, &nroles);
assert(classmeta->type == METATYPE_CLASS || nroles == 0);
for(i = 0; i < nroles; i++) {
RoleEmbedding *embedding = MUST_ROLEEMBEDDING(embeddings[i]);
ClassMeta *rolemeta = embedding->rolemeta;
assert(rolemeta->sealed);
make_instance_fields(rolemeta, fieldstore, embedding->offset);
}
}
}
#define alias_fieldkeys_into_av(classmeta, hv, backingav) S_alias_fieldkeys_into_av(aTHX_ classmeta, hv, backingav)
static void S_alias_fieldkeys_into_av(pTHX_ ClassMeta *classmeta, HV *hv, AV *backingav)
{
if(classmeta->cls.supermeta)
alias_fieldkeys_into_av(classmeta->cls.supermeta, hv, backingav);
AV *fields = classmeta->fields;
I32 nfields = av_count(fields);
I32 i;
for(i = 0; i < nfields; i++) {
FieldMeta *fieldmeta = MUST_FIELDMETA(AvARRAY(fields)[i]);
if(!fieldmeta->is_direct)
continue;
SV *fieldkey = newSVpvf("%" SVf "/%" SVf, classmeta->name, fieldmeta->name);
HE *he = hv_fetch_ent(hv, fieldkey, 1, 0);
SvREFCNT_dec(fieldkey);
av_store(backingav, fieldmeta->fieldix, SvREFCNT_inc(HeVAL(he)));
}
}
SV *ObjectPad_get_obj_fieldstore(pTHX_ SV *self, enum ReprType repr, bool create)
{
SV *rv = SvRV(self);
switch(repr) {
case REPR_NATIVE:
if(SvTYPE(rv) != SVt_PVAV)
croak("Not an ARRAY reference");
return rv;
case REPR_HASH:
case_REPR_HASH:
{
if(SvTYPE(rv) != SVt_PVHV)
croak("Not a HASH reference");
SV **backingsvp = hv_fetchs((HV *)rv, "Object::Pad/slots", create);
if(create && !SvOK(*backingsvp))
sv_setrv_noinc(*backingsvp, (SV *)newAV());
/* A method invoked during a superclass constructor of a classic perl
* class might encounter $self without fields. If this is the case we'll
* have to create the fields now
* https://rt.cpan.org/Ticket/Display.html?id=132263
*/
if(!backingsvp) {
struct ClassMeta *classmeta = mop_get_class_for_stash(SvSTASH(rv));
SV *fieldstore = (SV *)newAV();
src/class.c view on Meta::CPAN
if(!mg)
croak("Expected to find backing AV magic extension");
return mg->mg_obj;
}
case REPR_AUTOSELECT:
if(SvTYPE(rv) == SVt_PVHV)
goto case_REPR_HASH;
goto case_REPR_MAGIC;
case REPR_KEYS:
{
/* TODO: This representation is going to be sloooooow
*/
if(SvTYPE(rv) != SVt_PVHV)
croak("Not a HASH reference");
HV *hv = (HV *)rv;
AV *backingav = newAV();
SAVEFREESV((SV *)backingav);
alias_fieldkeys_into_av(mop_get_class_for_stash(SvSTASH(rv)), hv, backingav);
return (SV *)backingav;
}
case REPR_PVOBJ:
#ifdef HAVE_SVt_PVOBJ
if(SvTYPE(rv) != SVt_PVOBJ)
croak("ARGH not an SVt_PVOBJ");
return rv;
#else
croak("ARGH cannot SVt_PVOBJ on this version of perl");
#endif
}
croak("ARGH unhandled repr type");
}
SV *ObjectPad_get_obj_backingav(pTHX_ SV *self, enum ReprType repr, bool create)
{
if(repr == REPR_PVOBJ)
croak("ARGH cannot get_obj_backingav for REPR_PVOBJ because it isn't an AV");
else
return get_obj_fieldstore(self, repr, create);
}
#define embed_cv(cv, embedding) S_embed_cv(aTHX_ cv, embedding)
static CV *S_embed_cv(pTHX_ CV *cv, RoleEmbedding *embedding)
{
assert(cv);
assert(CvOUTSIDE(cv));
/* Perl core's cv_clone() would break in some situation here; see
* https://rt.cpan.org/Ticket/Display.html?id=141483
*/
CV *embedded_cv = cv_copy_flags(cv, 0);
SV *embeddingsv = embedding->embeddingsv;
assert(SvTYPE(embeddingsv) == SVt_PV && SvLEN(embeddingsv) >= sizeof(RoleEmbedding));
PAD *pad1 = PadlistARRAY(CvPADLIST(embedded_cv))[1];
PadARRAY(pad1)[PADIX_EMBEDDING] = SvREFCNT_inc(embeddingsv);
return embedded_cv;
}
RoleEmbedding *ObjectPad__get_embedding_from_pad(pTHX)
{
/* Embedding info is stored in pad1; PAD_SVl() will look at CvDEPTH. We'll
* have to grab it manually */
PAD *pad1 = PadlistARRAY(CvPADLIST(find_runcv(0)))[1];
SV *embeddingsv = PadARRAY(pad1)[PADIX_EMBEDDING];
if(embeddingsv && embeddingsv != &PL_sv_undef)
return MUST_ROLEEMBEDDING(SvPVX(embeddingsv));
else
return NULL;
}
RoleEmbedding **ObjectPad_mop_class_get_direct_roles(pTHX_ const ClassMeta *meta, U32 *nroles)
{
assert(meta->type == METATYPE_CLASS);
AV *roles = meta->cls.direct_roles;
*nroles = av_count(roles);
return (RoleEmbedding **)AvARRAY(roles);
}
RoleEmbedding **ObjectPad_mop_class_get_all_roles(pTHX_ const ClassMeta *meta, U32 *nroles)
{
assert(meta->type == METATYPE_CLASS);
AV *roles = meta->cls.embedded_roles;
*nroles = av_count(roles);
return (RoleEmbedding **)AvARRAY(roles);
}
void ObjectPad__prepare_method_parse(pTHX_ ClassMeta *meta)
{
/* Save the methodscope for this subparse, in case of nested methods
* (RT132321)
*/
SAVESPTR(meta->methodscope);
/* While creating the new scope CV we need to ENTER a block so as not to
* break any interpvars
*/
ENTER;
SAVESPTR(PL_comppad);
SAVESPTR(PL_comppad_name);
SAVESPTR(PL_curpad);
CV *methodscope = meta->methodscope = MUTABLE_CV(newSV_type(SVt_PVCV));
CvPADLIST(methodscope) = pad_new(padnew_SAVE);
PL_comppad = PadlistARRAY(CvPADLIST(methodscope))[1];
PL_comppad_name = PadlistNAMES(CvPADLIST(methodscope));
PL_curpad = AvARRAY(PL_comppad);
/* We can't actually add the fields yet because we don't know if it'll be
* a :common method. Just save the seqnum for what they would be
*/
meta->methodscope_seq = PL_cop_seqmax;
COP_SEQMAX_INC;
LEAVE;
}
void ObjectPad__start_method_parse(pTHX_ ClassMeta *meta, bool is_common)
{
/* Splice in the field scope CV in */
CV *methodscope = meta->methodscope;
if(CvANON(PL_compcv))
CvANON_on(methodscope);
CvOUTSIDE (methodscope) = CvOUTSIDE (PL_compcv);
CvOUTSIDE_SEQ(methodscope) = CvOUTSIDE_SEQ(PL_compcv);
CvOUTSIDE(PL_compcv) = methodscope;
if(!is_common) {
/* instance method */
extend_pad_vars(meta);
intro_my();
ENTER;
SAVESPTR(PL_comppad);
SAVESPTR(PL_comppad_name);
SAVESPTR(PL_curpad);
PL_comppad = PadlistARRAY(CvPADLIST(methodscope))[1];
PL_comppad_name = PadlistNAMES(CvPADLIST(methodscope));
PL_curpad = AvARRAY(PL_comppad);
/* Pretend we saw these variables at an earlier time */
assert(meta->methodscope_seq < CvOUTSIDE_SEQ(PL_compcv));
SAVEI32(PL_cop_seqmax);
PL_cop_seqmax = meta->methodscope_seq;
add_fields_to_pad(meta, 0);
intro_my();
LEAVE;
}
else {
/* :common method */
PADOFFSET padix;
padix = pad_add_name_pvs("$class", 0, NULL, NULL);
if(padix != PADIX_SELF)
croak("ARGH: Expected that padix[$class] = 1");
intro_my();
}
if(meta->type == METATYPE_ROLE) {
PAD *pad1 = PadlistARRAY(CvPADLIST(PL_compcv))[1];
if(meta->role_is_invokable) {
SV *sv = PadARRAY(pad1)[PADIX_EMBEDDING];
SvUPGRADE(sv, SVt_PV);
SvPOK_on(sv);
SvLEN(sv) = 0;
SvPVX(sv) = (void *)&ObjectPad__embedding_standalone;
}
else {
SvREFCNT_dec(PadARRAY(pad1)[PADIX_EMBEDDING]);
/* Unembedded role CVs store the entire class map */
PadARRAY(pad1)[PADIX_EMBEDDING] = SvREFCNT_inc(meta->role.applied_classes);
}
}
}
void ObjectPad__add_fields_to_pad(pTHX_ ClassMeta *meta, U32 since_field)
{
AV *fields = meta->fields;
U32 nfields = av_count(fields);
U32 i;
for(i = since_field; i < nfields; i++) {
FieldMeta *fieldmeta = MUST_FIELDMETA(AvARRAY(fields)[i]);
/* Skip the anonymous ones */
if(SvCUR(fieldmeta->name) < 2)
continue;
/* includes the non-direct ones */
/* Claim these are all STATE variables just to quiet the "will not stay
* shared" warning */
pad_add_name_sv(fieldmeta->name, padadd_STATE, NULL, NULL);
}
}
#define find_padix_for_field(fieldmeta) S_find_padix_for_field(aTHX_ fieldmeta)
static PADOFFSET S_find_padix_for_field(pTHX_ FieldMeta *fieldmeta)
{
const char *fieldname = SvPVX(fieldmeta->name);
#if HAVE_PERL_VERSION(5, 20, 0)
const PADNAMELIST *nl = PadlistNAMES(CvPADLIST(PL_compcv));
PADNAME **names = PadnamelistARRAY(nl);
PADOFFSET padix;
for(padix = 1; padix <= PadnamelistMAXNAMED(nl); padix++) {
PADNAME *name = names[padix];
if(!name || !PadnameLEN(name))
continue;
const char *pv = PadnamePV(name);
if(!pv)
continue;
/* field names are all OUTER vars. This is necessary so we don't get
* confused by signatures params of the same name
* https://rt.cpan.org/Ticket/Display.html?id=134456
*/
if(!PadnameOUTER(name))
continue;
if(!strEQ(pv, fieldname))
continue;
/* TODO: for extra robustness we could compare the SV * in the pad itself */
return padix;
}
return NOT_IN_PAD;
#else
src/class.c view on Meta::CPAN
if(PadnameIsNULL(pn) || !PadnameLEN(pn))
continue;
const char *pv = PadnamePV(pn);
if(!pv || !strEQ(pv, "$self"))
continue;
COP *padcop = NULL;
if(find_cop_for_lvintro(padix, body, &padcop))
PL_curcop = padcop;
warn("\"my\" variable $self masks earlier declaration in same scope");
}
LEAVE;
}
body = prepend_methstart_ops(meta, meta->methodscope, body, false);
}
else if(body && is_common) {
body = prepend_methstart_ops(meta, meta->methodscope, body, true);
}
meta->methodscope = NULL;
/* Restore CvOUTSIDE(PL_compcv) back to where it should be */
{
CV *outside = CvOUTSIDE(PL_compcv);
PADNAMELIST *pnl = PadlistNAMES(CvPADLIST(PL_compcv));
PADNAMELIST *outside_pnl = PadlistNAMES(CvPADLIST(outside));
/* Lexical captures will need their parent pad index fixing
* Technically these only matter for CvANON because they're only used when
* reconstructing the parent pad captures by OP_ANONCODE. But we might as
* well be polite and fix them for all CVs
*/
PADOFFSET padix;
for(padix = 1; padix <= PadnamelistMAX(pnl); padix++) {
PADNAME *pn = PadnamelistARRAY(pnl)[padix];
if(PadnameIsNULL(pn) ||
!PadnameOUTER(pn) ||
!PARENT_PAD_INDEX(pn))
continue;
PADNAME *outside_pn = PadnamelistARRAY(outside_pnl)[PARENT_PAD_INDEX(pn)];
PARENT_PAD_INDEX_set(pn, PARENT_PAD_INDEX(outside_pn));
if(!PadnameOUTER(outside_pn))
PadnameOUTER_off(pn);
}
CvOUTSIDE(PL_compcv) = CvOUTSIDE(outside);
CvOUTSIDE_SEQ(PL_compcv) = CvOUTSIDE_SEQ(outside);
}
return body;
}
void ObjectPad__prepare_adjust_params(pTHX_ ClassMeta *meta)
{
/* Skip the PADIX_EMBEDDING slot if not already done so */
if(meta->type != METATYPE_ROLE)
pad_add_name_pvs("", 0, NULL, NULL);
PADOFFSET params_padix = pad_add_name_pvs("%(params)", 0, NULL, NULL);
assert(params_padix == PADIX_PARAMS);
PERL_UNUSED_VAR(params_padix);
intro_my();
}
void ObjectPad__parse_adjust_params(pTHX_ ClassMeta *meta, AV *params)
{
/* This is a custom parser because XPK won't handle this */
if(lex_peek_unichar(0) != '(')
croak("Expected ADJUST :params signature in parens");
lex_read_unichar(0);
if(!meta->parammap)
meta->parammap = newHV();
HV *parammap = meta->parammap;
bool seen_slurpy = false;
while(1) {
lex_read_space(0);
/* Should now follow a sequence of comma-separated elements; each element is
* :$NAME or
* :$NAME = EXPR
* :$NAME //= EXPR
* :$NAME ||= EXPR
* The final one may also be
* %NAME
*/
char c = lex_peek_unichar(0);
if(c == ')')
break;
if(seen_slurpy)
croak("Cannot have more parameters after the final slurpy one");
if(c == ':') {
lex_read_unichar(0);
lex_read_space(0);
SV *varname = lex_scan_lexvar();
lex_read_space(0);
if(SvPVX(varname)[0] != '$')
croak("Expected a named scalar parameter");
SV *paramname = newSVpvn(SvPVX(varname)+1, SvCUR(varname)-1);
check_colliding_param(meta, paramname);
PADOFFSET padix = pad_add_name_sv(varname, 0, NULL, NULL);
ParamMeta *parammeta;
Newx(parammeta, 1, struct ParamMeta);
src/class.c view on Meta::CPAN
if(!meta->buildcvs)
meta->buildcvs = newAV();
av_push(meta->buildcvs, (SV *)cv);
}
void ObjectPad_mop_class_add_ADJUST(pTHX_ ClassMeta *meta, CV *cv)
{
if(!meta->begun)
croak("Cannot add a new ADJUST phaser to a class that is not yet begun");
if(meta->sealed)
croak("Cannot add an ADJUST(PARAMS) phaser to an already-sealed class");
warn_outofblock_ops(CvROOT(cv), "Using %s to leave an ADJUST phaser is discouraged and will be removed in a later version");
if(!meta->adjustcvs)
meta->adjustcvs = newAV();
meta->has_adjust = true;
av_push(meta->adjustcvs, (SV *)cv);
}
void ObjectPad_mop_class_add_APPLY(pTHX_ ClassMeta *meta, CV *cv)
{
if(meta->type != METATYPE_ROLE)
croak("Can only add a new APPLY phaser to a role");
if(!meta->begun)
croak("Cannot add a new APPLY phaser to a role that is not yet begun");
if(meta->sealed)
croak("Cannot add an APPLY phaser to an already-sealed role");
if(!meta->role.applycvs)
meta->role.applycvs = newAV();
av_push(meta->role.applycvs, (SV *)cv);
}
void ObjectPad_mop_class_add_required_method(pTHX_ ClassMeta *meta, SV *methodname)
{
if(!meta->abstract)
croak("Can only add a required method to a role or abstract class");
if(!meta->begun)
croak("Cannot add a new required method to a class that is not yet begun");
if(meta->sealed)
croak("Cannot add a new required method to an already-sealed class");
av_push(meta->requiremethods, SvREFCNT_inc(methodname));
}
#define mop_class_implements_role(meta, rolemeta) S_mop_class_implements_role(aTHX_ meta, rolemeta)
static bool S_mop_class_implements_role(pTHX_ ClassMeta *meta, ClassMeta *rolemeta)
{
U32 i, n;
switch(meta->type) {
case METATYPE_CLASS: {
RoleEmbedding **embeddings = mop_class_get_all_roles(meta, &n);
for(i = 0; i < n; i++)
if(MUST_ROLEEMBEDDING(embeddings[i])->rolemeta == rolemeta)
return true;
break;
}
case METATYPE_ROLE: {
ClassMeta **roles = (ClassMeta **)AvARRAY(meta->role.superroles);
U32 n = av_count(meta->role.superroles);
/* TODO: this isn't super-efficient in deep cross-linked heirarchies */
for(i = 0; i < n; i++) {
if(MUST_CLASSMETA(roles[i]) == rolemeta)
return true;
if(mop_class_implements_role(roles[i], rolemeta))
return true;
}
break;
}
}
return false;
}
#define copy_requiremethods_from(dst, src) S_copy_requiremethods_from(aTHX_ dst, src)
static void S_copy_requiremethods_from(pTHX_ ClassMeta *dst, ClassMeta *src)
{
U32 nmethods = av_count(src->requiremethods);
for(U32 i = 0; i < nmethods; i++) {
av_push(dst->requiremethods, SvREFCNT_inc(AvARRAY(src->requiremethods)[i]));
}
}
#define embed_role(class, role) S_embed_role(aTHX_ class, role)
static RoleEmbedding *S_embed_role(pTHX_ ClassMeta *classmeta, ClassMeta *rolemeta)
{
U32 i;
if(classmeta->type != METATYPE_CLASS)
croak("Can only apply to a class");
if(rolemeta->type != METATYPE_ROLE)
croak("Can only apply a role to a class");
HV *srcstash = rolemeta->stash;
HV *dststash = classmeta->stash;
SV *embeddingsv = newSV(sizeof(RoleEmbedding));
assert(SvTYPE(embeddingsv) == SVt_PV && SvLEN(embeddingsv) >= sizeof(RoleEmbedding));
RoleEmbedding *embedding = (RoleEmbedding *)SvPVX(embeddingsv);
*embedding = (RoleEmbedding){
LINNET_INIT(LINNET_VAL_ROLEEMBEDDING)
.embeddingsv = embeddingsv,
.rolemeta = rolemeta,
.classmeta = classmeta,
.offset = -1,
};
av_push(classmeta->cls.embedded_roles, (SV *)embedding);
hv_store_ent(rolemeta->role.applied_classes, classmeta->name, (SV *)embedding, 0);
U32 nbuilds = rolemeta->buildcvs ? av_count(rolemeta->buildcvs) : 0;
for(i = 0; i < nbuilds; i++) {
CV *buildcv = (CV *)AvARRAY(rolemeta->buildcvs)[i];
CV *embedded_buildcv = embed_cv(buildcv, embedding);
if(!classmeta->buildcvs)
classmeta->buildcvs = newAV();
av_push(classmeta->buildcvs, (SV *)embedded_buildcv);
}
U32 nadjusts = rolemeta->adjustcvs ? av_count(rolemeta->adjustcvs) : 0;
for(i = 0; i < nadjusts; i++) {
CV *cv = (CV *)AvARRAY(rolemeta->adjustcvs)[i];
CV *embedded_cv = embed_cv(cv, embedding);
mop_class_add_ADJUST(classmeta, embedded_cv);
}
if(rolemeta->has_adjust)
classmeta->has_adjust = true;
U32 nmethods = av_count(rolemeta->direct_methods);
for(i = 0; i < nmethods; i++) {
MethodMeta *methodmeta = MUST_METHODMETA(AvARRAY(rolemeta->direct_methods)[i]);
SV *mname = methodmeta->name;
HE *he = hv_fetch_ent(srcstash, mname, 0, 0);
SV *heval = he ? HeVAL(he) : NULL;
CV *cv =
!heval ? NULL :
/* perl since 5.41.9 might store RV to CV directly in the stash */
SvROK(heval) && SvTYPE(SvRV(heval)) == SVt_PVCV ? (CV *)SvRV(heval) :
SvTYPE(heval) == SVt_PVGV ? GvCV(heval) :
NULL;
if(!cv)
croak("ARGH expected to find CODE called %" SVf " in package %" SVf,
SVfARG(mname), SVfARG(rolemeta->name));
{
MethodMeta *dstmethodmeta = mop_class_add_method(classmeta, mname);
dstmethodmeta->role = rolemeta;
dstmethodmeta->is_common = methodmeta->is_common;
}
GV **gvp = (GV **)hv_fetch(dststash, SvPVX(mname), SvCUR(mname), GV_ADD);
gv_init_sv(*gvp, dststash, mname, 0);
GvMULTI_on(*gvp);
src/class.c view on Meta::CPAN
if(!classmeta->fieldhooks_makefield)
classmeta->fieldhooks_makefield = newAV();
U32 i;
for(i = 0; i < av_count(rolemeta->fieldhooks_makefield); i++) {
struct FieldHook *roleh = (struct FieldHook *)AvARRAY(rolemeta->fieldhooks_makefield)[i];
av_push(classmeta->fieldhooks_makefield, (SV *)embed_fieldhook(roleh, embedding->offset));
}
}
if(rolemeta->fieldhooks_construct) {
if(!classmeta->fieldhooks_construct)
classmeta->fieldhooks_construct = newAV();
U32 i;
for(i = 0; i < av_count(rolemeta->fieldhooks_construct); i++) {
struct FieldHook *roleh = (struct FieldHook *)AvARRAY(rolemeta->fieldhooks_construct)[i];
av_push(classmeta->fieldhooks_construct, (SV *)embed_fieldhook(roleh, embedding->offset));
}
}
classmeta->next_fieldix += rolemeta->next_fieldix;
if(rolemeta->role.applycvs) {
/* TODO: if APPLY phasers exist they should *replace* the built-in behaviour */
dSP;
AV *applycvs = rolemeta->role.applycvs;
SV *classmop = sv_newmortal();
sv_setref_uv(classmop, "Object::Pad::MOP::Class", PTR2UV(classmeta));
int i;
for(i = 0; i < av_count(applycvs); i++) {
CV *applycv = (CV *)AvARRAY(applycvs)[i];
ENTER;
SAVETMPS;
SPAGAIN;
EXTEND(SP, 1);
PUSHMARK(SP);
PUSHs(sv_mortalcopy(classmop));
PUTBACK;
assert(applycv);
call_sv((SV *)applycv, G_VOID);
FREETMPS;
LEAVE;
}
}
}
static void S_apply_roles(pTHX_ ClassMeta *dstmeta, ClassMeta *srcmeta)
{
U32 nroles;
RoleEmbedding **arr = mop_class_get_direct_roles(srcmeta, &nroles);
U32 i;
for(i = 0; i < nroles; i++) {
mop_class_apply_role(MUST_ROLEEMBEDDING(arr[i]));
}
}
void ObjectPad__check_colliding_param(pTHX_ ClassMeta *classmeta, SV *paramname)
{
HV *parammap = classmeta->parammap;
assert(parammap);
HE *he = hv_fetch_ent(parammap, paramname, 0, 0);
if(!he)
return;
ParamMeta *colliding_parammeta = MUST_PARAMMETA(HeVAL(he));
ClassMeta *origclassmeta = colliding_parammeta->class;
if(origclassmeta != classmeta)
croak("Already have a named constructor parameter called '%" SVf "' inherited from %" SVf,
SVfARG(paramname), SVfARG(origclassmeta->name));
else
croak("Already have a named constructor parameter called '%" SVf "'", SVfARG(paramname));
}
static OP *pp_alias_params(pTHX)
{
dSP;
PADOFFSET padix = PADIX_PARAMS;
SV *params = POPs;
if(SvTYPE(params) != SVt_PVHV)
RETURN;
SAVESPTR(PAD_SVl(padix));
PAD_SVl(padix) = SvREFCNT_inc(params);
save_freesv(params);
RETURN;
}
static void S_generate_initfields_method(pTHX_ ClassMeta *meta)
{
int i;
ENTER;
need_PLparser();
I32 floor_ix = PL_savestack_ix;
{
SAVEI32(PL_subline);
save_item(PL_subname);
resume_compcv(&meta->initfields_compcv);
}
SAVEFREESV(PL_compcv);
I32 save_ix = block_start(TRUE);
#ifdef DEBUG_OVERRIDE_PLCURCOP
SAVESPTR(PL_curcop);
PL_curcop = meta->tmpcop;
CopLINE_set(PL_curcop, __LINE__);
#endif
OP *ops = NULL;
ops = op_append_list(OP_LINESEQ, ops,
newSTATEOP(0, NULL, NULL));
/* A more optimised implementation of this method would be able to generate
* a @self lexical and OP_REFASSIGN it, but that would only work on newer
* perls. For now we'll take the small performance hit of RV2AV every time
*/
ops = op_append_list(OP_LINESEQ, ops,
newUNOP_CUSTOM(&pp_alias_params, 0,
newOP(OP_SHIFT, OPf_SPECIAL)));
/* TODO: Icky horrible implementation; if our fieldoffset > 0 then
* we must be a subclass
*/
if(meta->start_fieldix) {
struct ClassMeta *supermeta = meta->cls.supermeta;
assert(supermeta->sealed);
assert(supermeta->initfields);
DEBUG_SET_CURCOP_LINE(__LINE__);
ops = op_append_list(OP_LINESEQ, ops,
newSTATEOP(0, NULL, NULL));
ops = op_append_list(OP_LINESEQ, ops,
/* Build an OP_ENTERSUB for supermeta's initfields */
newLISTOPn(OP_ENTERSUB, OPf_WANT_VOID|OPf_STACKED,
newPADxVOP(OP_PADSV, 0, PADIX_SELF),
newPADxVOP(OP_PADHV, OPf_REF, PADIX_PARAMS),
newSVOP(OP_CONST, 0, (SV *)supermeta->initfields),
NULL));
}
if(meta->initfields_lines) {
ops = op_append_list(OP_LINESEQ, ops,
meta->initfields_lines);
}
if(meta->type == METATYPE_CLASS) {
U32 nroles;
RoleEmbedding **embeddings = mop_class_get_direct_roles(meta, &nroles);
for(i = 0; i < nroles; i++) {
RoleEmbedding *embedding = MUST_ROLEEMBEDDING(embeddings[i]);
ClassMeta *rolemeta = embedding->rolemeta;
if(!rolemeta->sealed)
mop_class_seal(rolemeta);
assert(rolemeta->sealed);
assert(rolemeta->initfields);
DEBUG_SET_CURCOP_LINE(__LINE__);
ops = op_append_list(OP_LINESEQ, ops,
newSTATEOP(0, NULL, NULL));
ops = op_append_list(OP_LINESEQ, ops,
newLISTOPn(OP_ENTERSUB, OPf_WANT_VOID|OPf_STACKED,
newPADxVOP(OP_PADSV, 0, PADIX_SELF),
newPADxVOP(OP_PADHV, OPf_REF, PADIX_PARAMS),
newSVOP(OP_CONST, 0, (SV *)embed_cv(rolemeta->initfields, embedding)),
NULL));
}
}
/* TODO: This will create a method start op that appears to capture every
* field except the final one. There's not a lot we can do about this
* without duplicating a lot of the `methodscope` structure for initfields,
* except more complex due to the multiple suspend/resume nature of parsing
* it.
*/
ops = prepend_methstart_ops(meta, NULL, ops, false);
SvREFCNT_inc(PL_compcv);
ops = block_end(save_ix, ops);
/* newATTRSUB will capture PL_curstash */
SAVESPTR(PL_curstash);
PL_curstash = meta->stash;
meta->initfields = newATTRSUB(floor_ix, NULL, NULL, NULL, ops);
assert(meta->initfields);
assert(CvOUTSIDE(meta->initfields));
LEAVE;
}
void ObjectPad_mop_class_seal(pTHX_ ClassMeta *meta)
{
if(!meta->begun)
mop_class_begin(meta);
if(meta->sealed) /* idempotent */
return;
MOP_CLASS_RUN_HOOKS_NOARGS(meta, pre_seal);
if(meta->type == METATYPE_CLASS &&
meta->cls.supermeta && !meta->cls.supermeta->sealed) {
/* Must defer sealing until superclass is sealed first
* (RT133190)
*/
ClassMeta *supermeta = meta->cls.supermeta;
src/class.c view on Meta::CPAN
#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);
PUSHs(self);
PUSHs(wantrole);
PUTBACK;
int count = call_sv((SV*)cv_does, G_SCALAR);
SPAGAIN;
bool ret = false;
if (count)
ret = POPi;
FREETMPS;
LEAVE;
if(ret)
XSRETURN_YES;
}
else {
/* We need to also respond to Object::Pad::UNIVERSAL and UNIVERSAL */
if(sv_derived_from_sv(self, wantrole, 0))
XSRETURN_YES;
}
XSRETURN_NO;
}
static OP *pp_croak_from_constructor(pTHX)
{
dSP;
/* Walk up the caller stack to find the COP of the first caller; i.e. the
* first one that wasn't in src/class.c
*/
I32 count = 0;
const PERL_CONTEXT *cx;
while((cx = caller_cx(count, NULL))) {
const char *copfile = CopFILE(cx->blk_oldcop);
if(!copfile|| strNE(copfile, "src/class.c")) {
PL_curcop = cx->blk_oldcop;
break;
}
src/class.c view on Meta::CPAN
if(supermeta->buildcvs) {
if(!meta->buildcvs)
meta->buildcvs = newAV();
av_push_from_av_noinc(meta->buildcvs, supermeta->buildcvs);
}
if(supermeta->adjustcvs) {
if(!meta->adjustcvs)
meta->adjustcvs = newAV();
av_push_from_av_noinc(meta->adjustcvs, supermeta->adjustcvs);
}
if(supermeta->fieldhooks_makefield) {
if(!meta->fieldhooks_makefield)
meta->fieldhooks_makefield = newAV();
av_push_from_av_noinc(meta->fieldhooks_makefield, supermeta->fieldhooks_makefield);
}
if(supermeta->fieldhooks_construct) {
if(!meta->fieldhooks_construct)
meta->fieldhooks_construct = newAV();
av_push_from_av_noinc(meta->fieldhooks_construct, supermeta->fieldhooks_construct);
}
if(supermeta->parammap) {
HV *old = supermeta->parammap;
HV *new = meta->parammap = newHV();
hv_iterinit(old);
HE *iter;
while((iter = hv_iternext(old))) {
STRLEN klen = HeKLEN(iter);
/* Don't SvREFCNT_inc() the values because they aren't really SV *s */
/* Subclasses *DIRECTLY SHARE* their param metas because the
* information in them is directly compatible
*/
if(klen < 0)
hv_store_ent(new, HeSVKEY(iter), HeVAL(iter), HeHASH(iter));
else
hv_store(new, HeKEY(iter), klen, HeVAL(iter), HeHASH(iter));
}
}
if(supermeta->abstract)
copy_requiremethods_from(meta, supermeta);
if(supermeta->has_adjust)
meta->has_adjust = true;
U32 nroles;
RoleEmbedding **embeddings = mop_class_get_all_roles(supermeta, &nroles);
if(nroles) {
U32 i;
for(i = 0; i < nroles; i++) {
RoleEmbedding *embedding = MUST_ROLEEMBEDDING(embeddings[i]);
ClassMeta *rolemeta = embedding->rolemeta;
av_push(meta->cls.embedded_roles, (SV *)embedding);
hv_store_ent(rolemeta->role.applied_classes, meta->name, (SV *)embedding, 0);
}
}
}
else {
/* A subclass of a foreign class */
meta->cls.foreign_new = fetch_superclass_method_pv(meta->stash, "new", 3, -1);
if(!meta->cls.foreign_new)
croak("Unable to find SUPER::new for %" SVf, superclassname);
meta->cls.foreign_does = fetch_superclass_method_pv(meta->stash, "DOES", 4, -1);
}
meta->has_superclass = true;
meta->cls.supermeta = supermeta;
}
void ObjectPad_mop_class_load_and_set_superclass(pTHX_ ClassMeta *class, SV *supername, SV *superver)
{
if(class->type != METATYPE_CLASS)
croak("Only a class may extend another");
HV *superstash = gv_stashsv(supername, 0);
if(!superstash || !hv_fetchs(superstash, "new", 0)) {
/* Try to `require` the module then attempt a second time */
/* load_module() will modify the name argument and take ownership of it */
load_module(PERL_LOADMOD_NOIMPORT, newSVsv(supername), NULL, NULL);
superstash = gv_stashsv(supername, 0);
}
if(!superstash)
croak("Superclass %" SVf " does not exist", supername);
if(superver && SvOK(superver))
ensure_module_version(supername, superver);
mop_class_set_superclass(class, supername);
}
void ObjectPad_mop_class_inherit_from_superclass(pTHX_ ClassMeta *meta, SV **args, size_t nargs)
{
if(!meta->begun)
croak("Cannot inherit into a class that is not yet begun");
if(meta->sealed)
croak("Cannot inherit into an already-sealed class");
ClassMeta *supermeta = meta->cls.supermeta;
if(meta->type != METATYPE_CLASS || !supermeta)
croak("Cannot inherit into a non-class or from a non-Object::Pad-based superclass");
for(int i = 0; i < nargs; i++) {
SV *arg = args[i];
if(SvPVX(arg)[0] == '$') {
/* A field name */
FieldMeta *superfield = mop_class_find_field(supermeta, arg, FIND_FIELD_ONLY_INHERITABLE);
if(!superfield)
( run in 0.807 second using v1.01-cache-2.11-cpan-71847e10f99 )