Skip to content

Commit ec78f9b

Browse files
committed
class.c: Less cheating when creating accessor method CVs
The prior code manually constructed the `OP_METHSTART` op itself, filling in the field binding operations itself and using specially-constructed pad entries to contain fake copies of the field variables. While this technically worked, it will break upcoming code changes, as well as just being a weird special-case snowflake. The new code imports the real field padname into the compiling pad in a manner much closer to the way real code would, and also sets the `CvIsMETHOD` flag on `PL_compcv`, so that the `OP_METHSTART` op is generated implicitly by `newATTRSUB()` in the usual way. This avoids keeping two copies of special-case code here in `class.c`.
1 parent 2d8768c commit ec78f9b

File tree

1 file changed

+24
-40
lines changed

1 file changed

+24
-40
lines changed

class.c

Lines changed: 24 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -1031,6 +1031,26 @@ Perl_class_add_field(pTHX_ HV *stash, PADNAME *pn)
10311031
PadnameREFCNT_inc(pn);
10321032
}
10331033

1034+
/* Adds a pad entry to PL_compcv to make the given field visible. This works
1035+
* even before the field has been properly `intro_my()`'ed and is thus usable
1036+
* during attributes declared on the same newly-field.
1037+
*/
1038+
1039+
#define pad_import_field(fieldpn) S_pad_import_field(aTHX_ fieldpn)
1040+
static PADOFFSET
1041+
S_pad_import_field(pTHX_ PADNAME *fieldpn)
1042+
{
1043+
assert(PadnameIsFIELD(fieldpn));
1044+
1045+
/* We can't just pad_findmy_pvn() because the actual field may not have been
1046+
* intro_my()'ed yet */
1047+
PADNAME *name = newPADNAMEouter(fieldpn);
1048+
PADOFFSET padix = pad_alloc(OP_PADSV, SVs_PADMY);
1049+
padnamelist_store(PL_comppad_name, padix, name);
1050+
1051+
return padix;
1052+
}
1053+
10341054
static void
10351055
apply_field_attribute_param(pTHX_ PADNAME *pn, SV *value)
10361056
{
@@ -1073,10 +1093,9 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
10731093
if(!valid_identifier_sv(value))
10741094
croak("%" SVf_QUOTEDPREFIX " is not a valid name for a generated method", value);
10751095

1076-
PADOFFSET fieldix = PadnameFIELDINFO(pn)->fieldix;
1077-
10781096
I32 floor_ix = start_subparse(FALSE, 0);
10791097
SAVEFREESV(PL_compcv);
1098+
CvIsMETHOD_on(PL_compcv);
10801099

10811100
I32 save_ix = block_start(TRUE);
10821101

@@ -1085,25 +1104,9 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
10851104
padix = pad_add_name_pvs("$self", 0, NULL, NULL);
10861105
assert(padix == PADIX_SELF);
10871106

1088-
padix = pad_add_name_pvn(PadnamePV(pn), PadnameLEN(pn), 0, NULL, NULL);
1107+
padix = pad_import_field(pn);
10891108
intro_my();
10901109

1091-
OP *methstartop;
1092-
{
1093-
UNOP_AUX_item *aux;
1094-
aux = (UNOP_AUX_item *)PerlMemShared_malloc(
1095-
sizeof(UNOP_AUX_item) * (2 + 2));
1096-
1097-
UNOP_AUX_item *ap = aux;
1098-
(ap++)->uv = 1; /* fieldcount */
1099-
(ap++)->uv = fieldix; /* max_fieldix */
1100-
1101-
(ap++)->uv = padix;
1102-
(ap++)->uv = fieldix;
1103-
1104-
methstartop = newUNOP_AUX(OP_METHSTART, 0, NULL, aux);
1105-
}
1106-
11071110
OP *argcheckop;
11081111
{
11091112
struct op_argcheck_aux *aux = (struct op_argcheck_aux *)
@@ -1132,7 +1135,6 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
11321135
}
11331136

11341137
OP *ops = newLISTOPn(OP_LINESEQ, 0,
1135-
methstartop,
11361138
argcheckop,
11371139
retop,
11381140
NULL);
@@ -1178,10 +1180,9 @@ apply_field_attribute_writer(pTHX_ PADNAME *pn, SV *value)
11781180
if(!valid_identifier_sv(value))
11791181
croak("%" SVf_QUOTEDPREFIX " is not a valid name for a generated method", value);
11801182

1181-
PADOFFSET fieldix = PadnameFIELDINFO(pn)->fieldix;
1182-
11831183
I32 floor_ix = start_subparse(FALSE, 0);
11841184
SAVEFREESV(PL_compcv);
1185+
CvIsMETHOD_on(PL_compcv);
11851186

11861187
I32 save_ix = block_start(TRUE);
11871188

@@ -1190,25 +1191,9 @@ apply_field_attribute_writer(pTHX_ PADNAME *pn, SV *value)
11901191
padix = pad_add_name_pvs("$self", 0, NULL, NULL);
11911192
assert(padix == PADIX_SELF);
11921193

1193-
padix = pad_add_name_pvn(PadnamePV(pn), PadnameLEN(pn), 0, NULL, NULL);
1194+
padix = pad_import_field(pn);
11941195
intro_my();
11951196

1196-
OP *methstartop;
1197-
{
1198-
UNOP_AUX_item *aux;
1199-
aux = (UNOP_AUX_item *)PerlMemShared_malloc(
1200-
sizeof(UNOP_AUX_item) * (2 + 2));
1201-
1202-
UNOP_AUX_item *ap = aux;
1203-
(ap++)->uv = 1; /* fieldcount */
1204-
(ap++)->uv = fieldix; /* max_fieldix */
1205-
1206-
(ap++)->uv = padix;
1207-
(ap++)->uv = fieldix;
1208-
1209-
methstartop = newUNOP_AUX(OP_METHSTART, 0, NULL, aux);
1210-
}
1211-
12121197
OP *argcheckop;
12131198
{
12141199
struct op_argcheck_aux *aux = (struct op_argcheck_aux *)
@@ -1230,7 +1215,6 @@ apply_field_attribute_writer(pTHX_ PADNAME *pn, SV *value)
12301215
newPADxVOP(OP_PADSV, 0, PADIX_SELF));
12311216

12321217
OP *ops = newLISTOPn(OP_LINESEQ, 0,
1233-
methstartop,
12341218
argcheckop,
12351219
assignop,
12361220
retop,

0 commit comments

Comments
 (0)