line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
/* vi: set ft=c : */ |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
#include "EXTERN.h" |
4
|
|
|
|
|
|
|
#include "perl.h" |
5
|
|
|
|
|
|
|
#include "XSUB.h" |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
#define HAVE_PERL_VERSION(R, V, S) \ |
8
|
|
|
|
|
|
|
(PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
#include "XSParseSublike.h" |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
/* Skip this entire file on perls older than OP_ARGCHECK */ |
13
|
|
|
|
|
|
|
#if HAVE_PERL_VERSION(5, 26, 0) |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
#define PERL_EXT |
16
|
|
|
|
|
|
|
/* We need to be able to see FEATURE_*_IS_ENABLED */ |
17
|
|
|
|
|
|
|
#include "feature.h" |
18
|
|
|
|
|
|
|
/* Also need KEY_sigvar */ |
19
|
|
|
|
|
|
|
#include "keywords.h" |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
#include "make_argcheck_aux.c.inc" |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
#include "LOGOP_ANY.c.inc" |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
#include "parse_subsignature_ex.h" |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
#include "lexer-additions.c.inc" |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
#include "newSV_with_free.c.inc" |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
#define newSVpvx(ptr) S_newSVpvx(aTHX_ ptr) |
32
|
|
|
|
|
|
|
static SV *S_newSVpvx(pTHX_ void *ptr) |
33
|
|
|
|
|
|
|
{ |
34
|
11
|
|
|
|
|
|
SV *sv = newSV(0); |
35
|
11
|
|
|
|
|
|
sv_upgrade(sv, SVt_PV); |
36
|
11
|
|
|
|
|
|
SvPVX(sv) = ptr; |
37
|
|
|
|
|
|
|
return sv; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
/* |
41
|
|
|
|
|
|
|
* Need to grab some things that aren't quite core perl API |
42
|
|
|
|
|
|
|
*/ |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
/* yyerror() is a long function and hard to emulate or copy-paste for our |
45
|
|
|
|
|
|
|
* purposes; we'll reïmplement a smaller version of it |
46
|
|
|
|
|
|
|
*/ |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
#define LEX_IGNORE_UTF8_HINTS 0x00000002 |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
#define PL_linestr (PL_parser->linestr) |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
#ifdef USE_UTF8_SCRIPTS |
53
|
|
|
|
|
|
|
# define UTF cBOOL(!IN_BYTES) |
54
|
|
|
|
|
|
|
#else |
55
|
|
|
|
|
|
|
# define UTF cBOOL((PL_linestr && DO_UTF8(PL_linestr)) || ( !(PL_parser->lex_flags & LEX_IGNORE_UTF8_HINTS) && (PL_hints & HINT_UTF8))) |
56
|
|
|
|
|
|
|
#endif |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
#define yyerror(s) S_yyerror(aTHX_ s) |
59
|
0
|
|
|
|
|
|
void S_yyerror(pTHX_ const char *s) |
60
|
|
|
|
|
|
|
{ |
61
|
0
|
|
|
|
|
|
SV *message = sv_2mortal(newSVpvs_flags("", 0)); |
62
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
|
char *context = PL_parser->oldbufptr; |
64
|
0
|
|
|
|
|
|
STRLEN contlen = PL_parser->bufptr - PL_parser->oldbufptr; |
65
|
|
|
|
|
|
|
|
66
|
0
|
0
|
|
|
|
|
sv_catpvf(message, "%s at %s line %" IVdf, |
67
|
0
|
|
|
|
|
|
s, OutCopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); |
68
|
|
|
|
|
|
|
|
69
|
0
|
0
|
|
|
|
|
if(context) |
70
|
0
|
0
|
|
|
|
|
sv_catpvf(message, ", near \"%" UTF8f "\"", |
|
|
0
|
|
|
|
|
|
71
|
0
|
0
|
|
|
|
|
UTF8fARG(UTF, contlen, context)); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
|
sv_catpvf(message, "\n"); |
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
|
|
|
PL_parser->error_count++; |
76
|
0
|
|
|
|
|
|
warn_sv(message); |
77
|
0
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
/* Stolen from op.c */ |
80
|
|
|
|
|
|
|
#ifndef OpTYPE_set |
81
|
|
|
|
|
|
|
# define OpTYPE_set(op, type) \ |
82
|
|
|
|
|
|
|
STMT_START { \ |
83
|
|
|
|
|
|
|
op->op_type = (OPCODE)type; \ |
84
|
|
|
|
|
|
|
op->op_ppaddr = PL_ppaddr[type]; \ |
85
|
|
|
|
|
|
|
} STMT_END |
86
|
|
|
|
|
|
|
#endif |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
#define alloc_LOGOP(a,b,c) S_alloc_LOGOP(aTHX_ a,b,c) |
89
|
1
|
|
|
|
|
|
static LOGOP *S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other) |
90
|
|
|
|
|
|
|
{ |
91
|
|
|
|
|
|
|
dVAR; |
92
|
|
|
|
|
|
|
LOGOP *logop; |
93
|
|
|
|
|
|
|
OP *kid = first; |
94
|
1
|
|
|
|
|
|
NewOp(1101, logop, 1, LOGOP); |
95
|
1
|
|
|
|
|
|
OpTYPE_set(logop, type); |
96
|
1
|
|
|
|
|
|
logop->op_first = first; |
97
|
1
|
|
|
|
|
|
logop->op_other = other; |
98
|
1
|
50
|
|
|
|
|
if (first) |
99
|
1
|
|
|
|
|
|
logop->op_flags = OPf_KIDS; |
100
|
1
|
50
|
|
|
|
|
while (kid && OpHAS_SIBLING(kid)) |
|
|
50
|
|
|
|
|
|
101
|
1
|
0
|
|
|
|
|
kid = OpSIBLING(kid); |
102
|
1
|
50
|
|
|
|
|
if (kid) |
103
|
1
|
|
|
|
|
|
OpLASTSIB_set(kid, (OP*)logop); |
104
|
1
|
|
|
|
|
|
return logop; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
/* copypaste from core's pp.c */ |
108
|
|
|
|
|
|
|
static SV * |
109
|
2
|
|
|
|
|
|
S_find_runcv_name(pTHX) |
110
|
|
|
|
|
|
|
{ |
111
|
|
|
|
|
|
|
CV *cv; |
112
|
|
|
|
|
|
|
GV *gv; |
113
|
|
|
|
|
|
|
SV *sv; |
114
|
|
|
|
|
|
|
|
115
|
2
|
|
|
|
|
|
cv = find_runcv(0); |
116
|
2
|
50
|
|
|
|
|
if (!cv) |
117
|
|
|
|
|
|
|
return &PL_sv_no; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
gv = CvGV(cv); |
120
|
2
|
50
|
|
|
|
|
if (!gv) |
121
|
|
|
|
|
|
|
return &PL_sv_no; |
122
|
|
|
|
|
|
|
|
123
|
2
|
|
|
|
|
|
sv = sv_newmortal(); |
124
|
2
|
|
|
|
|
|
gv_fullname4(sv, gv, NULL, TRUE); |
125
|
2
|
|
|
|
|
|
return sv; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
15
|
|
|
|
|
|
static OP *pp_namedargdefelem(pTHX) |
129
|
|
|
|
|
|
|
{ |
130
|
15
|
|
|
|
|
|
dSP; |
131
|
15
|
|
|
|
|
|
ANY *op_any = cLOGOP_ANY->op_any; |
132
|
15
|
|
|
|
|
|
SV *keysv = op_any[0].any_sv; |
133
|
15
|
|
|
|
|
|
HV *slurpy_hv = (HV *)PAD_SVl(op_any[1].any_iv); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
assert(slurpy_hv && SvTYPE(slurpy_hv) == SVt_PVHV); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
/* TODO: we could precompute the hash and store it in the ANY vector */ |
138
|
15
|
|
|
|
|
|
SV *value = hv_delete_ent(slurpy_hv, keysv, 0, 0); |
139
|
|
|
|
|
|
|
|
140
|
15
|
100
|
|
|
|
|
if(value) { |
141
|
12
|
50
|
|
|
|
|
EXTEND(SP, 1); |
142
|
12
|
|
|
|
|
|
PUSHs(value); |
143
|
12
|
|
|
|
|
|
RETURN; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
3
|
100
|
|
|
|
|
if(cLOGOP->op_other) |
147
|
|
|
|
|
|
|
return cLOGOP->op_other; |
148
|
|
|
|
|
|
|
|
149
|
1
|
|
|
|
|
|
croak("Missing argument '%" SVf "' for subroutine %" SVf, |
150
|
1
|
|
|
|
|
|
SVfARG(keysv), SVfARG(S_find_runcv_name(aTHX))); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
7
|
|
|
|
|
|
static OP *pp_checknomorenamed(pTHX) |
154
|
|
|
|
|
|
|
{ |
155
|
7
|
|
|
|
|
|
HV *slurpy_hv = (HV *)PAD_SVl(PL_op->op_targ); |
156
|
|
|
|
|
|
|
|
157
|
7
|
100
|
|
|
|
|
if(!hv_iterinit(slurpy_hv)) |
158
|
6
|
|
|
|
|
|
return NORMAL; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
/* There are remaining named arguments; concat their names into a message */ |
161
|
|
|
|
|
|
|
|
162
|
1
|
|
|
|
|
|
HE *he = hv_iternext(slurpy_hv); |
163
|
|
|
|
|
|
|
|
164
|
1
|
|
|
|
|
|
SV *keynames = newSVpvn("", 0); |
165
|
1
|
|
|
|
|
|
SAVEFREESV(keynames); |
166
|
|
|
|
|
|
|
|
167
|
1
|
50
|
|
|
|
|
sv_catpvf(keynames, "'%" SVf "'", SVfARG(HeSVKEY_force(he))); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
IV nkeys = 1; |
170
|
|
|
|
|
|
|
|
171
|
1
|
50
|
|
|
|
|
while((he = hv_iternext(slurpy_hv))) |
172
|
0
|
0
|
|
|
|
|
sv_catpvf(keynames, ", '%" SVf "'", SVfARG(HeSVKEY_force(he))), nkeys++; |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
173
|
|
|
|
|
|
|
|
174
|
1
|
50
|
|
|
|
|
croak("Unrecognised %s %" SVf " for subroutine %" SVf, |
175
|
|
|
|
|
|
|
nkeys > 1 ? "arguments" : "argument", |
176
|
1
|
|
|
|
|
|
SVfARG(keynames), SVfARG(S_find_runcv_name(aTHX))); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
#define OP_IS_NAMED_PARAM(o) (o->op_type == OP_ARGELEM && cUNOPx(o)->op_first && \ |
180
|
|
|
|
|
|
|
cUNOPx(o)->op_first->op_type == OP_CUSTOM && \ |
181
|
|
|
|
|
|
|
cUNOPx(o)->op_first->op_ppaddr == &pp_namedargdefelem) |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
/* Parameter attribute extensions */ |
184
|
|
|
|
|
|
|
typedef struct SignatureAttributeRegistration SignatureAttributeRegistration; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
struct SignatureAttributeRegistration { |
187
|
|
|
|
|
|
|
SignatureAttributeRegistration *next; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
const char *name; |
190
|
|
|
|
|
|
|
STRLEN permit_hintkeylen; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
const struct XPSSignatureAttributeFuncs *funcs; |
193
|
|
|
|
|
|
|
void *funcdata; |
194
|
|
|
|
|
|
|
}; |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
static SignatureAttributeRegistration *sigattrs = NULL; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
#define find_registered_attribute(name) S_find_registered_attribute(aTHX_ name) |
199
|
4
|
|
|
|
|
|
static SignatureAttributeRegistration *S_find_registered_attribute(pTHX_ const char *name) |
200
|
|
|
|
|
|
|
{ |
201
|
4
|
|
|
|
|
|
HV *hints = GvHV(PL_hintgv); |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
SignatureAttributeRegistration *reg; |
204
|
4
|
50
|
|
|
|
|
for(reg = sigattrs; reg; reg = reg->next) { |
205
|
4
|
50
|
|
|
|
|
if(!strEQ(name, reg->name)) |
206
|
0
|
|
|
|
|
|
continue; |
207
|
|
|
|
|
|
|
|
208
|
4
|
50
|
|
|
|
|
if(reg->funcs->permit_hintkey && |
|
|
50
|
|
|
|
|
|
209
|
4
|
50
|
|
|
|
|
(!hints || !hv_fetch(hints, reg->funcs->permit_hintkey, reg->permit_hintkeylen, 0))) |
210
|
0
|
|
|
|
|
|
continue; |
211
|
|
|
|
|
|
|
|
212
|
4
|
|
|
|
|
|
return reg; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
0
|
|
|
|
|
|
croak("Unrecognised signature parameter attribute :%s", name); |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
struct PendingSignatureFunc { |
219
|
|
|
|
|
|
|
const struct XPSSignatureAttributeFuncs *funcs; |
220
|
|
|
|
|
|
|
void *funcdata; |
221
|
|
|
|
|
|
|
void *attrdata; |
222
|
|
|
|
|
|
|
}; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
#define PENDING_FROM_SV(sv) ((struct PendingSignatureFunc *)SvPVX(sv)) |
225
|
|
|
|
|
|
|
|
226
|
0
|
|
|
|
|
|
static void pending_free(pTHX_ SV *sv) |
227
|
|
|
|
|
|
|
{ |
228
|
0
|
|
|
|
|
|
struct PendingSignatureFunc *p = PENDING_FROM_SV(sv); |
229
|
|
|
|
|
|
|
|
230
|
0
|
0
|
|
|
|
|
if(p->funcs->free) |
231
|
0
|
|
|
|
|
|
(*p->funcs->free)(aTHX_ p->attrdata, p->funcdata); |
232
|
0
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
#define NEW_SV_PENDING() newSV_with_free(sizeof(struct PendingSignatureFunc), &pending_free) |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
struct SignatureParsingContext { |
237
|
|
|
|
|
|
|
AV *named_varops; /* SV ptrs to the varop of every named parameter */ |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
OP *last_varop; /* the most recently-constructed varop */ |
240
|
|
|
|
|
|
|
}; |
241
|
|
|
|
|
|
|
|
242
|
21
|
|
|
|
|
|
static void free_parsing_ctx(pTHX_ void *_ctx) |
243
|
|
|
|
|
|
|
{ |
244
|
|
|
|
|
|
|
struct SignatureParsingContext *ctx = _ctx; |
245
|
21
|
100
|
|
|
|
|
if(ctx->named_varops) |
246
|
|
|
|
|
|
|
SvREFCNT_dec((SV *)ctx->named_varops); |
247
|
21
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
#define parse_sigelem(ctx, flags) S_parse_sigelem(aTHX_ ctx, flags) |
250
|
31
|
|
|
|
|
|
static OP *S_parse_sigelem(pTHX_ struct SignatureParsingContext *ctx, U32 flags) |
251
|
|
|
|
|
|
|
{ |
252
|
31
|
|
|
|
|
|
bool permit_attributes = flags & PARSE_SUBSIGNATURE_PARAM_ATTRIBUTES; |
253
|
|
|
|
|
|
|
|
254
|
31
|
|
|
|
|
|
yy_parser *parser = PL_parser; |
255
|
|
|
|
|
|
|
|
256
|
31
|
|
|
|
|
|
int c = lex_peek_unichar(0); |
257
|
|
|
|
|
|
|
int private; |
258
|
31
|
|
|
|
|
|
struct XPSSignatureParamContext paramctx = {}; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
AV *pending = NULL; |
261
|
|
|
|
|
|
|
|
262
|
31
|
100
|
|
|
|
|
if((flags & PARSE_SUBSIGNATURE_NAMED_PARAMS) && c == ':') { |
|
|
100
|
|
|
|
|
|
263
|
11
|
|
|
|
|
|
lex_read_unichar(0); |
264
|
11
|
|
|
|
|
|
lex_read_space(0); |
265
|
|
|
|
|
|
|
|
266
|
11
|
|
|
|
|
|
paramctx.is_named = true; |
267
|
11
|
|
|
|
|
|
c = lex_peek_unichar(0); |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
31
|
|
|
|
|
|
switch(c) { |
271
|
|
|
|
|
|
|
case '$': private = OPpARGELEM_SV; break; |
272
|
2
|
|
|
|
|
|
case '@': private = OPpARGELEM_AV; break; |
273
|
2
|
|
|
|
|
|
case '%': private = OPpARGELEM_HV; break; |
274
|
|
|
|
|
|
|
default: |
275
|
0
|
|
|
|
|
|
croak("Expected a signature element at <%s>\n", parser->bufptr); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
|
278
|
31
|
|
|
|
|
|
char *lexname = parser->bufptr; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
/* Consume sigil */ |
281
|
31
|
|
|
|
|
|
lex_read_unichar(0); |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
char *lexname_end; |
284
|
|
|
|
|
|
|
|
285
|
31
|
50
|
|
|
|
|
if(isIDFIRST_uni(lex_peek_unichar(0))) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
286
|
30
|
|
|
|
|
|
lex_read_unichar(0); |
287
|
46
|
50
|
|
|
|
|
while(isALNUM_uni(lex_peek_unichar(0))) |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
288
|
16
|
|
|
|
|
|
lex_read_unichar(0); |
289
|
|
|
|
|
|
|
|
290
|
30
|
|
|
|
|
|
paramctx.varop = newUNOP_AUX(OP_ARGELEM, 0, NULL, INT2PTR(UNOP_AUX_item *, (parser->sig_elems))); |
291
|
30
|
|
|
|
|
|
paramctx.varop->op_private |= private; |
292
|
|
|
|
|
|
|
|
293
|
30
|
100
|
|
|
|
|
if(paramctx.is_named) { |
294
|
11
|
100
|
|
|
|
|
if(!ctx->named_varops) |
295
|
8
|
|
|
|
|
|
ctx->named_varops = newAV(); |
296
|
|
|
|
|
|
|
|
297
|
11
|
|
|
|
|
|
av_push(ctx->named_varops, newSVpvx(paramctx.varop)); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
30
|
|
|
|
|
|
ctx->last_varop = paramctx.varop; |
301
|
|
|
|
|
|
|
|
302
|
30
|
|
|
|
|
|
ENTER; |
303
|
30
|
|
|
|
|
|
SAVEI16(PL_parser->in_my); |
304
|
30
|
|
|
|
|
|
PL_parser->in_my = KEY_sigvar; |
305
|
|
|
|
|
|
|
|
306
|
30
|
|
|
|
|
|
lexname_end = PL_parser->bufptr; |
307
|
60
|
|
|
|
|
|
paramctx.padix = paramctx.varop->op_targ = |
308
|
30
|
|
|
|
|
|
pad_add_name_pvn(lexname, lexname_end - lexname, 0, NULL, NULL); |
309
|
|
|
|
|
|
|
|
310
|
30
|
|
|
|
|
|
LEAVE; |
311
|
|
|
|
|
|
|
|
312
|
30
|
|
|
|
|
|
lex_read_space(0); |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
31
|
100
|
|
|
|
|
if(permit_attributes && lex_peek_unichar(0) == ':') { |
|
|
100
|
|
|
|
|
|
316
|
4
|
|
|
|
|
|
lex_read_unichar(0); |
317
|
4
|
|
|
|
|
|
lex_read_space(0); |
318
|
|
|
|
|
|
|
|
319
|
4
|
|
|
|
|
|
SV *attrname = sv_newmortal(), *attrval = sv_newmortal(); |
320
|
|
|
|
|
|
|
|
321
|
8
|
100
|
|
|
|
|
while(lex_scan_attrval_into(attrname, attrval)) { |
322
|
4
|
|
|
|
|
|
lex_read_space(0); |
323
|
|
|
|
|
|
|
|
324
|
4
|
50
|
|
|
|
|
SignatureAttributeRegistration *reg = find_registered_attribute(SvPV_nolen(attrname)); |
325
|
|
|
|
|
|
|
|
326
|
4
|
|
|
|
|
|
void *attrdata = NULL; |
327
|
4
|
50
|
|
|
|
|
if(reg->funcs->apply) |
328
|
4
|
|
|
|
|
|
(*reg->funcs->apply)(aTHX_ ¶mctx, attrval, &attrdata, reg->funcdata); |
329
|
|
|
|
|
|
|
|
330
|
4
|
50
|
|
|
|
|
if(attrdata || reg->funcs->post_defop) { |
|
|
50
|
|
|
|
|
|
331
|
0
|
0
|
|
|
|
|
if(!pending) { |
332
|
0
|
|
|
|
|
|
pending = newAV(); |
333
|
0
|
|
|
|
|
|
SAVEFREESV(pending); |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
SV *psv; |
337
|
0
|
|
|
|
|
|
av_push(pending, psv = NEW_SV_PENDING()); |
338
|
|
|
|
|
|
|
|
339
|
0
|
|
|
|
|
|
PENDING_FROM_SV(psv)->funcs = reg->funcs; |
340
|
0
|
|
|
|
|
|
PENDING_FROM_SV(psv)->funcdata = reg->funcdata; |
341
|
0
|
|
|
|
|
|
PENDING_FROM_SV(psv)->attrdata = attrdata; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
4
|
50
|
|
|
|
|
if(lex_peek_unichar(0) == ':') { |
345
|
0
|
|
|
|
|
|
lex_read_unichar(0); |
346
|
4
|
|
|
|
|
|
lex_read_space(0); |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
|
351
|
31
|
100
|
|
|
|
|
if(c == '$') { |
352
|
|
|
|
|
|
|
SV *argname; |
353
|
|
|
|
|
|
|
|
354
|
27
|
100
|
|
|
|
|
if(paramctx.is_named) { |
355
|
11
|
|
|
|
|
|
parser->sig_slurpy = '+'; |
356
|
11
|
|
|
|
|
|
argname = newSVpvn(lexname + 1, lexname_end - lexname - 1); |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
else { |
359
|
16
|
50
|
|
|
|
|
if(parser->sig_slurpy) |
360
|
0
|
|
|
|
|
|
yyerror("Slurpy parameters not last"); |
361
|
|
|
|
|
|
|
|
362
|
16
|
|
|
|
|
|
parser->sig_elems++; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
27
|
100
|
|
|
|
|
if(lex_peek_unichar(0) == '=') { |
366
|
3
|
|
|
|
|
|
lex_read_unichar(0); |
367
|
3
|
|
|
|
|
|
lex_read_space(0); |
368
|
|
|
|
|
|
|
|
369
|
3
|
100
|
|
|
|
|
if(!paramctx.is_named) |
370
|
1
|
|
|
|
|
|
parser->sig_optelems++; |
371
|
|
|
|
|
|
|
|
372
|
3
|
|
|
|
|
|
OP *defexpr = parse_termexpr(0); |
373
|
|
|
|
|
|
|
|
374
|
3
|
100
|
|
|
|
|
if(paramctx.is_named) { |
375
|
2
|
50
|
|
|
|
|
paramctx.defop = (OP *)alloc_LOGOP_ANY(OP_CUSTOM, defexpr, LINKLIST(defexpr)); |
376
|
2
|
|
|
|
|
|
paramctx.defop->op_ppaddr = &pp_namedargdefelem; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
else { |
379
|
1
|
50
|
|
|
|
|
paramctx.defop = (OP *)alloc_LOGOP(OP_ARGDEFELEM, defexpr, LINKLIST(defexpr)); |
380
|
1
|
|
|
|
|
|
paramctx.defop->op_targ = (PADOFFSET)(parser->sig_elems - 1); |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
3
|
|
|
|
|
|
paramctx.varop->op_flags |= OPf_STACKED; |
384
|
3
|
|
|
|
|
|
op_sibling_splice(paramctx.varop, NULL, 0, paramctx.defop); |
385
|
3
|
|
|
|
|
|
paramctx.defop = op_contextualize(paramctx.defop, G_SCALAR); |
386
|
|
|
|
|
|
|
|
387
|
3
|
50
|
|
|
|
|
LINKLIST(paramctx.varop); |
388
|
|
|
|
|
|
|
|
389
|
3
|
|
|
|
|
|
paramctx.varop->op_next = paramctx.defop; |
390
|
3
|
|
|
|
|
|
defexpr->op_next = paramctx.varop; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
else { |
393
|
24
|
50
|
|
|
|
|
if(parser->sig_optelems) |
394
|
0
|
|
|
|
|
|
yyerror("Mandatory parameter follows optional parameter"); |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
27
|
100
|
|
|
|
|
if(paramctx.is_named) { |
398
|
11
|
|
|
|
|
|
OP *defop = paramctx.defop; |
399
|
11
|
100
|
|
|
|
|
if(!defop) { |
400
|
9
|
|
|
|
|
|
defop = (OP *)alloc_LOGOP_ANY(OP_CUSTOM, NULL, NULL); |
401
|
9
|
|
|
|
|
|
defop->op_ppaddr = &pp_namedargdefelem; |
402
|
|
|
|
|
|
|
|
403
|
9
|
|
|
|
|
|
paramctx.varop->op_flags |= OPf_STACKED; |
404
|
9
|
|
|
|
|
|
op_sibling_splice(paramctx.varop, NULL, 0, defop); |
405
|
|
|
|
|
|
|
|
406
|
9
|
50
|
|
|
|
|
LINKLIST(paramctx.varop); |
407
|
|
|
|
|
|
|
|
408
|
9
|
|
|
|
|
|
paramctx.varop->op_next = defop; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
ANY *op_any; |
412
|
11
|
|
|
|
|
|
Newx(op_any, 2, ANY); |
413
|
|
|
|
|
|
|
|
414
|
11
|
|
|
|
|
|
op_any[0].any_sv = argname; |
415
|
|
|
|
|
|
|
/* [1] is filled in later */ |
416
|
|
|
|
|
|
|
|
417
|
11
|
|
|
|
|
|
cLOGOP_ANYx(defop)->op_any = op_any; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
else { |
421
|
4
|
50
|
|
|
|
|
if(paramctx.is_named) |
422
|
0
|
|
|
|
|
|
yyerror("Slurpy parameters may not be named"); |
423
|
4
|
50
|
|
|
|
|
if(parser->sig_slurpy && parser->sig_slurpy != '+') |
424
|
0
|
|
|
|
|
|
yyerror("Multiple slurpy parameters not allowed"); |
425
|
|
|
|
|
|
|
|
426
|
4
|
|
|
|
|
|
parser->sig_slurpy = c; |
427
|
|
|
|
|
|
|
|
428
|
4
|
50
|
|
|
|
|
if(lex_peek_unichar(0) == '=') |
429
|
0
|
|
|
|
|
|
yyerror("A slurpy parameter may not have a default value"); |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
31
|
|
|
|
|
|
paramctx.op = paramctx.varop; |
433
|
|
|
|
|
|
|
|
434
|
31
|
50
|
|
|
|
|
if(pending) { |
435
|
0
|
0
|
|
|
|
|
for(int i = 0; i <= AvFILL(pending); i++) { |
|
|
0
|
|
|
|
|
|
436
|
0
|
|
|
|
|
|
struct PendingSignatureFunc *p = PENDING_FROM_SV(AvARRAY(pending)[i]); |
437
|
|
|
|
|
|
|
|
438
|
0
|
0
|
|
|
|
|
if(p->funcs->post_defop) |
439
|
0
|
|
|
|
|
|
(*p->funcs->post_defop)(aTHX_ ¶mctx, p->attrdata, p->funcdata); |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
|
443
|
31
|
100
|
|
|
|
|
return paramctx.op ? newSTATEOP(0, NULL, paramctx.op) : NULL; |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
21
|
|
|
|
|
|
OP *XPS_parse_subsignature_ex(pTHX_ int flags) |
447
|
|
|
|
|
|
|
{ |
448
|
|
|
|
|
|
|
/* Mostly reconstructed logic from perl 5.28.0's toke.c and perly.y |
449
|
|
|
|
|
|
|
*/ |
450
|
21
|
|
|
|
|
|
yy_parser *parser = PL_parser; |
451
|
21
|
|
|
|
|
|
struct SignatureParsingContext ctx = {}; |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
bool permit_named_params = flags & PARSE_SUBSIGNATURE_NAMED_PARAMS; |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
assert((flags & ~(PARSE_SUBSIGNATURE_NAMED_PARAMS|PARSE_SUBSIGNATURE_PARAM_ATTRIBUTES)) == 0); |
456
|
|
|
|
|
|
|
|
457
|
21
|
|
|
|
|
|
ENTER; |
458
|
21
|
|
|
|
|
|
SAVEDESTRUCTOR_X(&free_parsing_ctx, &ctx); |
459
|
|
|
|
|
|
|
|
460
|
21
|
|
|
|
|
|
SAVEIV(parser->sig_elems); |
461
|
21
|
|
|
|
|
|
SAVEIV(parser->sig_optelems); |
462
|
21
|
|
|
|
|
|
SAVEI8(parser->sig_slurpy); |
463
|
|
|
|
|
|
|
|
464
|
21
|
|
|
|
|
|
parser->sig_elems = 0; |
465
|
21
|
|
|
|
|
|
parser->sig_optelems = 0; |
466
|
21
|
|
|
|
|
|
parser->sig_slurpy = 0; |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
OP *elems = NULL; |
469
|
|
|
|
|
|
|
OP *namedelems = NULL; |
470
|
|
|
|
|
|
|
OP *final_elem = NULL; |
471
|
|
|
|
|
|
|
|
472
|
34
|
100
|
|
|
|
|
while(lex_peek_unichar(0) != ')') { |
473
|
31
|
|
|
|
|
|
lex_read_space(0); |
474
|
31
|
|
|
|
|
|
OP *elem = parse_sigelem(&ctx, flags); |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
/* placeholder anonymous elems are NULL */ |
477
|
31
|
100
|
|
|
|
|
if(elem) { |
478
|
|
|
|
|
|
|
/* elem should be an OP_LINESEQ[ OP_NEXTSTATE. actual elem ] */ |
479
|
|
|
|
|
|
|
assert(elem->op_type == OP_LINESEQ); |
480
|
|
|
|
|
|
|
assert(cLISTOPx(elem)->op_first); |
481
|
|
|
|
|
|
|
assert(OpSIBLING(cLISTOPx(elem)->op_first)); |
482
|
|
|
|
|
|
|
|
483
|
30
|
50
|
|
|
|
|
final_elem = OpSIBLING(cLISTOPx(elem)->op_first); |
484
|
|
|
|
|
|
|
|
485
|
30
|
50
|
|
|
|
|
if(OP_IS_NAMED_PARAM(ctx.last_varop)) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
486
|
11
|
|
|
|
|
|
namedelems = op_append_list(OP_LIST, namedelems, elem); |
487
|
|
|
|
|
|
|
else |
488
|
19
|
|
|
|
|
|
elems = op_append_list(OP_LINESEQ, elems, elem); |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
31
|
50
|
|
|
|
|
if(PL_parser->error_count) { |
492
|
0
|
|
|
|
|
|
LEAVE; |
493
|
0
|
|
|
|
|
|
return NULL; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
31
|
|
|
|
|
|
lex_read_space(0); |
497
|
31
|
|
|
|
|
|
switch(lex_peek_unichar(0)) { |
498
|
|
|
|
|
|
|
case ')': goto endofelems; |
499
|
|
|
|
|
|
|
case ',': break; |
500
|
|
|
|
|
|
|
default: |
501
|
0
|
|
|
|
|
|
fprintf(stderr, "ARGH unsure how to proceed parse_subsignature at <%s>\n", |
502
|
|
|
|
|
|
|
parser->bufptr); |
503
|
0
|
|
|
|
|
|
croak("ARGH"); |
504
|
|
|
|
|
|
|
break; |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
13
|
|
|
|
|
|
lex_read_unichar(0); |
508
|
13
|
|
|
|
|
|
lex_read_space(0); |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
endofelems: |
511
|
|
|
|
|
|
|
|
512
|
21
|
50
|
|
|
|
|
if (!FEATURE_SIGNATURES_IS_ENABLED) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
513
|
0
|
|
|
|
|
|
croak("Experimental subroutine signatures not enabled"); |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
#if !HAVE_PERL_VERSION(5, 37, 0) |
516
|
21
|
|
|
|
|
|
Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__SIGNATURES), |
517
|
|
|
|
|
|
|
"The signatures feature is experimental"); |
518
|
|
|
|
|
|
|
#endif |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
bool allow_extras_after_named = true; |
521
|
21
|
100
|
|
|
|
|
if(ctx.named_varops) { |
522
|
8
|
|
|
|
|
|
switch(PL_parser->sig_slurpy) { |
523
|
|
|
|
|
|
|
case 0: |
524
|
|
|
|
|
|
|
case '@': |
525
|
0
|
|
|
|
|
|
NOT_REACHED; |
526
|
|
|
|
|
|
|
case '+': |
527
|
|
|
|
|
|
|
{ |
528
|
|
|
|
|
|
|
/* Pretend we have a new, unnamed slurpy hash */ |
529
|
6
|
|
|
|
|
|
OP *varop = newUNOP_AUX(OP_ARGELEM, 0, NULL, INT2PTR(UNOP_AUX_item *, (parser->sig_elems))); |
530
|
6
|
|
|
|
|
|
varop->op_private |= OPpARGELEM_HV; |
531
|
6
|
|
|
|
|
|
varop->op_targ = pad_add_name_pvs("%(params)", 0, NULL, NULL); |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
final_elem = varop; |
534
|
|
|
|
|
|
|
|
535
|
6
|
|
|
|
|
|
OP *elem = newSTATEOP(0, NULL, varop); |
536
|
6
|
|
|
|
|
|
elems = op_append_list(OP_LINESEQ, elems, elem); |
537
|
|
|
|
|
|
|
|
538
|
6
|
|
|
|
|
|
PL_parser->sig_slurpy = '%'; |
539
|
|
|
|
|
|
|
allow_extras_after_named = false; |
540
|
|
|
|
|
|
|
} |
541
|
6
|
|
|
|
|
|
break; |
542
|
|
|
|
|
|
|
case '%': |
543
|
|
|
|
|
|
|
break; |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
21
|
|
|
|
|
|
UNOP_AUX_item *aux = make_argcheck_aux( |
548
|
|
|
|
|
|
|
parser->sig_elems, parser->sig_optelems, parser->sig_slurpy); |
549
|
|
|
|
|
|
|
|
550
|
21
|
|
|
|
|
|
OP *checkop = newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux); |
551
|
|
|
|
|
|
|
|
552
|
21
|
|
|
|
|
|
OP *ops = op_prepend_elem(OP_LINESEQ, newSTATEOP(0, NULL, NULL), |
553
|
|
|
|
|
|
|
op_prepend_elem(OP_LINESEQ, checkop, elems)); |
554
|
|
|
|
|
|
|
|
555
|
21
|
100
|
|
|
|
|
if(ctx.named_varops) { |
556
|
|
|
|
|
|
|
assert(final_elem->op_type == OP_ARGELEM); |
557
|
|
|
|
|
|
|
assert(final_elem->op_private == OPpARGELEM_HV); |
558
|
|
|
|
|
|
|
|
559
|
8
|
|
|
|
|
|
PADOFFSET slurpy_padix = final_elem->op_targ; |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
/* Tell all the pp_namedargdefelem()s where to find the slurpy hash */ |
562
|
19
|
50
|
|
|
|
|
for(int i = 0; i <= AvFILL(ctx.named_varops); i++) { |
|
|
100
|
|
|
|
|
|
563
|
11
|
|
|
|
|
|
OP *elemop = (OP *)(SvPVX(AvARRAY(ctx.named_varops)[i])); |
564
|
|
|
|
|
|
|
assert(elemop); |
565
|
|
|
|
|
|
|
assert(OP_IS_NAMED_PARAM(elemop)); |
566
|
|
|
|
|
|
|
|
567
|
11
|
|
|
|
|
|
OP *defelemop = cUNOPx(elemop)->op_first; |
568
|
|
|
|
|
|
|
assert(defelemop); |
569
|
|
|
|
|
|
|
assert(defelemop->op_type == OP_CUSTOM && |
570
|
|
|
|
|
|
|
defelemop->op_ppaddr == &pp_namedargdefelem); |
571
|
11
|
|
|
|
|
|
ANY *op_any = cLOGOP_ANYx(defelemop)->op_any; |
572
|
11
|
|
|
|
|
|
op_any[1].any_iv = slurpy_padix; |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
8
|
|
|
|
|
|
ops = op_append_list(OP_LINESEQ, ops, |
576
|
|
|
|
|
|
|
namedelems); |
577
|
|
|
|
|
|
|
|
578
|
8
|
100
|
|
|
|
|
if(!allow_extras_after_named) { |
579
|
6
|
|
|
|
|
|
ops = op_append_list(OP_LINESEQ, ops, |
580
|
|
|
|
|
|
|
newSTATEOP(0, NULL, checkop = newOP(OP_CUSTOM, 0))); |
581
|
6
|
|
|
|
|
|
checkop->op_ppaddr = &pp_checknomorenamed; |
582
|
6
|
|
|
|
|
|
checkop->op_targ = slurpy_padix; |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
/* a nextstate at the end handles context correctly for an empty |
587
|
|
|
|
|
|
|
* sub body */ |
588
|
21
|
|
|
|
|
|
ops = op_append_elem(OP_LINESEQ, ops, newSTATEOP(0, NULL, NULL)); |
589
|
|
|
|
|
|
|
|
590
|
21
|
|
|
|
|
|
LEAVE; |
591
|
|
|
|
|
|
|
|
592
|
21
|
|
|
|
|
|
return ops; |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
|
595
|
6
|
|
|
|
|
|
void XPS_register_subsignature_attribute(pTHX_ const char *name, const struct XPSSignatureAttributeFuncs *funcs, void *funcdata) |
596
|
|
|
|
|
|
|
{ |
597
|
|
|
|
|
|
|
SignatureAttributeRegistration *reg; |
598
|
6
|
|
|
|
|
|
Newx(reg, 1, struct SignatureAttributeRegistration); |
599
|
|
|
|
|
|
|
|
600
|
6
|
|
|
|
|
|
*reg = (struct SignatureAttributeRegistration){ |
601
|
|
|
|
|
|
|
.name = name, |
602
|
|
|
|
|
|
|
.funcs = funcs, |
603
|
|
|
|
|
|
|
.funcdata = funcdata, |
604
|
|
|
|
|
|
|
}; |
605
|
|
|
|
|
|
|
|
606
|
6
|
50
|
|
|
|
|
if(funcs->permit_hintkey) |
607
|
6
|
|
|
|
|
|
reg->permit_hintkeylen = strlen(funcs->permit_hintkey); |
608
|
|
|
|
|
|
|
|
609
|
6
|
|
|
|
|
|
reg->next = sigattrs; |
610
|
6
|
|
|
|
|
|
sigattrs = reg; |
611
|
6
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
#else /* !HAVE_PERL_VERSION(5, 26, 0) */ |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
void XPS_register_subsignature_attribute(pTHX_ const char *name, const struct XPSSignatureAttributeFuncs *funcs, void *funcdata) |
616
|
|
|
|
|
|
|
{ |
617
|
|
|
|
|
|
|
croak("Custom subroutine signature attributes are not supported on this verison of Perl"); |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
#endif |