projects / p5sagit/Function-Parameters.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Merge branch 'metadata' into mooseish-types
[p5sagit/Function-Parameters.git] / Parameters.xs
CommitLineData
db81d362 1/*
2Copyright 2012 Lukas Mai.
3
4This program is free software; you can redistribute it and/or modify it
5under the terms of either: the GNU General Public License as published
6by the Free Software Foundation; or the Artistic License.
7
8See http://dev.perl.org/licenses/ for more information.
9 */
10
11#ifdef __GNUC__
12 #if (__GNUC__ == 4 && __GNUC_MINOR__ >= 6) || __GNUC__ >= 5
13 #define PRAGMA_GCC_(X) _Pragma(#X)
14 #define PRAGMA_GCC(X) PRAGMA_GCC_(GCC X)
15 #endif
16#endif
17
18#ifndef PRAGMA_GCC
19 #define PRAGMA_GCC(X)
20#endif
21
22#ifdef DEVEL
23 #define WARNINGS_RESET PRAGMA_GCC(diagnostic pop)
24 #define WARNINGS_ENABLEW(X) PRAGMA_GCC(diagnostic warning #X)
25 #define WARNINGS_ENABLE \
26 WARNINGS_ENABLEW(-Wall) \
27 WARNINGS_ENABLEW(-Wextra) \
28 WARNINGS_ENABLEW(-Wundef) \
c3e72f35 29 /* WARNINGS_ENABLEW(-Wshadow) :-( */ \
db81d362 30 WARNINGS_ENABLEW(-Wbad-function-cast) \
31 WARNINGS_ENABLEW(-Wcast-align) \
32 WARNINGS_ENABLEW(-Wwrite-strings) \
33 /* WARNINGS_ENABLEW(-Wnested-externs) wtf? */ \
34 WARNINGS_ENABLEW(-Wstrict-prototypes) \
35 WARNINGS_ENABLEW(-Wmissing-prototypes) \
36 WARNINGS_ENABLEW(-Winline) \
37 WARNINGS_ENABLEW(-Wdisabled-optimization)
38
39#else
40 #define WARNINGS_RESET
1bc47886 41 #define WARNINGS_ENABLE
db81d362 42#endif
43
44
7dd35535 45#define PERL_NO_GET_CONTEXT
db81d362 46#include "EXTERN.h"
47#include "perl.h"
48#include "XSUB.h"
49
50#include <string.h>
51
63915d26 52
db81d362 53WARNINGS_ENABLE
54
db81d362 55
7dd35535 56#define HAVE_PERL_VERSION(R, V, S) \
57 (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
58
de013990 59#if HAVE_PERL_VERSION(5, 16, 0)
60 #define IF_HAVE_PERL_5_16(YES, NO) YES
61#else
62 #define IF_HAVE_PERL_5_16(YES, NO) NO
63#endif
64
e158cf8f 65#if 0
66 #if HAVE_PERL_VERSION(5, 17, 6)
67 #error "internal error: missing definition of KEY_my (your perl is too new)"
68 #elif HAVE_PERL_VERSION(5, 15, 8)
69 #define S_KEY_my 134
70 #elif HAVE_PERL_VERSION(5, 15, 6)
71 #define S_KEY_my 133
72 #elif HAVE_PERL_VERSION(5, 15, 5)
73 #define S_KEY_my 132
74 #elif HAVE_PERL_VERSION(5, 13, 0)
75 #define S_KEY_my 131
76 #else
77 #error "internal error: missing definition of KEY_my (your perl is too old)"
78 #endif
79#endif
80
63915d26 81
82#define MY_PKG "Function::Parameters"
83
84#define HINTK_KEYWORDS MY_PKG "/keywords"
85#define HINTK_FLAGS_ MY_PKG "/flags:"
86#define HINTK_SHIFT_ MY_PKG "/shift:"
87#define HINTK_ATTRS_ MY_PKG "/attrs:"
88
89#define DEFSTRUCT(T) typedef struct T T; struct T
90
0f875412 91#define UV_BITS (sizeof (UV) * CHAR_BIT)
63915d26 92
93enum {
94 FLAG_NAME_OK = 0x01,
95 FLAG_ANON_OK = 0x02,
96 FLAG_DEFAULT_ARGS = 0x04,
d8e5d540 97 FLAG_CHECK_NARGS = 0x08,
e158cf8f 98 FLAG_INVOCANT = 0x10,
51a483f8 99 FLAG_NAMED_PARAMS = 0x20,
100 FLAG_TYPES_OK = 0x40,
101 FLAG_CHECK_TARGS = 0x80
63915d26 102};
103
104DEFSTRUCT(KWSpec) {
105 unsigned flags;
b72eb6ee 106 SV *shift;
107 SV *attrs;
63915d26 108};
db81d362 109
110static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
111
e4648f19 112DEFSTRUCT(Resource) {
113 Resource *next;
114 void *data;
115 void (*destroy)(pTHX_ void *);
116};
117
118typedef Resource *Sentinel[1];
119
120static void sentinel_clear_void(pTHX_ void *p) {
121 Resource **pp = p;
122 while (*pp) {
123 Resource *cur = *pp;
a4c13d40 124 if (cur->destroy) {
125 cur->destroy(aTHX_ cur->data);
126 }
e4648f19 127 cur->data = (void *)"no";
128 cur->destroy = NULL;
129 *pp = cur->next;
130 Safefree(cur);
131 }
132}
133
a4c13d40 134static Resource *sentinel_register(Sentinel sen, void *data, void (*destroy)(pTHX_ void *)) {
e4648f19 135 Resource *cur;
136
137 Newx(cur, 1, Resource);
138 cur->data = data;
139 cur->destroy = destroy;
140 cur->next = *sen;
141 *sen = cur;
a4c13d40 142
143 return cur;
144}
145
146static void sentinel_disarm(Resource *p) {
147 p->destroy = NULL;
e4648f19 148}
149
150static void my_sv_refcnt_dec_void(pTHX_ void *p) {
151 SV *sv = p;
152 SvREFCNT_dec(sv);
153}
154
155static SV *sentinel_mortalize(Sentinel sen, SV *sv) {
156 sentinel_register(sen, sv, my_sv_refcnt_dec_void);
157 return sv;
158}
159
160static void my_safefree(void *p) {
161 Safefree(p);
162}
163
164#define SENTINEL_ALLOC(SEN, P, N, T) STMT_START { \
165 Newx(P, N, T); \
166 sentinel_register(SEN, P, my_safefree); \
167} STMT_END
168
169#define SENTINEL_MDUP(SEN, P, O, N, T) STMT_START { \
170 void *const _sentinel_mdup_tmp_ = (P); \
171 SENTINEL_ALLOC(SEN, P, N, T); \
172 memcpy(P, _sentinel_mdup_tmp_, O * sizeof (T)); \
173} STMT_END
174
175#define SENTINEL_REALLOC(SEN, P, N, T) STMT_START { \
176 assert((N) > 0); \
177 if (!(P)) { \
178 SENTINEL_ALLOC(SEN, P, N, T); \
179 } else { \
180 Resource **_sentinel_realloc_tmp_ = (SEN); \
181 for (;;) { \
182 assert(*_sentinel_realloc_tmp_ != NULL); \
183 if ((*_sentinel_realloc_tmp_)->data == (P)) { \
184 Renew((*_sentinel_realloc_tmp_)->data, N, T); \
185 (P) = (*_sentinel_realloc_tmp_)->data; \
186 break; \
187 } \
188 _sentinel_realloc_tmp_ = &(*_sentinel_realloc_tmp_)->next; \
189 } \
190 } \
191} STMT_END
192
193static int kw_flags(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len, KWSpec *spec) {
db81d362 194 HV *hints;
195 SV *sv, **psv;
196 const char *p, *kw_active;
197 STRLEN kw_active_len;
198
63915d26 199 spec->flags = 0;
e4648f19 200 spec->shift = sentinel_mortalize(sen, newSVpvs(""));
201 spec->attrs = sentinel_mortalize(sen, newSVpvs(""));
db81d362 202
203 if (!(hints = GvHV(PL_hintgv))) {
204 return FALSE;
205 }
206 if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) {
207 return FALSE;
208 }
209 sv = *psv;
210 kw_active = SvPV(sv, kw_active_len);
211 if (kw_active_len <= kw_len) {
212 return FALSE;
213 }
e88490f6 214 for (
215 p = kw_active;
216 (p = strchr(p, *kw_ptr)) &&
217 p < kw_active + kw_active_len - kw_len;
218 p++
219 ) {
db81d362 220 if (
221 (p == kw_active || p[-1] == ' ') &&
222 p[kw_len] == ' ' &&
223 memcmp(kw_ptr, p, kw_len) == 0
224 ) {
b72eb6ee 225
d970c3e7 226#define FETCH_HINTK_INTO(NAME, PTR, LEN, X) STMT_START { \
b72eb6ee 227 const char *fk_ptr_; \
228 STRLEN fk_len_; \
229 SV *fk_sv_; \
e4648f19 230 fk_sv_ = sentinel_mortalize(sen, newSVpvs(HINTK_ ## NAME)); \
b72eb6ee 231 sv_catpvn(fk_sv_, PTR, LEN); \
232 fk_ptr_ = SvPV(fk_sv_, fk_len_); \
233 if (!((X) = hv_fetch(hints, fk_ptr_, fk_len_, 0))) { \
234 croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)fk_len_, fk_ptr_); \
235 } \
d970c3e7 236} STMT_END
b72eb6ee 237
63915d26 238 FETCH_HINTK_INTO(FLAGS_, kw_ptr, kw_len, psv);
239 spec->flags = SvIV(*psv);
db81d362 240
b72eb6ee 241 FETCH_HINTK_INTO(SHIFT_, kw_ptr, kw_len, psv);
242 SvSetSV(spec->shift, *psv);
db81d362 243
b72eb6ee 244 FETCH_HINTK_INTO(ATTRS_, kw_ptr, kw_len, psv);
245 SvSetSV(spec->attrs, *psv);
246
247#undef FETCH_HINTK_INTO
db81d362 248 return TRUE;
249 }
250 }
251 return FALSE;
252}
253
254
51a483f8 255static void free_ptr_op_void(pTHX_ void *vp) {
c311cef3 256 OP **pp = vp;
257 op_free(*pp);
258 Safefree(pp);
259}
260
51a483f8 261static void free_op_void(pTHX_ void *vp) {
262 OP *p = vp;
263 op_free(p);
264}
265
59016bfb 266#define sv_eq_pvs(SV, S) my_sv_eq_pvn(aTHX_ SV, "" S "", sizeof (S) - 1)
c311cef3 267
59016bfb 268static int my_sv_eq_pvn(pTHX_ SV *sv, const char *p, STRLEN n) {
c311cef3 269 STRLEN sv_len;
270 const char *sv_p = SvPV(sv, sv_len);
59016bfb 271 return memcmp(sv_p, p, n) == 0;
c311cef3 272}
273
274
275#include "padop_on_crack.c.inc"
276
277
c311cef3 278enum {
279 MY_ATTR_LVALUE = 0x01,
280 MY_ATTR_METHOD = 0x02,
281 MY_ATTR_SPECIAL = 0x04
282};
283
31534187 284static void my_sv_cat_c(pTHX_ SV *sv, U32 c) {
285 char ds[UTF8_MAXBYTES + 1], *d;
67fc1ddb 286 d = (char *)uvchr_to_utf8((U8 *)ds, c);
31534187 287 if (d - ds > 1) {
288 sv_utf8_upgrade(sv);
289 }
290 sv_catpvn(sv, ds, d - ds);
291}
292
293static bool my_is_uni_xidfirst(pTHX_ UV c) {
294 U8 tmpbuf[UTF8_MAXBYTES + 1];
295 uvchr_to_utf8(tmpbuf, c);
296 return is_utf8_xidfirst(tmpbuf);
297}
298
299static bool my_is_uni_xidcont(pTHX_ UV c) {
300 U8 tmpbuf[UTF8_MAXBYTES + 1];
301 uvchr_to_utf8(tmpbuf, c);
302 return is_utf8_xidcont(tmpbuf);
303}
304
e4648f19 305static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) {
31534187 306 bool at_start, at_substart;
307 I32 c;
e4648f19 308 SV *sv = sentinel_mortalize(sen, newSVpvs(""));
31534187 309 if (lex_bufutf8()) {
310 SvUTF8_on(sv);
311 }
312
313 at_start = at_substart = TRUE;
314 c = lex_peek_unichar(0);
315
316 while (c != -1) {
317 if (at_substart ? my_is_uni_xidfirst(aTHX_ c) : my_is_uni_xidcont(aTHX_ c)) {
318 lex_read_unichar(0);
319 my_sv_cat_c(aTHX_ sv, c);
320 at_substart = FALSE;
321 c = lex_peek_unichar(0);
322 } else if (allow_package && !at_substart && c == '\'') {
323 lex_read_unichar(0);
324 c = lex_peek_unichar(0);
325 if (!my_is_uni_xidfirst(aTHX_ c)) {
326 lex_stuff_pvs("'", 0);
327 break;
328 }
329 sv_catpvs(sv, "'");
330 at_substart = TRUE;
331 } else if (allow_package && (at_start || !at_substart) && c == ':') {
332 lex_read_unichar(0);
333 if (lex_peek_unichar(0) != ':') {
334 lex_stuff_pvs(":", 0);
335 break;
336 }
337 lex_read_unichar(0);
338 c = lex_peek_unichar(0);
339 if (!my_is_uni_xidfirst(aTHX_ c)) {
340 lex_stuff_pvs("::", 0);
341 break;
342 }
343 sv_catpvs(sv, "::");
344 at_substart = TRUE;
345 } else {
346 break;
347 }
348 at_start = FALSE;
349 }
350
351 return SvCUR(sv) ? sv : NULL;
352}
353
e4648f19 354static SV *my_scan_parens_tail(pTHX_ Sentinel sen, bool keep_backslash) {
31534187 355 I32 c, nesting;
356 SV *sv;
357 line_t start;
358
359 start = CopLINE(PL_curcop);
360
e4648f19 361 sv = sentinel_mortalize(sen, newSVpvs(""));
31534187 362 if (lex_bufutf8()) {
363 SvUTF8_on(sv);
364 }
365
366 nesting = 0;
367 for (;;) {
368 c = lex_read_unichar(0);
369 if (c == EOF) {
370 CopLINE_set(PL_curcop, start);
371 return NULL;
372 }
373
374 if (c == '\\') {
375 c = lex_read_unichar(0);
376 if (c == EOF) {
377 CopLINE_set(PL_curcop, start);
378 return NULL;
379 }
380 if (keep_backslash || (c != '(' && c != ')')) {
381 sv_catpvs(sv, "\\");
382 }
383 } else if (c == '(') {
384 nesting++;
385 } else if (c == ')') {
386 if (!nesting) {
387 break;
388 }
389 nesting--;
390 }
391
392 my_sv_cat_c(aTHX_ sv, c);
393 }
394
395 return sv;
396}
397
e4648f19 398static void my_check_prototype(pTHX_ Sentinel sen, const SV *declarator, SV *proto) {
31534187 399 char *start, *r, *w, *end;
400 STRLEN len;
401
402 /* strip spaces */
403 start = SvPV(proto, len);
404 end = start + len;
405
406 for (w = r = start; r < end; r++) {
407 if (!isSPACE(*r)) {
408 *w++ = *r;
409 }
410 }
411 *w = '\0';
412 SvCUR_set(proto, w - start);
413 end = w;
414 len = end - start;
415
416 if (!ckWARN(WARN_ILLEGALPROTO)) {
417 return;
418 }
419
420 /* check for bad characters */
421 if (strspn(start, "$@%*;[]&\\_+") != len) {
e4648f19 422 SV *dsv = sentinel_mortalize(sen, newSVpvs(""));
31534187 423 warner(
424 packWARN(WARN_ILLEGALPROTO),
425 "Illegal character in prototype for %"SVf" : %s",
426 SVfARG(declarator),
427 SvUTF8(proto)
428 ? sv_uni_display(
429 dsv,
430 proto,
431 len,
432 UNI_DISPLAY_ISPRINT
433 )
434 : pv_pretty(dsv, start, len, 60, NULL, NULL,
435 PERL_PV_ESCAPE_NONASCII
436 )
437 );
438 return;
439 }
440
441 for (r = start; r < end; r++) {
442 switch (*r) {
443 default:
444 warner(
445 packWARN(WARN_ILLEGALPROTO),
446 "Illegal character in prototype for %"SVf" : %s",
447 SVfARG(declarator), r
448 );
449 return;
450
451 case '_':
452 if (r[1] && !strchr(";@%", *r)) {
453 warner(
454 packWARN(WARN_ILLEGALPROTO),
455 "Illegal character after '_' in prototype for %"SVf" : %s",
456 SVfARG(declarator), r
457 );
458 return;
459 }
460 break;
461
462 case '@':
463 case '%':
464 if (r[1]) {
465 warner(
466 packWARN(WARN_ILLEGALPROTO),
467 "prototype after '%c' for %"SVf": %s",
468 *r, SVfARG(declarator), r + 1
469 );
470 return;
471 }
472 break;
473
474 case '\\':
475 r++;
476 if (strchr("$@%&*", *r)) {
477 break;
478 }
479 if (*r == '[') {
480 r++;
481 for (; r < end && *r != ']'; r++) {
482 if (!strchr("$@%&*", *r)) {
483 break;
484 }
485 }
486 if (*r == ']' && r[-1] != '[') {
487 break;
488 }
489 }
490 warner(
491 packWARN(WARN_ILLEGALPROTO),
492 "Illegal character after '\\' in prototype for %"SVf" : %s",
493 SVfARG(declarator), r
494 );
495 return;
496
497 case '$':
498 case '*':
499 case '&':
500 case ';':
501 case '+':
502 break;
503 }
504 }
505}
506
51a483f8 507static SV *parse_type(pTHX_ Sentinel, const SV *);
508
509static SV *parse_type_paramd(pTHX_ Sentinel sen, const SV *declarator) {
510 I32 c;
511 SV *t;
512
513 t = my_scan_word(aTHX_ sen, TRUE);
514 lex_read_space(0);
515
516 c = lex_peek_unichar(0);
517 if (c == '[') {
518 SV *u;
519
520 lex_read_unichar(0);
521 lex_read_space(0);
522 my_sv_cat_c(aTHX_ t, c);
523
524 u = parse_type(aTHX_ sen, declarator);
525 sv_catsv(t, u);
526
527 c = lex_peek_unichar(0);
528 if (c != ']') {
529 croak("In %"SVf": missing ']' after '%"SVf"'", SVfARG(declarator), SVfARG(t));
530 }
531 lex_read_unichar(0);
532 lex_read_space(0);
533
534 my_sv_cat_c(aTHX_ t, c);
535 }
536
537 return t;
538}
539
540static SV *parse_type(pTHX_ Sentinel sen, const SV *declarator) {
541 I32 c;
542 SV *t;
543
544 t = parse_type_paramd(aTHX_ sen, declarator);
545
546 c = lex_peek_unichar(0);
547 while (c == '|') {
548 SV *u;
549
550 lex_read_unichar(0);
551 lex_read_space(0);
552
553 my_sv_cat_c(aTHX_ t, c);
554 u = parse_type_paramd(aTHX_ sen, declarator);
555 sv_catsv(t, u);
556
557 c = lex_peek_unichar(0);
558 }
559
560 return t;
561}
562
563static SV *reify_type(pTHX_ Sentinel sen, const SV *declarator, SV *name) {
564 SV *t;
565 int n;
566 dSP;
567
568 ENTER;
569 SAVETMPS;
570
571 PUSHMARK(SP);
572 EXTEND(SP, 1);
573 PUSHs(name);
574 PUTBACK;
575
576 n = call_pv("Moose::Util::TypeConstraints::find_or_parse_type_constraint", G_SCALAR);
577 SPAGAIN;
578
579 assert(n == 1);
580 t = sentinel_mortalize(sen, SvREFCNT_inc(POPs));
581
582 PUTBACK;
583 FREETMPS;
584 LEAVE;
585
586 if (!SvTRUE(t)) {
587 croak("In %"SVf": undefined type '%"SVf"'", SVfARG(declarator), SVfARG(name));
588 }
589
590 return t;
591}
592
e158cf8f 593
594DEFSTRUCT(Param) {
595 SV *name;
596 PADOFFSET padoff;
51a483f8 597 SV *type;
e158cf8f 598};
599
600DEFSTRUCT(ParamInit) {
601 Param param;
602 OP *init;
603};
604
605#define VEC(B) B ## _Vec
606
607#define DEFVECTOR(B) DEFSTRUCT(VEC(B)) { \
608 B (*data); \
609 size_t used, size; \
610}
611
612DEFVECTOR(Param);
613DEFVECTOR(ParamInit);
614
615#define DEFVECTOR_INIT(N, B) static void N(VEC(B) *p) { \
616 p->used = 0; \
617 p->size = 23; \
618 Newx(p->data, p->size, B); \
619} static void N(VEC(B) *)
620
621DEFSTRUCT(ParamSpec) {
622 Param invocant;
623 VEC(Param) positional_required;
624 VEC(ParamInit) positional_optional;
625 VEC(Param) named_required;
626 VEC(ParamInit) named_optional;
627 Param slurpy;
fc634bba 628 PADOFFSET rest_hash;
e158cf8f 629};
630
631DEFVECTOR_INIT(pv_init, Param);
632DEFVECTOR_INIT(piv_init, ParamInit);
633
634static void p_init(Param *p) {
635 p->name = NULL;
636 p->padoff = NOT_IN_PAD;
51a483f8 637 p->type = NULL;
e158cf8f 638}
639
640static void ps_init(ParamSpec *ps) {
641 p_init(&ps->invocant);
642 pv_init(&ps->positional_required);
643 piv_init(&ps->positional_optional);
644 pv_init(&ps->named_required);
645 piv_init(&ps->named_optional);
646 p_init(&ps->slurpy);
fc634bba 647 ps->rest_hash = NOT_IN_PAD;
e158cf8f 648}
649
650#define DEFVECTOR_EXTEND(N, B) static B (*N(VEC(B) *p)) { \
651 assert(p->used <= p->size); \
652 if (p->used == p->size) { \
653 const size_t n = p->size / 2 * 3 + 1; \
654 Renew(p->data, n, B); \
655 p->size = n; \
656 } \
657 return &p->data[p->used]; \
658} static B (*N(VEC(B) *))
659
660DEFVECTOR_EXTEND(pv_extend, Param);
661DEFVECTOR_EXTEND(piv_extend, ParamInit);
662
663#define DEFVECTOR_CLEAR(N, B, F) static void N(pTHX_ VEC(B) *p) { \
664 while (p->used) { \
665 p->used--; \
666 F(aTHX_ &p->data[p->used]); \
667 } \
668 Safefree(p->data); \
669 p->data = NULL; \
670 p->size = 0; \
671} static void N(pTHX_ VEC(B) *)
672
673static void p_clear(pTHX_ Param *p) {
674 p->name = NULL;
675 p->padoff = NOT_IN_PAD;
51a483f8 676 p->type = NULL;
e158cf8f 677}
678
679static void pi_clear(pTHX_ ParamInit *pi) {
680 p_clear(aTHX_ &pi->param);
681 if (pi->init) {
682 op_free(pi->init);
683 pi->init = NULL;
684 }
685}
686
687DEFVECTOR_CLEAR(pv_clear, Param, p_clear);
688DEFVECTOR_CLEAR(piv_clear, ParamInit, pi_clear);
689
690static void ps_clear(pTHX_ ParamSpec *ps) {
691 p_clear(aTHX_ &ps->invocant);
692
693 pv_clear(aTHX_ &ps->positional_required);
694 piv_clear(aTHX_ &ps->positional_optional);
695
696 pv_clear(aTHX_ &ps->named_required);
697 piv_clear(aTHX_ &ps->named_optional);
698
699 p_clear(aTHX_ &ps->slurpy);
700}
701
702static int ps_contains(pTHX_ const ParamSpec *ps, SV *sv) {
703 size_t i, lim;
704
705 if (ps->invocant.name && sv_eq(sv, ps->invocant.name)) {
706 return 1;
707 }
708
709 for (i = 0, lim = ps->positional_required.used; i < lim; i++) {
710 if (sv_eq(sv, ps->positional_required.data[i].name)) {
711 return 1;
712 }
713 }
714
715 for (i = 0, lim = ps->positional_optional.used; i < lim; i++) {
716 if (sv_eq(sv, ps->positional_optional.data[i].param.name)) {
717 return 1;
718 }
719 }
720
721 for (i = 0, lim = ps->named_required.used; i < lim; i++) {
722 if (sv_eq(sv, ps->named_required.data[i].name)) {
723 return 1;
724 }
725 }
726
727 for (i = 0, lim = ps->named_optional.used; i < lim; i++) {
728 if (sv_eq(sv, ps->named_optional.data[i].param.name)) {
729 return 1;
730 }
731 }
732
733 return 0;
734}
735
736static void ps_free_void(pTHX_ void *p) {
737 ps_clear(aTHX_ p);
738 Safefree(p);
739}
740
741static int args_min(pTHX_ const ParamSpec *ps, const KWSpec *ks) {
742 int n = 0;
743 if (!ps) {
744 return SvTRUE(ks->shift) ? 1 : 0;
745 }
746 if (ps->invocant.name) {
747 n++;
748 }
749 n += ps->positional_required.used;
750 n += ps->named_required.used * 2;
751 return n;
752}
753
754static int args_max(const ParamSpec *ps) {
755 int n = 0;
756 if (!ps) {
757 return -1;
758 }
759 if (ps->invocant.name) {
760 n++;
761 }
762 n += ps->positional_required.used;
763 n += ps->positional_optional.used;
764 if (ps->named_required.used || ps->named_optional.used || ps->slurpy.name) {
765 n = -1;
766 }
767 return n;
768}
769
770static size_t count_positional_params(const ParamSpec *ps) {
771 return ps->positional_required.used + ps->positional_optional.used;
772}
773
774static size_t count_named_params(const ParamSpec *ps) {
775 return ps->named_required.used + ps->named_optional.used;
776}
777
51a483f8 778static void my_require(pTHX_ const char *file) {
779 require_pv(file);
780 if (SvTRUE(ERRSV)) {
781 croak_sv(ERRSV);
782 }
783}
784
785static SV *my_eval(pTHX_ Sentinel sen, I32 floor, OP *op) {
786 SV *sv;
787 CV *cv;
788 dSP;
789
790 cv = newATTRSUB(floor, NULL, NULL, NULL, op);
791
792 ENTER;
793 SAVETMPS;
794
795 PUSHMARK(SP);
796 call_sv((SV *)cv, G_SCALAR | G_NOARGS);
797 SPAGAIN;
798 sv = sentinel_mortalize(sen, SvREFCNT_inc(POPs));
799
800 PUTBACK;
801 FREETMPS;
802 LEAVE;
803
804 return sv;
805}
806
e158cf8f 807enum {
808 PARAM_INVOCANT = 0x01,
809 PARAM_NAMED = 0x02
810};
811
812/* *pinit must be NULL on entry.
813 * caller must free *pinit on error.
814 */
815static PADOFFSET parse_param(
816 pTHX_
e4648f19 817 Sentinel sen,
e158cf8f 818 const SV *declarator, const KWSpec *spec, ParamSpec *param_spec,
51a483f8 819 int *pflags, SV **pname, OP **pinit, SV **ptype
e158cf8f 820) {
821 I32 c;
822 char sigil;
a4c13d40 823 SV *name;
e158cf8f 824
825 assert(!*pinit);
826 *pflags = 0;
51a483f8 827 *ptype = NULL;
e158cf8f 828
829 c = lex_peek_unichar(0);
830
51a483f8 831 if (spec->flags & FLAG_TYPES_OK) {
832 if (c == '(') {
833 I32 floor;
834 OP *expr;
a4c13d40 835 Resource *expr_sentinel;
51a483f8 836
837 lex_read_unichar(0);
838
a4c13d40 839 floor = start_subparse(FALSE, 0);
840 SAVEFREESV(PL_compcv);
841 CvSPECIAL_on(PL_compcv);
51a483f8 842
843 if (!(expr = parse_fullexpr(PARSE_OPTIONAL))) {
844 croak("In %"SVf": invalid type expression", SVfARG(declarator));
845 }
a4c13d40 846 expr_sentinel = sentinel_register(sen, expr, free_op_void);
51a483f8 847
848 lex_read_space(0);
849 c = lex_peek_unichar(0);
850 if (c != ')') {
851 croak("In %"SVf": missing ')' after type expression", SVfARG(declarator));
852 }
853 lex_read_unichar(0);
854 lex_read_space(0);
855
a4c13d40 856 SvREFCNT_inc_simple_void(PL_compcv);
857 sentinel_disarm(expr_sentinel);
51a483f8 858 *ptype = my_eval(aTHX_ sen, floor, expr);
a4c13d40 859 *ptype = reify_type(aTHX_ sen, declarator, *ptype);
51a483f8 860 if (!sv_isobject(*ptype)) {
861 croak("In %"SVf": (%"SVf") doesn't look like a type object", SVfARG(declarator), SVfARG(*ptype));
862 }
863
864 c = lex_peek_unichar(0);
865 } else if (my_is_uni_xidfirst(aTHX_ c)) {
a4c13d40 866 *ptype = parse_type(aTHX_ sen, declarator);
51a483f8 867 my_require(aTHX_ "Moose/Util/TypeConstraints.pm");
a4c13d40 868 *ptype = reify_type(aTHX_ sen, declarator, *ptype);
51a483f8 869
870 c = lex_peek_unichar(0);
871 }
872 }
873
e158cf8f 874 if (c == ':') {
875 lex_read_unichar(0);
876 lex_read_space(0);
877
878 *pflags |= PARAM_NAMED;
879
880 c = lex_peek_unichar(0);
881 }
882
883 if (c == -1) {
884 croak("In %"SVf": unterminated parameter list", SVfARG(declarator));
885 }
51a483f8 886
e158cf8f 887 if (!(c == '$' || c == '@' || c == '%')) {
888 croak("In %"SVf": unexpected '%c' in parameter list (expecting a sigil)", SVfARG(declarator), (int)c);
889 }
890
891 sigil = c;
892
893 lex_read_unichar(0);
894 lex_read_space(0);
895
e4648f19 896 if (!(name = my_scan_word(aTHX_ sen, FALSE))) {
e158cf8f 897 croak("In %"SVf": missing identifier after '%c'", SVfARG(declarator), sigil);
898 }
899 sv_insert(name, 0, 0, &sigil, 1);
900 *pname = name;
901
902 lex_read_space(0);
903 c = lex_peek_unichar(0);
904
905 if (c == '=') {
906 lex_read_unichar(0);
907 lex_read_space(0);
908
909
910 if (!param_spec->invocant.name && SvTRUE(spec->shift)) {
911 param_spec->invocant.name = spec->shift;
912 param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL);
913 }
914
915 *pinit = parse_termexpr(0);
916
917 lex_read_space(0);
918 c = lex_peek_unichar(0);
919 }
920
921 if (c == ':') {
922 *pflags |= PARAM_INVOCANT;
923 lex_read_unichar(0);
924 lex_read_space(0);
925 } else if (c == ',') {
926 lex_read_unichar(0);
927 lex_read_space(0);
928 } else if (c != ')') {
929 if (c == -1) {
930 croak("In %"SVf": unterminated parameter list", SVfARG(declarator));
931 }
932 croak("In %"SVf": unexpected '%c' in parameter list (expecting ',')", SVfARG(declarator), (int)c);
933 }
934
935 return pad_add_name_sv(*pname, IF_HAVE_PERL_5_16(padadd_NO_DUP_CHECK, 0), NULL, NULL);
936}
937
938static OP *my_var_g(pTHX_ I32 type, I32 flags, PADOFFSET padoff) {
939 OP *var = newOP(type, flags);
940 var->op_targ = padoff;
941 return var;
942}
943
944static OP *my_var(pTHX_ I32 flags, PADOFFSET padoff) {
945 return my_var_g(aTHX_ OP_PADSV, flags, padoff);
946}
947
fc634bba 948static OP *mkhvelem(pTHX_ PADOFFSET h, OP *k) {
949 OP *hv = my_var_g(aTHX_ OP_PADHV, OPf_REF, h);
950 return newBINOP(OP_HELEM, 0, hv, k);
951}
952
953static OP *mkconstsv(pTHX_ SV *sv) {
954 return newSVOP(OP_CONST, 0, sv);
955}
956
957static OP *mkconstiv(pTHX_ IV i) {
958 return mkconstsv(aTHX_ newSViv(i));
959}
960
961static OP *mkconstpv(pTHX_ const char *p, size_t n) {
962 return mkconstsv(aTHX_ newSVpv(p, n));
963}
964
965#define mkconstpvs(S) mkconstpv(aTHX_ "" S "", sizeof S - 1)
966
51a483f8 967static OP *mktypecheck(pTHX_ const SV *declarator, int nr, SV *name, PADOFFSET padoff, SV *type) {
968 /* $type->check($value) or Carp::croak "...: " . $type->get_message($value) */
969 OP *chk, *cond, *err, *msg, *xcroak;
970
971 err = mkconstsv(aTHX_ newSVpvf("In %"SVf": parameter %d (%"SVf"): ", SVfARG(declarator), nr, SVfARG(name)));
972 {
973 OP *args = NULL;
974
975 args = op_append_elem(OP_LIST, args, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(type)));
976 args = op_append_elem(
977 OP_LIST, args,
978 padoff == NOT_IN_PAD
979 ? S_newDEFSVOP(aTHX)
980 : my_var(aTHX_ 0, padoff)
981 );
982 args = op_append_elem(OP_LIST, args, newUNOP(OP_METHOD, 0, mkconstpvs("get_message")));
983
984 msg = args;
985 msg->op_type = OP_ENTERSUB;
986 msg->op_ppaddr = PL_ppaddr[OP_ENTERSUB];
987 msg->op_flags |= OPf_STACKED;
988 }
989
990 msg = newBINOP(OP_CONCAT, 0, err, msg);
991
992 xcroak = newCVREF(
993 OPf_WANT_SCALAR,
994 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
995 );
996 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
997
998 {
999 OP *args = NULL;
1000
1001 args = op_append_elem(OP_LIST, args, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(type)));
1002 args = op_append_elem(
1003 OP_LIST, args,
1004 padoff == NOT_IN_PAD
1005 ? S_newDEFSVOP(aTHX)
1006 : my_var(aTHX_ 0, padoff)
1007 );
1008 args = op_append_elem(OP_LIST, args, newUNOP(OP_METHOD, 0, mkconstpvs("check")));
1009
1010 chk = args;
1011 chk->op_type = OP_ENTERSUB;
1012 chk->op_ppaddr = PL_ppaddr[OP_ENTERSUB];
1013 chk->op_flags |= OPf_STACKED;
1014 }
1015
1016 chk = newLOGOP(OP_OR, 0, chk, xcroak);
1017 return chk;
1018}
1019
1020static OP *mktypecheckp(pTHX_ const SV *declarator, int nr, const Param *param) {
1021 return mktypecheck(aTHX_ declarator, nr, param->name, param->padoff, param->type);
1022}
1023
53c979f0 1024static void register_info(pTHX_ UV key, SV *declarator, const KWSpec *kws, const ParamSpec *ps) {
1025 dSP;
1026
1027 ENTER;
1028 SAVETMPS;
1029
1030 PUSHMARK(SP);
51a483f8 1031 EXTEND(SP, 10);
53c979f0 1032
1033 /* 0 */ {
1034 mPUSHu(key);
1035 }
1036 /* 1 */ {
1037 size_t n;
1038 char *p = SvPV(declarator, n);
1039 char *q = memchr(p, ' ', n);
1040 mPUSHp(p, q ? q - p : n);
1041 }
1042 if (!ps) {
1043 if (SvTRUE(kws->shift)) {
1044 PUSHs(kws->shift);
1045 } else {
1046 PUSHmortal;
1047 }
51a483f8 1048 PUSHmortal;
53c979f0 1049 mPUSHs(newRV_noinc((SV *)newAV()));
1050 mPUSHs(newRV_noinc((SV *)newAV()));
1051 mPUSHs(newRV_noinc((SV *)newAV()));
1052 mPUSHs(newRV_noinc((SV *)newAV()));
1053 mPUSHp("@_", 2);
51a483f8 1054 PUSHmortal;
53c979f0 1055 } else {
51a483f8 1056 /* 2, 3 */ {
53c979f0 1057 if (ps->invocant.name) {
1058 PUSHs(ps->invocant.name);
51a483f8 1059 if (ps->invocant.type) {
1060 PUSHs(ps->invocant.type);
1061 } else {
1062 PUSHmortal;
1063 }
53c979f0 1064 } else {
1065 PUSHmortal;
51a483f8 1066 PUSHmortal;
53c979f0 1067 }
1068 }
51a483f8 1069 /* 4 */ {
53c979f0 1070 size_t i, lim;
1071 AV *av;
1072
1073 lim = ps->positional_required.used;
1074
1075 av = newAV();
1076 if (lim) {
51a483f8 1077 av_extend(av, (lim - 1) * 2);
53c979f0 1078 for (i = 0; i < lim; i++) {
51a483f8 1079 Param *cur = &ps->positional_required.data[i];
1080 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1081 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1082 }
1083 }
1084
1085 mPUSHs(newRV_noinc((SV *)av));
1086 }
51a483f8 1087 /* 5 */ {
53c979f0 1088 size_t i, lim;
1089 AV *av;
1090
1091 lim = ps->positional_optional.used;
1092
1093 av = newAV();
1094 if (lim) {
51a483f8 1095 av_extend(av, (lim - 1) * 2);
53c979f0 1096 for (i = 0; i < lim; i++) {
51a483f8 1097 Param *cur = &ps->positional_optional.data[i].param;
1098 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1099 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1100 }
1101 }
1102
1103 mPUSHs(newRV_noinc((SV *)av));
1104 }
51a483f8 1105 /* 6 */ {
53c979f0 1106 size_t i, lim;
1107 AV *av;
1108
1109 lim = ps->named_required.used;
1110
1111 av = newAV();
1112 if (lim) {
51a483f8 1113 av_extend(av, (lim - 1) * 2);
53c979f0 1114 for (i = 0; i < lim; i++) {
51a483f8 1115 Param *cur = &ps->named_required.data[i];
1116 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1117 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1118 }
1119 }
1120
1121 mPUSHs(newRV_noinc((SV *)av));
1122 }
51a483f8 1123 /* 7 */ {
53c979f0 1124 size_t i, lim;
1125 AV *av;
1126
1127 lim = ps->named_optional.used;
1128
1129 av = newAV();
1130 if (lim) {
51a483f8 1131 av_extend(av, (lim - 1) * 2);
53c979f0 1132 for (i = 0; i < lim; i++) {
51a483f8 1133 Param *cur = &ps->named_optional.data[i].param;
1134 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1135 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1136 }
1137 }
1138
1139 mPUSHs(newRV_noinc((SV *)av));
1140 }
51a483f8 1141 /* 8, 9 */ {
53c979f0 1142 if (ps->slurpy.name) {
1143 PUSHs(ps->slurpy.name);
51a483f8 1144 if (ps->slurpy.type) {
1145 PUSHs(ps->slurpy.type);
1146 } else {
1147 PUSHmortal;
1148 }
53c979f0 1149 } else {
1150 PUSHmortal;
51a483f8 1151 PUSHmortal;
53c979f0 1152 }
1153 }
1154 }
1155 PUTBACK;
1156
1157 call_pv(MY_PKG "::_register_info", G_VOID);
1158
1159 FREETMPS;
1160 LEAVE;
1161}
1162
e4648f19 1163static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) {
e158cf8f 1164 ParamSpec *param_spec;
c311cef3 1165 SV *declarator;
1166 I32 floor_ix;
63915d26 1167 int save_ix;
c311cef3 1168 SV *saw_name;
1e0f1595 1169 OP **prelude_sentinel;
c311cef3 1170 SV *proto;
1171 OP **attrs_sentinel, *body;
1172 unsigned builtin_attrs;
db81d362 1173 I32 c;
1174
e4648f19 1175 declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len));
db81d362 1176
db81d362 1177 lex_read_space(0);
1178
c311cef3 1179 builtin_attrs = 0;
1180
db81d362 1181 /* function name */
c311cef3 1182 saw_name = NULL;
e4648f19 1183 if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ sen, TRUE))) {
c311cef3 1184
1185 if (PL_parser->expect != XSTATE) {
1186 /* bail out early so we don't predeclare $saw_name */
1187 croak("In %"SVf": I was expecting a function body, not \"%"SVf"\"", SVfARG(declarator), SVfARG(saw_name));
1188 }
1189
db81d362 1190 sv_catpvs(declarator, " ");
c311cef3 1191 sv_catsv(declarator, saw_name);
1192
1193 if (
1194 sv_eq_pvs(saw_name, "BEGIN") ||
1195 sv_eq_pvs(saw_name, "END") ||
1196 sv_eq_pvs(saw_name, "INIT") ||
1197 sv_eq_pvs(saw_name, "CHECK") ||
1198 sv_eq_pvs(saw_name, "UNITCHECK")
1199 ) {
1200 builtin_attrs |= MY_ATTR_SPECIAL;
1201 }
1202
db81d362 1203 lex_read_space(0);
63915d26 1204 } else if (!(spec->flags & FLAG_ANON_OK)) {
31534187 1205 croak("I was expecting a function name, not \"%.*s\"", (int)(PL_parser->bufend - PL_parser->bufptr), PL_parser->bufptr);
db81d362 1206 } else {
1207 sv_catpvs(declarator, " (anon)");
1208 }
1209
63915d26 1210 /* we're a subroutine declaration */
c311cef3 1211 floor_ix = start_subparse(FALSE, saw_name ? 0 : CVf_ANON);
1212 SAVEFREESV(PL_compcv);
1213
63915d26 1214 /* create outer block: '{' */
1215 save_ix = S_block_start(aTHX_ TRUE);
1216
1e0f1595 1217 /* initialize synthetic optree */
1218 Newx(prelude_sentinel, 1, OP *);
1219 *prelude_sentinel = NULL;
51a483f8 1220 sentinel_register(sen, prelude_sentinel, free_ptr_op_void);
1e0f1595 1221
db81d362 1222 /* parameters */
e158cf8f 1223 param_spec = NULL;
63915d26 1224
db81d362 1225 c = lex_peek_unichar(0);
1226 if (c == '(') {
e158cf8f 1227 OP **init_sentinel;
1228
1229 Newx(init_sentinel, 1, OP *);
1230 *init_sentinel = NULL;
51a483f8 1231 sentinel_register(sen, init_sentinel, free_ptr_op_void);
e158cf8f 1232
1233 Newx(param_spec, 1, ParamSpec);
1234 ps_init(param_spec);
e4648f19 1235 sentinel_register(sen, param_spec, ps_free_void);
db81d362 1236
1237 lex_read_unichar(0);
1238 lex_read_space(0);
1239
e158cf8f 1240 while ((c = lex_peek_unichar(0)) != ')') {
1241 int flags;
51a483f8 1242 SV *name, *type;
e158cf8f 1243 char sigil;
1244 PADOFFSET padoff;
c311cef3 1245
51a483f8 1246 padoff = parse_param(aTHX_ sen, declarator, spec, param_spec, &flags, &name, init_sentinel, &type);
c311cef3 1247
e158cf8f 1248 S_intro_my(aTHX);
63915d26 1249
e158cf8f 1250 sigil = SvPV_nolen(name)[0];
db81d362 1251
e158cf8f 1252 /* internal consistency */
1253 if (flags & PARAM_NAMED) {
1254 if (flags & PARAM_INVOCANT) {
1255 croak("In %"SVf": invocant %"SVf" can't be a named parameter", SVfARG(declarator), SVfARG(name));
db81d362 1256 }
e158cf8f 1257 if (sigil != '$') {
1258 croak("In %"SVf": named parameter %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash");
db81d362 1259 }
e158cf8f 1260 } else if (flags & PARAM_INVOCANT) {
1261 if (*init_sentinel) {
1262 croak("In %"SVf": invocant %"SVf" can't have a default value", SVfARG(declarator), SVfARG(name));
db81d362 1263 }
e158cf8f 1264 if (sigil != '$') {
1265 croak("In %"SVf": invocant %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash");
1266 }
1267 } else if (sigil != '$' && *init_sentinel) {
1268 croak("In %"SVf": %s %"SVf" can't have a default value", SVfARG(declarator), sigil == '@' ? "array" : "hash", SVfARG(name));
1269 }
db81d362 1270
e158cf8f 1271 /* external constraints */
1272 if (param_spec->slurpy.name) {
1273 croak("In %"SVf": I was expecting \")\" after \"%"SVf"\", not \"%"SVf"\"", SVfARG(declarator), SVfARG(param_spec->slurpy.name), SVfARG(name));
1274 }
1275 if (sigil != '$') {
1276 assert(!*init_sentinel);
1277 param_spec->slurpy.name = name;
1278 param_spec->slurpy.padoff = padoff;
51a483f8 1279 param_spec->slurpy.type = type;
e158cf8f 1280 continue;
1281 }
d8e5d540 1282
e158cf8f 1283 if (!(flags & PARAM_NAMED) && count_named_params(param_spec)) {
1284 croak("In %"SVf": positional parameter %"SVf" can't appear after named parameter %"SVf"", SVfARG(declarator), SVfARG(name), SVfARG((param_spec->named_required.used ? param_spec->named_required.data[0] : param_spec->named_optional.data[0].param).name));
1285 }
d8e5d540 1286
e158cf8f 1287 if (flags & PARAM_INVOCANT) {
1288 if (param_spec->invocant.name) {
1289 croak("In %"SVf": invalid double invocants %"SVf", %"SVf"", SVfARG(declarator), SVfARG(param_spec->invocant.name), SVfARG(name));
1290 }
1291 if (count_positional_params(param_spec) || count_named_params(param_spec)) {
1292 croak("In %"SVf": invocant %"SVf" must be first in parameter list", SVfARG(declarator), SVfARG(name));
63915d26 1293 }
e158cf8f 1294 if (!(spec->flags & FLAG_INVOCANT)) {
1295 croak("In %"SVf": invocant %"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
1296 }
1297 param_spec->invocant.name = name;
1298 param_spec->invocant.padoff = padoff;
51a483f8 1299 param_spec->invocant.type = type;
e158cf8f 1300 continue;
1301 }
63915d26 1302
e158cf8f 1303 if (*init_sentinel && !(spec->flags & FLAG_DEFAULT_ARGS)) {
1304 croak("In %"SVf": default argument for %"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
1305 }
1e0f1595 1306
e158cf8f 1307 if (ps_contains(aTHX_ param_spec, name)) {
1308 croak("In %"SVf": %"SVf" can't appear twice in the same parameter list", SVfARG(declarator), SVfARG(name));
1309 }
1e0f1595 1310
e158cf8f 1311 if (flags & PARAM_NAMED) {
1312 if (!(spec->flags & FLAG_NAMED_PARAMS)) {
1313 croak("In %"SVf": named parameter :%"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
1e0f1595 1314 }
1315
e158cf8f 1316 if (*init_sentinel) {
1317 ParamInit *pi = piv_extend(&param_spec->named_optional);
1318 pi->param.name = name;
1319 pi->param.padoff = padoff;
51a483f8 1320 pi->param.type = type;
e158cf8f 1321 pi->init = *init_sentinel;
1322 *init_sentinel = NULL;
1323 param_spec->named_optional.used++;
1324 } else {
67fc1ddb 1325 Param *p;
1326
e158cf8f 1327 if (param_spec->positional_optional.used) {
1328 croak("In %"SVf": can't combine optional positional (%"SVf") and required named (%"SVf") parameters", SVfARG(declarator), SVfARG(param_spec->positional_optional.data[0].param.name), SVfARG(name));
1329 }
d8e5d540 1330
67fc1ddb 1331 p = pv_extend(&param_spec->named_required);
e158cf8f 1332 p->name = name;
1333 p->padoff = padoff;
51a483f8 1334 p->type = type;
e158cf8f 1335 param_spec->named_required.used++;
1336 }
1337 } else {
1338 if (*init_sentinel || param_spec->positional_optional.used) {
1339 ParamInit *pi = piv_extend(&param_spec->positional_optional);
1340 pi->param.name = name;
1341 pi->param.padoff = padoff;
51a483f8 1342 pi->param.type = type;
e158cf8f 1343 pi->init = *init_sentinel;
1344 *init_sentinel = NULL;
1345 param_spec->positional_optional.used++;
1346 } else {
1347 Param *p = pv_extend(&param_spec->positional_required);
1348 p->name = name;
1349 p->padoff = padoff;
51a483f8 1350 p->type = type;
e158cf8f 1351 param_spec->positional_required.used++;
db81d362 1352 }
1353 }
1354
e158cf8f 1355 }
1356 lex_read_unichar(0);
1357 lex_read_space(0);
1358 *init_sentinel = NULL;
db81d362 1359
e158cf8f 1360 if (!param_spec->invocant.name && SvTRUE(spec->shift)) {
1361 if (ps_contains(aTHX_ param_spec, spec->shift)) {
1362 croak("In %"SVf": %"SVf" can't appear twice in the same parameter list", SVfARG(declarator), SVfARG(spec->shift));
db81d362 1363 }
e158cf8f 1364
1365 param_spec->invocant.name = spec->shift;
1366 param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL);
db81d362 1367 }
1368 }
1369
1370 /* prototype */
c311cef3 1371 proto = NULL;
db81d362 1372 c = lex_peek_unichar(0);
1373 if (c == ':') {
1374 lex_read_unichar(0);
1375 lex_read_space(0);
1376
1377 c = lex_peek_unichar(0);
1378 if (c != '(') {
c311cef3 1379 lex_stuff_pvs(":", 0);
1380 c = ':';
db81d362 1381 } else {
31534187 1382 lex_read_unichar(0);
e4648f19 1383 if (!(proto = my_scan_parens_tail(aTHX_ sen, FALSE))) {
f34187b8 1384 croak("In %"SVf": prototype not terminated", SVfARG(declarator));
db81d362 1385 }
e4648f19 1386 my_check_prototype(aTHX_ sen, declarator, proto);
db81d362 1387 lex_read_space(0);
c311cef3 1388 c = lex_peek_unichar(0);
514bcaa6 1389 if (!(c == ':' || c == '{')) {
1390 lex_stuff_pvs(":", 0);
1391 c = ':';
1392 }
db81d362 1393 }
1394 }
1395
db81d362 1396 /* attributes */
c311cef3 1397 Newx(attrs_sentinel, 1, OP *);
1398 *attrs_sentinel = NULL;
51a483f8 1399 sentinel_register(sen, attrs_sentinel, free_ptr_op_void);
c311cef3 1400
63915d26 1401 if (c == ':' || c == '{') /* '}' - hi, vim */ {
c311cef3 1402
1403 /* kludge default attributes in */
1404 if (SvTRUE(spec->attrs) && SvPV_nolen(spec->attrs)[0] == ':') {
1405 lex_stuff_sv(spec->attrs, 0);
1406 c = ':';
1407 }
b72eb6ee 1408
db81d362 1409 if (c == ':') {
db81d362 1410 lex_read_unichar(0);
1411 lex_read_space(0);
db81d362 1412 c = lex_peek_unichar(0);
c311cef3 1413
1414 for (;;) {
1415 SV *attr;
1416
e4648f19 1417 if (!(attr = my_scan_word(aTHX_ sen, FALSE))) {
c311cef3 1418 break;
db81d362 1419 }
c311cef3 1420
db81d362 1421 lex_read_space(0);
1422 c = lex_peek_unichar(0);
c311cef3 1423
1424 if (c != '(') {
1425 if (sv_eq_pvs(attr, "lvalue")) {
1426 builtin_attrs |= MY_ATTR_LVALUE;
1427 attr = NULL;
1428 } else if (sv_eq_pvs(attr, "method")) {
1429 builtin_attrs |= MY_ATTR_METHOD;
1430 attr = NULL;
1431 }
1432 } else {
31534187 1433 SV *sv;
1434 lex_read_unichar(0);
e4648f19 1435 if (!(sv = my_scan_parens_tail(aTHX_ sen, TRUE))) {
c311cef3 1436 croak("In %"SVf": unterminated attribute parameter in attribute list", SVfARG(declarator));
1437 }
31534187 1438 sv_catpvs(attr, "(");
c311cef3 1439 sv_catsv(attr, sv);
31534187 1440 sv_catpvs(attr, ")");
c311cef3 1441
1442 lex_read_space(0);
1443 c = lex_peek_unichar(0);
1444 }
1445
1446 if (attr) {
fc634bba 1447 *attrs_sentinel = op_append_elem(OP_LIST, *attrs_sentinel, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(attr)));
c311cef3 1448 }
1449
1450 if (c == ':') {
1451 lex_read_unichar(0);
1452 lex_read_space(0);
1453 c = lex_peek_unichar(0);
1454 }
db81d362 1455 }
1456 }
1457 }
1458
1459 /* body */
63915d26 1460 if (c != '{') /* '}' - hi, vim */ {
85bc3fbd 1461 croak("In %"SVf": I was expecting a function body, not \"%c\"", SVfARG(declarator), (int)c);
db81d362 1462 }
c311cef3 1463
63915d26 1464 /* surprise predeclaration! */
1465 if (saw_name) {
1466 /* 'sub NAME (PROTO);' to make name/proto known to perl before it
1467 starts parsing the body */
1468 const I32 sub_ix = start_subparse(FALSE, 0);
1469 SAVEFREESV(PL_compcv);
1470
1471 SvREFCNT_inc_simple_void(PL_compcv);
1472
1473 newATTRSUB(
1474 sub_ix,
fc634bba 1475 mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(saw_name)),
1476 proto ? mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(proto)) : NULL,
63915d26 1477 NULL,
1478 NULL
1479 );
1480 }
1481
c311cef3 1482 if (builtin_attrs & MY_ATTR_LVALUE) {
1483 CvLVALUE_on(PL_compcv);
db81d362 1484 }
c311cef3 1485 if (builtin_attrs & MY_ATTR_METHOD) {
1486 CvMETHOD_on(PL_compcv);
1487 }
1488 if (builtin_attrs & MY_ATTR_SPECIAL) {
1489 CvSPECIAL_on(PL_compcv);
db81d362 1490 }
1491
e158cf8f 1492 /* check number of arguments */
1e0f1595 1493 if (spec->flags & FLAG_CHECK_NARGS) {
e158cf8f 1494 int amin, amax;
abccbe86 1495
e158cf8f 1496 amin = args_min(aTHX_ param_spec, spec);
1497 if (amin > 0) {
51a483f8 1498 OP *chk, *cond, *err, *xcroak;
63915d26 1499
fc634bba 1500 err = mkconstsv(aTHX_ newSVpvf("Not enough arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amin));
1501 err = newBINOP(
1502 OP_CONCAT, 0,
1503 err,
1504 newAVREF(newGVOP(OP_GV, 0, PL_defgv))
1505 );
1506 err = newBINOP(
1507 OP_CONCAT, 0,
1508 err,
1509 mkconstpvs(")")
1510 );
63915d26 1511
51a483f8 1512 xcroak = newCVREF(OPf_WANT_SCALAR,
1513 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
1e0f1595 1514 err = newUNOP(OP_ENTERSUB, OPf_STACKED,
51a483f8 1515 op_append_elem(OP_LIST, err, xcroak));
63915d26 1516
1e0f1595 1517 cond = newBINOP(OP_LT, 0,
5f50e017 1518 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
fc634bba 1519 mkconstiv(aTHX_ amin));
1e0f1595 1520 chk = newLOGOP(OP_AND, 0, cond, err);
63915d26 1521
1e0f1595 1522 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
1523 }
abccbe86 1524
e158cf8f 1525 amax = args_max(param_spec);
1526 if (amax >= 0) {
51a483f8 1527 OP *chk, *cond, *err, *xcroak;
63915d26 1528
fc634bba 1529 err = mkconstsv(aTHX_ newSVpvf("Too many arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amax));
1530 err = newBINOP(
1531 OP_CONCAT, 0,
1532 err,
1533 newAVREF(newGVOP(OP_GV, 0, PL_defgv))
1534 );
1535 err = newBINOP(
1536 OP_CONCAT, 0,
1537 err,
1538 mkconstpvs(")")
1539 );
63915d26 1540
51a483f8 1541 xcroak = newCVREF(
fc634bba 1542 OPf_WANT_SCALAR,
1543 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1544 );
1e0f1595 1545 err = newUNOP(OP_ENTERSUB, OPf_STACKED,
51a483f8 1546 op_append_elem(OP_LIST, err, xcroak));
63915d26 1547
fc634bba 1548 cond = newBINOP(
1549 OP_GT, 0,
1550 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1551 mkconstiv(aTHX_ amax)
1552 );
1e0f1595 1553 chk = newLOGOP(OP_AND, 0, cond, err);
63915d26 1554
1e0f1595 1555 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
1556 }
e158cf8f 1557
1558 if (param_spec && (count_named_params(param_spec) || (param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%'))) {
51a483f8 1559 OP *chk, *cond, *err, *xcroak;
e158cf8f 1560 const UV fixed = count_positional_params(param_spec) + !!param_spec->invocant.name;
63915d26 1561
fc634bba 1562 err = mkconstsv(aTHX_ newSVpvf("Odd number of paired arguments for %"SVf"", SVfARG(declarator)));
63915d26 1563
51a483f8 1564 xcroak = newCVREF(
fc634bba 1565 OPf_WANT_SCALAR,
1566 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1567 );
1e0f1595 1568 err = newUNOP(OP_ENTERSUB, OPf_STACKED,
51a483f8 1569 op_append_elem(OP_LIST, err, xcroak));
63915d26 1570
1e0f1595 1571 cond = newBINOP(OP_GT, 0,
5f50e017 1572 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
fc634bba 1573 mkconstiv(aTHX_ fixed));
e158cf8f 1574 cond = newLOGOP(OP_AND, 0,
fc634bba 1575 cond,
1576 newBINOP(OP_MODULO, 0,
1577 fixed
1578 ? newBINOP(OP_SUBTRACT, 0,
1579 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1580 mkconstiv(aTHX_ fixed))
1581 : newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1582 mkconstiv(aTHX_ 2)));
1e0f1595 1583 chk = newLOGOP(OP_AND, 0, cond, err);
63915d26 1584
1e0f1595 1585 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
c311cef3 1586 }
1e0f1595 1587 }
c311cef3 1588
e158cf8f 1589 if (!param_spec) {
1590 /* my $invocant = shift; */
1591 if (SvTRUE(spec->shift)) {
1592 OP *var;
abccbe86 1593
e158cf8f 1594 var = my_var(
1595 aTHX_
1596 OPf_MOD | (OPpLVAL_INTRO << 8),
1597 pad_add_name_sv(spec->shift, 0, NULL, NULL)
1598 );
1599 var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
c311cef3 1600
e158cf8f 1601 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1602 }
1603 } else {
1604 /* my $invocant = shift; */
1605 if (param_spec->invocant.name) {
1606 OP *var;
c311cef3 1607
e158cf8f 1608 var = my_var(
1609 aTHX_
1610 OPf_MOD | (OPpLVAL_INTRO << 8),
1611 param_spec->invocant.padoff
1612 );
1613 var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
1e0f1595 1614
e158cf8f 1615 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
51a483f8 1616
1617 if (param_spec->invocant.type && (spec->flags & FLAG_CHECK_TARGS)) {
1618 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, 0, &param_spec->invocant)));
1619 }
c311cef3 1620 }
1621
e158cf8f 1622 /* my (...) = @_; */
1623 {
1624 OP *lhs;
1625 size_t i, lim;
63915d26 1626
e158cf8f 1627 lhs = NULL;
63915d26 1628
e158cf8f 1629 for (i = 0, lim = param_spec->positional_required.used; i < lim; i++) {
1630 OP *const var = my_var(
1631 aTHX_
1632 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1633 param_spec->positional_required.data[i].padoff
1634 );
1635 lhs = op_append_elem(OP_LIST, lhs, var);
1636 }
63915d26 1637
e158cf8f 1638 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1639 OP *const var = my_var(
1640 aTHX_
1641 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1642 param_spec->positional_optional.data[i].param.padoff
1643 );
1644 lhs = op_append_elem(OP_LIST, lhs, var);
1645 }
63915d26 1646
fc634bba 1647 {
1648 PADOFFSET padoff;
1649 I32 type;
1650 bool slurpy_hash;
1651
1652 /*
1653 * cases:
1654 * 1) no named params
1655 * 1.1) slurpy
1656 * => put it in
1657 * 1.2) no slurpy
1658 * => nop
1659 * 2) named params
1660 * 2.1) no slurpy
1661 * => synthetic %{rest}
1662 * 2.2) slurpy is a hash
1663 * => put it in
1664 * 2.3) slurpy is an array
1665 * => synthetic %{rest}
1666 * remember to declare array later
1667 */
1668
1669 slurpy_hash = param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%';
1670 if (!count_named_params(param_spec)) {
1671 if (param_spec->slurpy.name) {
1672 padoff = param_spec->slurpy.padoff;
1673 type = slurpy_hash ? OP_PADHV : OP_PADAV;
1674 } else {
1675 padoff = NOT_IN_PAD;
1676 type = OP_PADSV;
1677 }
1678 } else if (slurpy_hash) {
1679 padoff = param_spec->slurpy.padoff;
1680 type = OP_PADHV;
e158cf8f 1681 } else {
fc634bba 1682 padoff = param_spec->rest_hash = pad_add_name_pvs("%{rest}", 0, NULL, NULL);
1683 type = OP_PADHV;
1684 }
1685
1686 if (padoff != NOT_IN_PAD) {
e158cf8f 1687 OP *const var = my_var_g(
1688 aTHX_
fc634bba 1689 type,
e158cf8f 1690 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
fc634bba 1691 padoff
e158cf8f 1692 );
fc634bba 1693
e158cf8f 1694 lhs = op_append_elem(OP_LIST, lhs, var);
fc634bba 1695
1696 if (type == OP_PADHV) {
1697 param_spec->rest_hash = padoff;
1698 }
e158cf8f 1699 }
1700 }
63915d26 1701
e158cf8f 1702 if (lhs) {
1703 OP *rhs;
1704 lhs->op_flags |= OPf_PARENS;
1705 rhs = newAVREF(newGVOP(OP_GV, 0, PL_defgv));
1706
1707 *prelude_sentinel = op_append_list(
1708 OP_LINESEQ, *prelude_sentinel,
1709 newSTATEOP(
1710 0, NULL,
1711 newASSIGNOP(OPf_STACKED, lhs, 0, rhs)
1712 )
1713 );
1714 }
1715 }
63915d26 1716
fc634bba 1717 /* default positional arguments */
e158cf8f 1718 {
1719 size_t i, lim, req;
1720 OP *nest;
63915d26 1721
e158cf8f 1722 nest = NULL;
63915d26 1723
e158cf8f 1724 req = param_spec->positional_required.used;
1725 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1726 ParamInit *cur = &param_spec->positional_optional.data[i];
1727 OP *var, *cond;
63915d26 1728
e158cf8f 1729 cond = newBINOP(
1730 OP_LT, 0,
1731 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
fc634bba 1732 mkconstiv(aTHX_ req + i + 1)
e158cf8f 1733 );
63915d26 1734
e158cf8f 1735 var = my_var(aTHX_ 0, cur->param.padoff);
63915d26 1736
e158cf8f 1737 nest = op_append_list(
1738 OP_LINESEQ, nest,
1739 newASSIGNOP(OPf_STACKED, var, 0, cur->init)
1740 );
1741 cur->init = NULL;
1742 nest = newCONDOP(
1743 0,
1744 cond,
1745 nest,
1746 NULL
1747 );
1748 }
1e0f1595 1749
e158cf8f 1750 *prelude_sentinel = op_append_list(
1751 OP_LINESEQ, *prelude_sentinel,
1752 nest
1753 );
c311cef3 1754 }
1755
e158cf8f 1756 /* named parameters */
1757 if (count_named_params(param_spec)) {
fc634bba 1758 size_t i, lim;
1759
1760 assert(param_spec->rest_hash != NOT_IN_PAD);
1761
1762 for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1763 Param *cur = &param_spec->named_required.data[i];
1764 size_t n;
1765 char *p = SvPV(cur->name, n);
1766 OP *var, *cond;
1767
1768 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1769
1770 if (spec->flags & FLAG_CHECK_NARGS) {
51a483f8 1771 OP *xcroak, *msg;
fc634bba 1772
1773 var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1774 var = newUNOP(OP_DELETE, 0, var);
1775
1776 msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": missing named parameter: %.*s", SVfARG(declarator), (int)(n - 1), p + 1));
51a483f8 1777 xcroak = newCVREF(
fc634bba 1778 OPf_WANT_SCALAR,
1779 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1780 );
51a483f8 1781 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
fc634bba 1782
1783 cond = newUNOP(OP_EXISTS, 0, cond);
1784
51a483f8 1785 cond = newCONDOP(0, cond, var, xcroak);
fc634bba 1786 }
1787
1788 var = my_var(
1789 aTHX_
1790 OPf_MOD | (OPpLVAL_INTRO << 8),
1791 cur->padoff
1792 );
1793 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1794
1795 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1796 }
1797
1798 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1799 ParamInit *cur = &param_spec->named_optional.data[i];
1800 size_t n;
1801 char *p = SvPV(cur->param.name, n);
1802 OP *var, *cond;
1803
1804 var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1805 var = newUNOP(OP_DELETE, 0, var);
1806
1807 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1808 cond = newUNOP(OP_EXISTS, 0, cond);
1809
1810 cond = newCONDOP(0, cond, var, cur->init);
1811 cur->init = NULL;
1812
1813 var = my_var(
1814 aTHX_
1815 OPf_MOD | (OPpLVAL_INTRO << 8),
1816 cur->param.padoff
1817 );
1818 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1819
1820 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1821 }
1822
1823 if (!param_spec->slurpy.name) {
1824 if (spec->flags & FLAG_CHECK_NARGS) {
1825 /* croak if %{rest} */
51a483f8 1826 OP *xcroak, *cond, *keys, *msg;
fc634bba 1827
1828 keys = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1829 keys = newLISTOP(OP_SORT, 0, newOP(OP_PUSHMARK, 0), keys);
1830 {
1831 OP *first, *mid, *last;
1832
1833 last = keys;
1834
1835 mid = mkconstpvs(", ");
1836 mid->op_sibling = last;
1837
1838 first = newOP(OP_PUSHMARK, 0);
1839
1840 keys = newLISTOP(OP_JOIN, 0, first, mid);
1841 keys->op_targ = pad_alloc(OP_JOIN, SVs_PADTMP);
1842 ((LISTOP *)keys)->op_last = last;
1843 }
1844
1845 msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": no such named parameter: ", SVfARG(declarator)));
1846 msg = newBINOP(OP_CONCAT, 0, msg, keys);
1847
51a483f8 1848 xcroak = newCVREF(
fc634bba 1849 OPf_WANT_SCALAR,
1850 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1851 );
51a483f8 1852 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
fc634bba 1853
1854 cond = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
51a483f8 1855 xcroak = newCONDOP(0, cond, xcroak, NULL);
fc634bba 1856
51a483f8 1857 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, xcroak));
fc634bba 1858 } else {
1859 OP *clear;
1860
1861 clear = newASSIGNOP(
1862 OPf_STACKED,
1863 my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1864 0,
1865 newNULLLIST()
1866 );
1867
1868 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear));
1869 }
1870 } else if (param_spec->slurpy.padoff != param_spec->rest_hash) {
1871 OP *var, *clear;
1872
1873 assert(SvPV_nolen(param_spec->slurpy.name)[0] == '@');
1874
1875 var = my_var_g(
1876 aTHX_
1877 OP_PADAV,
1878 OPf_MOD | (OPpLVAL_INTRO << 8),
1879 param_spec->slurpy.padoff
1880 );
1881
1882 var = newASSIGNOP(OPf_STACKED, var, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1883
1884 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1885
1886 clear = newASSIGNOP(
1887 OPf_STACKED,
1888 my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1889 0,
1890 newNULLLIST()
1891 );
1892
1893 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear));
1894 }
1895 }
51a483f8 1896
1897 if (spec->flags & FLAG_CHECK_TARGS) {
1898 size_t i, lim, base;
1899
1900 base = 1;
1901 for (i = 0, lim = param_spec->positional_required.used; i < lim; i++) {
1902 Param *cur = &param_spec->positional_required.data[i];
1903
1904 if (cur->type) {
1905 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
1906 }
1907 }
1908 base += i;
1909
1910 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1911 Param *cur = &param_spec->positional_optional.data[i].param;
1912
1913 if (cur->type) {
1914 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
1915 }
1916 }
1917 base += i;
1918
1919 for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1920 Param *cur = &param_spec->named_required.data[i];
1921
1922 if (cur->type) {
1923 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
1924 }
1925 }
1926 base += i;
1927
1928 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1929 Param *cur = &param_spec->named_optional.data[i].param;
1930
1931 if (cur->type) {
1932 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
1933 }
1934 }
1935 base += i;
1936
1937 if (param_spec->slurpy.type) {
1938 /* $type->valid($_) or croak $type->get_message($_) for @rest / values %rest */
1939 OP *body, *list, *loop;
1940
1941 body = mktypecheck(aTHX_ declarator, base, param_spec->slurpy.name, NOT_IN_PAD, param_spec->slurpy.type);
1942
1943 if (SvPV_nolen(param_spec->slurpy.name)[0] == '@') {
1944 list = my_var_g(aTHX_ OP_PADAV, 0, param_spec->slurpy.padoff);
1945 } else {
1946 list = my_var_g(aTHX_ OP_PADHV, 0, param_spec->slurpy.padoff);
1947 list = newUNOP(OP_VALUES, 0, list);
1948 }
1949
1950 loop = newFOROP(0, NULL, list, body, NULL);
1951
1952 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, loop));
1953 }
1954 }
1e0f1595 1955 }
c311cef3 1956
1e0f1595 1957 /* finally let perl parse the actual subroutine body */
1958 body = parse_block(0);
c311cef3 1959
1e0f1595 1960 /* add '();' to make function return nothing by default */
1961 /* (otherwise the invisible parameter initialization can "leak" into
1962 the return value: fun ($x) {}->("asdf", 0) == 2) */
1963 if (*prelude_sentinel) {
1964 body = newSTATEOP(0, NULL, body);
db81d362 1965 }
1966
1e0f1595 1967 body = op_append_list(OP_LINESEQ, *prelude_sentinel, body);
1968 *prelude_sentinel = NULL;
1969
c311cef3 1970 /* it's go time. */
1971 {
53c979f0 1972 CV *cv;
c311cef3 1973 OP *const attrs = *attrs_sentinel;
1974 *attrs_sentinel = NULL;
53c979f0 1975
c311cef3 1976 SvREFCNT_inc_simple_void(PL_compcv);
1977
63915d26 1978 /* close outer block: '}' */
1979 S_block_end(aTHX_ save_ix, body);
1980
53c979f0 1981 cv = newATTRSUB(
c311cef3 1982 floor_ix,
53c979f0 1983 saw_name ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)) : NULL,
c311cef3 1984 proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL,
1985 attrs,
1986 body
1987 );
53c979f0 1988
1989 register_info(aTHX_ PTR2UV(CvROOT(cv)), declarator, spec, param_spec);
1990
1991 if (saw_name) {
1992 *pop = newOP(OP_NULL, 0);
1993 return KEYWORD_PLUGIN_STMT;
1994 }
1995
1996 *pop = newUNOP(
1997 OP_REFGEN, 0,
1998 newSVOP(
1999 OP_ANONCODE, 0,
2000 (SV *)cv
2001 )
2002 );
2003 return KEYWORD_PLUGIN_EXPR;
db81d362 2004 }
db81d362 2005}
2006
2007static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) {
63915d26 2008 KWSpec spec;
db81d362 2009 int ret;
e4648f19 2010 Sentinel sen = { NULL };
db81d362 2011
e4648f19 2012 ENTER;
db81d362 2013 SAVETMPS;
2014
e4648f19 2015 SAVEDESTRUCTOR_X(sentinel_clear_void, sen);
2016
2017 if (kw_flags(aTHX_ sen, keyword_ptr, keyword_len, &spec)) {
2018 ret = parse_fun(aTHX_ sen, op_ptr, keyword_ptr, keyword_len, &spec);
db81d362 2019 } else {
7dd35535 2020 ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
db81d362 2021 }
2022
2023 FREETMPS;
e4648f19 2024 LEAVE;
db81d362 2025
2026 return ret;
2027}
2028
2029WARNINGS_RESET
2030
53c979f0 2031MODULE = Function::Parameters PACKAGE = Function::Parameters PREFIX = fp_
db81d362 2032PROTOTYPES: ENABLE
2033
53c979f0 2034UV
2035fp__cv_root(sv)
2036 SV * sv
2037 PREINIT:
2038 CV *cv;
2039 HV *hv;
2040 GV *gv;
2041 CODE:
2042 cv = sv_2cv(sv, &hv, &gv, 0);
2043 RETVAL = PTR2UV(cv ? CvROOT(cv) : NULL);
2044 OUTPUT:
2045 RETVAL
2046
db81d362 2047BOOT:
2048WARNINGS_ENABLE {
2049 HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);
426a4d69 2050 /**/
d8e5d540 2051 newCONSTSUB(stash, "FLAG_NAME_OK", newSViv(FLAG_NAME_OK));
2052 newCONSTSUB(stash, "FLAG_ANON_OK", newSViv(FLAG_ANON_OK));
63915d26 2053 newCONSTSUB(stash, "FLAG_DEFAULT_ARGS", newSViv(FLAG_DEFAULT_ARGS));
d8e5d540 2054 newCONSTSUB(stash, "FLAG_CHECK_NARGS", newSViv(FLAG_CHECK_NARGS));
2055 newCONSTSUB(stash, "FLAG_INVOCANT", newSViv(FLAG_INVOCANT));
e158cf8f 2056 newCONSTSUB(stash, "FLAG_NAMED_PARAMS", newSViv(FLAG_NAMED_PARAMS));
51a483f8 2057 newCONSTSUB(stash, "FLAG_TYPES_OK", newSViv(FLAG_TYPES_OK));
2058 newCONSTSUB(stash, "FLAG_CHECK_TARGS", newSViv(FLAG_CHECK_TARGS));
db81d362 2059 newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS));
d8e5d540 2060 newCONSTSUB(stash, "HINTK_FLAGS_", newSVpvs(HINTK_FLAGS_));
2061 newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_));
2062 newCONSTSUB(stash, "HINTK_ATTRS_", newSVpvs(HINTK_ATTRS_));
426a4d69 2063 /**/
db81d362 2064 next_keyword_plugin = PL_keyword_plugin;
2065 PL_keyword_plugin = my_keyword_plugin;
2066} WARNINGS_RESET
Unnamed repository; edit this file to name it for gitweb.