projects / p5sagit/Function-Parameters.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
add Moose tests and make them pass
[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;
286 d = uvchr_to_utf8(ds, c);
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 {
1325 if (param_spec->positional_optional.used) {
1326 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));
1327 }
d8e5d540 1328
e158cf8f 1329 Param *p = pv_extend(&param_spec->named_required);
1330 p->name = name;
1331 p->padoff = padoff;
51a483f8 1332 p->type = type;
e158cf8f 1333 param_spec->named_required.used++;
1334 }
1335 } else {
1336 if (*init_sentinel || param_spec->positional_optional.used) {
1337 ParamInit *pi = piv_extend(&param_spec->positional_optional);
1338 pi->param.name = name;
1339 pi->param.padoff = padoff;
51a483f8 1340 pi->param.type = type;
e158cf8f 1341 pi->init = *init_sentinel;
1342 *init_sentinel = NULL;
1343 param_spec->positional_optional.used++;
1344 } else {
1345 Param *p = pv_extend(&param_spec->positional_required);
1346 p->name = name;
1347 p->padoff = padoff;
51a483f8 1348 p->type = type;
e158cf8f 1349 param_spec->positional_required.used++;
db81d362 1350 }
1351 }
1352
e158cf8f 1353 }
1354 lex_read_unichar(0);
1355 lex_read_space(0);
1356 *init_sentinel = NULL;
db81d362 1357
e158cf8f 1358 if (!param_spec->invocant.name && SvTRUE(spec->shift)) {
1359 if (ps_contains(aTHX_ param_spec, spec->shift)) {
1360 croak("In %"SVf": %"SVf" can't appear twice in the same parameter list", SVfARG(declarator), SVfARG(spec->shift));
db81d362 1361 }
e158cf8f 1362
1363 param_spec->invocant.name = spec->shift;
1364 param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL);
db81d362 1365 }
1366 }
1367
1368 /* prototype */
c311cef3 1369 proto = NULL;
db81d362 1370 c = lex_peek_unichar(0);
1371 if (c == ':') {
1372 lex_read_unichar(0);
1373 lex_read_space(0);
1374
1375 c = lex_peek_unichar(0);
1376 if (c != '(') {
c311cef3 1377 lex_stuff_pvs(":", 0);
1378 c = ':';
db81d362 1379 } else {
31534187 1380 lex_read_unichar(0);
e4648f19 1381 if (!(proto = my_scan_parens_tail(aTHX_ sen, FALSE))) {
f34187b8 1382 croak("In %"SVf": prototype not terminated", SVfARG(declarator));
db81d362 1383 }
e4648f19 1384 my_check_prototype(aTHX_ sen, declarator, proto);
db81d362 1385 lex_read_space(0);
c311cef3 1386 c = lex_peek_unichar(0);
514bcaa6 1387 if (!(c == ':' || c == '{')) {
1388 lex_stuff_pvs(":", 0);
1389 c = ':';
1390 }
db81d362 1391 }
1392 }
1393
db81d362 1394 /* attributes */
c311cef3 1395 Newx(attrs_sentinel, 1, OP *);
1396 *attrs_sentinel = NULL;
51a483f8 1397 sentinel_register(sen, attrs_sentinel, free_ptr_op_void);
c311cef3 1398
63915d26 1399 if (c == ':' || c == '{') /* '}' - hi, vim */ {
c311cef3 1400
1401 /* kludge default attributes in */
1402 if (SvTRUE(spec->attrs) && SvPV_nolen(spec->attrs)[0] == ':') {
1403 lex_stuff_sv(spec->attrs, 0);
1404 c = ':';
1405 }
b72eb6ee 1406
db81d362 1407 if (c == ':') {
db81d362 1408 lex_read_unichar(0);
1409 lex_read_space(0);
db81d362 1410 c = lex_peek_unichar(0);
c311cef3 1411
1412 for (;;) {
1413 SV *attr;
1414
e4648f19 1415 if (!(attr = my_scan_word(aTHX_ sen, FALSE))) {
c311cef3 1416 break;
db81d362 1417 }
c311cef3 1418
db81d362 1419 lex_read_space(0);
1420 c = lex_peek_unichar(0);
c311cef3 1421
1422 if (c != '(') {
1423 if (sv_eq_pvs(attr, "lvalue")) {
1424 builtin_attrs |= MY_ATTR_LVALUE;
1425 attr = NULL;
1426 } else if (sv_eq_pvs(attr, "method")) {
1427 builtin_attrs |= MY_ATTR_METHOD;
1428 attr = NULL;
1429 }
1430 } else {
31534187 1431 SV *sv;
1432 lex_read_unichar(0);
e4648f19 1433 if (!(sv = my_scan_parens_tail(aTHX_ sen, TRUE))) {
c311cef3 1434 croak("In %"SVf": unterminated attribute parameter in attribute list", SVfARG(declarator));
1435 }
31534187 1436 sv_catpvs(attr, "(");
c311cef3 1437 sv_catsv(attr, sv);
31534187 1438 sv_catpvs(attr, ")");
c311cef3 1439
1440 lex_read_space(0);
1441 c = lex_peek_unichar(0);
1442 }
1443
1444 if (attr) {
fc634bba 1445 *attrs_sentinel = op_append_elem(OP_LIST, *attrs_sentinel, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(attr)));
c311cef3 1446 }
1447
1448 if (c == ':') {
1449 lex_read_unichar(0);
1450 lex_read_space(0);
1451 c = lex_peek_unichar(0);
1452 }
db81d362 1453 }
1454 }
1455 }
1456
1457 /* body */
63915d26 1458 if (c != '{') /* '}' - hi, vim */ {
85bc3fbd 1459 croak("In %"SVf": I was expecting a function body, not \"%c\"", SVfARG(declarator), (int)c);
db81d362 1460 }
c311cef3 1461
63915d26 1462 /* surprise predeclaration! */
1463 if (saw_name) {
1464 /* 'sub NAME (PROTO);' to make name/proto known to perl before it
1465 starts parsing the body */
1466 const I32 sub_ix = start_subparse(FALSE, 0);
1467 SAVEFREESV(PL_compcv);
1468
1469 SvREFCNT_inc_simple_void(PL_compcv);
1470
1471 newATTRSUB(
1472 sub_ix,
fc634bba 1473 mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(saw_name)),
1474 proto ? mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(proto)) : NULL,
63915d26 1475 NULL,
1476 NULL
1477 );
1478 }
1479
c311cef3 1480 if (builtin_attrs & MY_ATTR_LVALUE) {
1481 CvLVALUE_on(PL_compcv);
db81d362 1482 }
c311cef3 1483 if (builtin_attrs & MY_ATTR_METHOD) {
1484 CvMETHOD_on(PL_compcv);
1485 }
1486 if (builtin_attrs & MY_ATTR_SPECIAL) {
1487 CvSPECIAL_on(PL_compcv);
db81d362 1488 }
1489
e158cf8f 1490 /* check number of arguments */
1e0f1595 1491 if (spec->flags & FLAG_CHECK_NARGS) {
e158cf8f 1492 int amin, amax;
1493 size_t named;
abccbe86 1494
e158cf8f 1495 amin = args_min(aTHX_ param_spec, spec);
1496 if (amin > 0) {
51a483f8 1497 OP *chk, *cond, *err, *xcroak;
63915d26 1498
fc634bba 1499 err = mkconstsv(aTHX_ newSVpvf("Not enough arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amin));
1500 err = newBINOP(
1501 OP_CONCAT, 0,
1502 err,
1503 newAVREF(newGVOP(OP_GV, 0, PL_defgv))
1504 );
1505 err = newBINOP(
1506 OP_CONCAT, 0,
1507 err,
1508 mkconstpvs(")")
1509 );
63915d26 1510
51a483f8 1511 xcroak = newCVREF(OPf_WANT_SCALAR,
1512 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
1e0f1595 1513 err = newUNOP(OP_ENTERSUB, OPf_STACKED,
51a483f8 1514 op_append_elem(OP_LIST, err, xcroak));
63915d26 1515
1e0f1595 1516 cond = newBINOP(OP_LT, 0,
5f50e017 1517 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
fc634bba 1518 mkconstiv(aTHX_ amin));
1e0f1595 1519 chk = newLOGOP(OP_AND, 0, cond, err);
63915d26 1520
1e0f1595 1521 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
1522 }
abccbe86 1523
e158cf8f 1524 amax = args_max(param_spec);
1525 if (amax >= 0) {
51a483f8 1526 OP *chk, *cond, *err, *xcroak;
63915d26 1527
fc634bba 1528 err = mkconstsv(aTHX_ newSVpvf("Too many arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amax));
1529 err = newBINOP(
1530 OP_CONCAT, 0,
1531 err,
1532 newAVREF(newGVOP(OP_GV, 0, PL_defgv))
1533 );
1534 err = newBINOP(
1535 OP_CONCAT, 0,
1536 err,
1537 mkconstpvs(")")
1538 );
63915d26 1539
51a483f8 1540 xcroak = newCVREF(
fc634bba 1541 OPf_WANT_SCALAR,
1542 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1543 );
1e0f1595 1544 err = newUNOP(OP_ENTERSUB, OPf_STACKED,
51a483f8 1545 op_append_elem(OP_LIST, err, xcroak));
63915d26 1546
fc634bba 1547 cond = newBINOP(
1548 OP_GT, 0,
1549 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1550 mkconstiv(aTHX_ amax)
1551 );
1e0f1595 1552 chk = newLOGOP(OP_AND, 0, cond, err);
63915d26 1553
1e0f1595 1554 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
1555 }
e158cf8f 1556
1557 if (param_spec && (count_named_params(param_spec) || (param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%'))) {
51a483f8 1558 OP *chk, *cond, *err, *xcroak;
e158cf8f 1559 const UV fixed = count_positional_params(param_spec) + !!param_spec->invocant.name;
63915d26 1560
fc634bba 1561 err = mkconstsv(aTHX_ newSVpvf("Odd number of paired arguments for %"SVf"", SVfARG(declarator)));
63915d26 1562
51a483f8 1563 xcroak = newCVREF(
fc634bba 1564 OPf_WANT_SCALAR,
1565 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1566 );
1e0f1595 1567 err = newUNOP(OP_ENTERSUB, OPf_STACKED,
51a483f8 1568 op_append_elem(OP_LIST, err, xcroak));
63915d26 1569
1e0f1595 1570 cond = newBINOP(OP_GT, 0,
5f50e017 1571 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
fc634bba 1572 mkconstiv(aTHX_ fixed));
e158cf8f 1573 cond = newLOGOP(OP_AND, 0,
fc634bba 1574 cond,
1575 newBINOP(OP_MODULO, 0,
1576 fixed
1577 ? newBINOP(OP_SUBTRACT, 0,
1578 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1579 mkconstiv(aTHX_ fixed))
1580 : newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1581 mkconstiv(aTHX_ 2)));
1e0f1595 1582 chk = newLOGOP(OP_AND, 0, cond, err);
63915d26 1583
1e0f1595 1584 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk));
c311cef3 1585 }
1e0f1595 1586 }
c311cef3 1587
e158cf8f 1588 if (!param_spec) {
1589 /* my $invocant = shift; */
1590 if (SvTRUE(spec->shift)) {
1591 OP *var;
abccbe86 1592
e158cf8f 1593 var = my_var(
1594 aTHX_
1595 OPf_MOD | (OPpLVAL_INTRO << 8),
1596 pad_add_name_sv(spec->shift, 0, NULL, NULL)
1597 );
1598 var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
c311cef3 1599
e158cf8f 1600 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1601 }
1602 } else {
1603 /* my $invocant = shift; */
1604 if (param_spec->invocant.name) {
1605 OP *var;
c311cef3 1606
e158cf8f 1607 var = my_var(
1608 aTHX_
1609 OPf_MOD | (OPpLVAL_INTRO << 8),
1610 param_spec->invocant.padoff
1611 );
1612 var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
1e0f1595 1613
e158cf8f 1614 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
51a483f8 1615
1616 if (param_spec->invocant.type && (spec->flags & FLAG_CHECK_TARGS)) {
1617 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, 0, &param_spec->invocant)));
1618 }
c311cef3 1619 }
1620
e158cf8f 1621 /* my (...) = @_; */
1622 {
1623 OP *lhs;
1624 size_t i, lim;
63915d26 1625
e158cf8f 1626 lhs = NULL;
63915d26 1627
e158cf8f 1628 for (i = 0, lim = param_spec->positional_required.used; i < lim; i++) {
1629 OP *const var = my_var(
1630 aTHX_
1631 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1632 param_spec->positional_required.data[i].padoff
1633 );
1634 lhs = op_append_elem(OP_LIST, lhs, var);
1635 }
63915d26 1636
e158cf8f 1637 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1638 OP *const var = my_var(
1639 aTHX_
1640 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1641 param_spec->positional_optional.data[i].param.padoff
1642 );
1643 lhs = op_append_elem(OP_LIST, lhs, var);
1644 }
63915d26 1645
fc634bba 1646 {
1647 PADOFFSET padoff;
1648 I32 type;
1649 bool slurpy_hash;
1650
1651 /*
1652 * cases:
1653 * 1) no named params
1654 * 1.1) slurpy
1655 * => put it in
1656 * 1.2) no slurpy
1657 * => nop
1658 * 2) named params
1659 * 2.1) no slurpy
1660 * => synthetic %{rest}
1661 * 2.2) slurpy is a hash
1662 * => put it in
1663 * 2.3) slurpy is an array
1664 * => synthetic %{rest}
1665 * remember to declare array later
1666 */
1667
1668 slurpy_hash = param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%';
1669 if (!count_named_params(param_spec)) {
1670 if (param_spec->slurpy.name) {
1671 padoff = param_spec->slurpy.padoff;
1672 type = slurpy_hash ? OP_PADHV : OP_PADAV;
1673 } else {
1674 padoff = NOT_IN_PAD;
1675 type = OP_PADSV;
1676 }
1677 } else if (slurpy_hash) {
1678 padoff = param_spec->slurpy.padoff;
1679 type = OP_PADHV;
e158cf8f 1680 } else {
fc634bba 1681 padoff = param_spec->rest_hash = pad_add_name_pvs("%{rest}", 0, NULL, NULL);
1682 type = OP_PADHV;
1683 }
1684
1685 if (padoff != NOT_IN_PAD) {
e158cf8f 1686 OP *const var = my_var_g(
1687 aTHX_
fc634bba 1688 type,
e158cf8f 1689 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
fc634bba 1690 padoff
e158cf8f 1691 );
fc634bba 1692
e158cf8f 1693 lhs = op_append_elem(OP_LIST, lhs, var);
fc634bba 1694
1695 if (type == OP_PADHV) {
1696 param_spec->rest_hash = padoff;
1697 }
e158cf8f 1698 }
1699 }
63915d26 1700
e158cf8f 1701 if (lhs) {
1702 OP *rhs;
1703 lhs->op_flags |= OPf_PARENS;
1704 rhs = newAVREF(newGVOP(OP_GV, 0, PL_defgv));
1705
1706 *prelude_sentinel = op_append_list(
1707 OP_LINESEQ, *prelude_sentinel,
1708 newSTATEOP(
1709 0, NULL,
1710 newASSIGNOP(OPf_STACKED, lhs, 0, rhs)
1711 )
1712 );
1713 }
1714 }
63915d26 1715
fc634bba 1716 /* default positional arguments */
e158cf8f 1717 {
1718 size_t i, lim, req;
1719 OP *nest;
63915d26 1720
e158cf8f 1721 nest = NULL;
63915d26 1722
e158cf8f 1723 req = param_spec->positional_required.used;
1724 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1725 ParamInit *cur = &param_spec->positional_optional.data[i];
1726 OP *var, *cond;
63915d26 1727
e158cf8f 1728 cond = newBINOP(
1729 OP_LT, 0,
1730 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
fc634bba 1731 mkconstiv(aTHX_ req + i + 1)
e158cf8f 1732 );
63915d26 1733
e158cf8f 1734 var = my_var(aTHX_ 0, cur->param.padoff);
63915d26 1735
e158cf8f 1736 nest = op_append_list(
1737 OP_LINESEQ, nest,
1738 newASSIGNOP(OPf_STACKED, var, 0, cur->init)
1739 );
1740 cur->init = NULL;
1741 nest = newCONDOP(
1742 0,
1743 cond,
1744 nest,
1745 NULL
1746 );
1747 }
1e0f1595 1748
e158cf8f 1749 *prelude_sentinel = op_append_list(
1750 OP_LINESEQ, *prelude_sentinel,
1751 nest
1752 );
c311cef3 1753 }
1754
e158cf8f 1755 /* named parameters */
1756 if (count_named_params(param_spec)) {
fc634bba 1757 size_t i, lim;
1758
1759 assert(param_spec->rest_hash != NOT_IN_PAD);
1760
1761 for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1762 Param *cur = &param_spec->named_required.data[i];
1763 size_t n;
1764 char *p = SvPV(cur->name, n);
1765 OP *var, *cond;
1766
1767 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1768
1769 if (spec->flags & FLAG_CHECK_NARGS) {
51a483f8 1770 OP *xcroak, *msg;
fc634bba 1771
1772 var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1773 var = newUNOP(OP_DELETE, 0, var);
1774
1775 msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": missing named parameter: %.*s", SVfARG(declarator), (int)(n - 1), p + 1));
51a483f8 1776 xcroak = newCVREF(
fc634bba 1777 OPf_WANT_SCALAR,
1778 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1779 );
51a483f8 1780 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
fc634bba 1781
1782 cond = newUNOP(OP_EXISTS, 0, cond);
1783
51a483f8 1784 cond = newCONDOP(0, cond, var, xcroak);
fc634bba 1785 }
1786
1787 var = my_var(
1788 aTHX_
1789 OPf_MOD | (OPpLVAL_INTRO << 8),
1790 cur->padoff
1791 );
1792 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1793
1794 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1795 }
1796
1797 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1798 ParamInit *cur = &param_spec->named_optional.data[i];
1799 size_t n;
1800 char *p = SvPV(cur->param.name, n);
1801 OP *var, *cond;
1802
1803 var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1804 var = newUNOP(OP_DELETE, 0, var);
1805
1806 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1807 cond = newUNOP(OP_EXISTS, 0, cond);
1808
1809 cond = newCONDOP(0, cond, var, cur->init);
1810 cur->init = NULL;
1811
1812 var = my_var(
1813 aTHX_
1814 OPf_MOD | (OPpLVAL_INTRO << 8),
1815 cur->param.padoff
1816 );
1817 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1818
1819 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1820 }
1821
1822 if (!param_spec->slurpy.name) {
1823 if (spec->flags & FLAG_CHECK_NARGS) {
1824 /* croak if %{rest} */
51a483f8 1825 OP *xcroak, *cond, *keys, *msg;
fc634bba 1826
1827 keys = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1828 keys = newLISTOP(OP_SORT, 0, newOP(OP_PUSHMARK, 0), keys);
1829 {
1830 OP *first, *mid, *last;
1831
1832 last = keys;
1833
1834 mid = mkconstpvs(", ");
1835 mid->op_sibling = last;
1836
1837 first = newOP(OP_PUSHMARK, 0);
1838
1839 keys = newLISTOP(OP_JOIN, 0, first, mid);
1840 keys->op_targ = pad_alloc(OP_JOIN, SVs_PADTMP);
1841 ((LISTOP *)keys)->op_last = last;
1842 }
1843
1844 msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": no such named parameter: ", SVfARG(declarator)));
1845 msg = newBINOP(OP_CONCAT, 0, msg, keys);
1846
51a483f8 1847 xcroak = newCVREF(
fc634bba 1848 OPf_WANT_SCALAR,
1849 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1850 );
51a483f8 1851 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
fc634bba 1852
1853 cond = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
51a483f8 1854 xcroak = newCONDOP(0, cond, xcroak, NULL);
fc634bba 1855
51a483f8 1856 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, xcroak));
fc634bba 1857 } else {
1858 OP *clear;
1859
1860 clear = newASSIGNOP(
1861 OPf_STACKED,
1862 my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1863 0,
1864 newNULLLIST()
1865 );
1866
1867 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear));
1868 }
1869 } else if (param_spec->slurpy.padoff != param_spec->rest_hash) {
1870 OP *var, *clear;
1871
1872 assert(SvPV_nolen(param_spec->slurpy.name)[0] == '@');
1873
1874 var = my_var_g(
1875 aTHX_
1876 OP_PADAV,
1877 OPf_MOD | (OPpLVAL_INTRO << 8),
1878 param_spec->slurpy.padoff
1879 );
1880
1881 var = newASSIGNOP(OPf_STACKED, var, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1882
1883 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
1884
1885 clear = newASSIGNOP(
1886 OPf_STACKED,
1887 my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1888 0,
1889 newNULLLIST()
1890 );
1891
1892 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear));
1893 }
1894 }
51a483f8 1895
1896 if (spec->flags & FLAG_CHECK_TARGS) {
1897 size_t i, lim, base;
1898
1899 base = 1;
1900 for (i = 0, lim = param_spec->positional_required.used; i < lim; i++) {
1901 Param *cur = &param_spec->positional_required.data[i];
1902
1903 if (cur->type) {
1904 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
1905 }
1906 }
1907 base += i;
1908
1909 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1910 Param *cur = &param_spec->positional_optional.data[i].param;
1911
1912 if (cur->type) {
1913 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
1914 }
1915 }
1916 base += i;
1917
1918 for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1919 Param *cur = &param_spec->named_required.data[i];
1920
1921 if (cur->type) {
1922 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
1923 }
1924 }
1925 base += i;
1926
1927 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1928 Param *cur = &param_spec->named_optional.data[i].param;
1929
1930 if (cur->type) {
1931 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
1932 }
1933 }
1934 base += i;
1935
1936 if (param_spec->slurpy.type) {
1937 /* $type->valid($_) or croak $type->get_message($_) for @rest / values %rest */
1938 OP *body, *list, *loop;
1939
1940 body = mktypecheck(aTHX_ declarator, base, param_spec->slurpy.name, NOT_IN_PAD, param_spec->slurpy.type);
1941
1942 if (SvPV_nolen(param_spec->slurpy.name)[0] == '@') {
1943 list = my_var_g(aTHX_ OP_PADAV, 0, param_spec->slurpy.padoff);
1944 } else {
1945 list = my_var_g(aTHX_ OP_PADHV, 0, param_spec->slurpy.padoff);
1946 list = newUNOP(OP_VALUES, 0, list);
1947 }
1948
1949 loop = newFOROP(0, NULL, list, body, NULL);
1950
1951 *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, loop));
1952 }
1953 }
1e0f1595 1954 }
c311cef3 1955
1e0f1595 1956 /* finally let perl parse the actual subroutine body */
1957 body = parse_block(0);
c311cef3 1958
1e0f1595 1959 /* add '();' to make function return nothing by default */
1960 /* (otherwise the invisible parameter initialization can "leak" into
1961 the return value: fun ($x) {}->("asdf", 0) == 2) */
1962 if (*prelude_sentinel) {
1963 body = newSTATEOP(0, NULL, body);
db81d362 1964 }
1965
1e0f1595 1966 body = op_append_list(OP_LINESEQ, *prelude_sentinel, body);
1967 *prelude_sentinel = NULL;
1968
c311cef3 1969 /* it's go time. */
1970 {
53c979f0 1971 CV *cv;
c311cef3 1972 OP *const attrs = *attrs_sentinel;
1973 *attrs_sentinel = NULL;
53c979f0 1974
c311cef3 1975 SvREFCNT_inc_simple_void(PL_compcv);
1976
63915d26 1977 /* close outer block: '}' */
1978 S_block_end(aTHX_ save_ix, body);
1979
53c979f0 1980 cv = newATTRSUB(
c311cef3 1981 floor_ix,
53c979f0 1982 saw_name ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)) : NULL,
c311cef3 1983 proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL,
1984 attrs,
1985 body
1986 );
53c979f0 1987
1988 register_info(aTHX_ PTR2UV(CvROOT(cv)), declarator, spec, param_spec);
1989
1990 if (saw_name) {
1991 *pop = newOP(OP_NULL, 0);
1992 return KEYWORD_PLUGIN_STMT;
1993 }
1994
1995 *pop = newUNOP(
1996 OP_REFGEN, 0,
1997 newSVOP(
1998 OP_ANONCODE, 0,
1999 (SV *)cv
2000 )
2001 );
2002 return KEYWORD_PLUGIN_EXPR;
db81d362 2003 }
db81d362 2004}
2005
2006static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) {
63915d26 2007 KWSpec spec;
db81d362 2008 int ret;
e4648f19 2009 Sentinel sen = { NULL };
db81d362 2010
e4648f19 2011 ENTER;
db81d362 2012 SAVETMPS;
2013
e4648f19 2014 SAVEDESTRUCTOR_X(sentinel_clear_void, sen);
2015
2016 if (kw_flags(aTHX_ sen, keyword_ptr, keyword_len, &spec)) {
2017 ret = parse_fun(aTHX_ sen, op_ptr, keyword_ptr, keyword_len, &spec);
db81d362 2018 } else {
7dd35535 2019 ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
db81d362 2020 }
2021
2022 FREETMPS;
e4648f19 2023 LEAVE;
db81d362 2024
2025 return ret;
2026}
2027
2028WARNINGS_RESET
2029
53c979f0 2030MODULE = Function::Parameters PACKAGE = Function::Parameters PREFIX = fp_
db81d362 2031PROTOTYPES: ENABLE
2032
53c979f0 2033UV
2034fp__cv_root(sv)
2035 SV * sv
2036 PREINIT:
2037 CV *cv;
2038 HV *hv;
2039 GV *gv;
2040 CODE:
2041 cv = sv_2cv(sv, &hv, &gv, 0);
2042 RETVAL = PTR2UV(cv ? CvROOT(cv) : NULL);
2043 OUTPUT:
2044 RETVAL
2045
db81d362 2046BOOT:
2047WARNINGS_ENABLE {
2048 HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);
426a4d69 2049 /**/
d8e5d540 2050 newCONSTSUB(stash, "FLAG_NAME_OK", newSViv(FLAG_NAME_OK));
2051 newCONSTSUB(stash, "FLAG_ANON_OK", newSViv(FLAG_ANON_OK));
63915d26 2052 newCONSTSUB(stash, "FLAG_DEFAULT_ARGS", newSViv(FLAG_DEFAULT_ARGS));
d8e5d540 2053 newCONSTSUB(stash, "FLAG_CHECK_NARGS", newSViv(FLAG_CHECK_NARGS));
2054 newCONSTSUB(stash, "FLAG_INVOCANT", newSViv(FLAG_INVOCANT));
e158cf8f 2055 newCONSTSUB(stash, "FLAG_NAMED_PARAMS", newSViv(FLAG_NAMED_PARAMS));
51a483f8 2056 newCONSTSUB(stash, "FLAG_TYPES_OK", newSViv(FLAG_TYPES_OK));
2057 newCONSTSUB(stash, "FLAG_CHECK_TARGS", newSViv(FLAG_CHECK_TARGS));
db81d362 2058 newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS));
d8e5d540 2059 newCONSTSUB(stash, "HINTK_FLAGS_", newSVpvs(HINTK_FLAGS_));
2060 newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_));
2061 newCONSTSUB(stash, "HINTK_ATTRS_", newSVpvs(HINTK_ATTRS_));
426a4d69 2062 /**/
db81d362 2063 next_keyword_plugin = PL_keyword_plugin;
2064 PL_keyword_plugin = my_keyword_plugin;
2065} WARNINGS_RESET
Unnamed repository; edit this file to name it for gitweb.