projects / p5sagit/Function-Parameters.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
version bump (developer release)
[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
e4648f19 160static int kw_flags(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len, KWSpec *spec) {
db81d362 161 HV *hints;
162 SV *sv, **psv;
163 const char *p, *kw_active;
164 STRLEN kw_active_len;
165
63915d26 166 spec->flags = 0;
e4648f19 167 spec->shift = sentinel_mortalize(sen, newSVpvs(""));
168 spec->attrs = sentinel_mortalize(sen, newSVpvs(""));
db81d362 169
170 if (!(hints = GvHV(PL_hintgv))) {
171 return FALSE;
172 }
173 if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) {
174 return FALSE;
175 }
176 sv = *psv;
177 kw_active = SvPV(sv, kw_active_len);
178 if (kw_active_len <= kw_len) {
179 return FALSE;
180 }
e88490f6 181 for (
182 p = kw_active;
183 (p = strchr(p, *kw_ptr)) &&
184 p < kw_active + kw_active_len - kw_len;
185 p++
186 ) {
db81d362 187 if (
188 (p == kw_active || p[-1] == ' ') &&
189 p[kw_len] == ' ' &&
190 memcmp(kw_ptr, p, kw_len) == 0
191 ) {
b72eb6ee 192
d970c3e7 193#define FETCH_HINTK_INTO(NAME, PTR, LEN, X) STMT_START { \
b72eb6ee 194 const char *fk_ptr_; \
195 STRLEN fk_len_; \
196 SV *fk_sv_; \
e4648f19 197 fk_sv_ = sentinel_mortalize(sen, newSVpvs(HINTK_ ## NAME)); \
b72eb6ee 198 sv_catpvn(fk_sv_, PTR, LEN); \
199 fk_ptr_ = SvPV(fk_sv_, fk_len_); \
200 if (!((X) = hv_fetch(hints, fk_ptr_, fk_len_, 0))) { \
201 croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)fk_len_, fk_ptr_); \
202 } \
d970c3e7 203} STMT_END
b72eb6ee 204
63915d26 205 FETCH_HINTK_INTO(FLAGS_, kw_ptr, kw_len, psv);
206 spec->flags = SvIV(*psv);
db81d362 207
b72eb6ee 208 FETCH_HINTK_INTO(SHIFT_, kw_ptr, kw_len, psv);
209 SvSetSV(spec->shift, *psv);
db81d362 210
b72eb6ee 211 FETCH_HINTK_INTO(ATTRS_, kw_ptr, kw_len, psv);
212 SvSetSV(spec->attrs, *psv);
213
214#undef FETCH_HINTK_INTO
db81d362 215 return TRUE;
216 }
217 }
218 return FALSE;
219}
220
221
ed95eeff 222#if HAVE_PERL_VERSION(5, 17, 2)
223 #define MY_OP_SLABBED(O) ((O)->op_slabbed)
224#else
225 #define MY_OP_SLABBED(O) 0
226#endif
227
228DEFSTRUCT(OpGuard) {
229 OP *op;
230 bool needs_freed;
231};
232
233static void op_guard_init(OpGuard *p) {
234 p->op = NULL;
235 p->needs_freed = FALSE;
236}
237
238static OpGuard op_guard_transfer(OpGuard *p) {
239 OpGuard r = *p;
240 op_guard_init(p);
241 return r;
242}
243
244static OP *op_guard_relinquish(OpGuard *p) {
245 OP *o = p->op;
246 op_guard_init(p);
247 return o;
248}
249
250static void op_guard_update(OpGuard *p, OP *o) {
251 p->op = o;
252 p->needs_freed = o && !MY_OP_SLABBED(o);
253}
254
255static void op_guard_clear(pTHX_ OpGuard *p) {
256 if (p->needs_freed) {
257 op_free(p->op);
258 }
259}
260
261static void free_op_guard_void(pTHX_ void *vp) {
262 OpGuard *p = vp;
263 op_guard_clear(aTHX_ p);
264 Safefree(p);
c311cef3 265}
266
51a483f8 267static void free_op_void(pTHX_ void *vp) {
268 OP *p = vp;
269 op_free(p);
270}
271
59016bfb 272#define sv_eq_pvs(SV, S) my_sv_eq_pvn(aTHX_ SV, "" S "", sizeof (S) - 1)
c311cef3 273
59016bfb 274static int my_sv_eq_pvn(pTHX_ SV *sv, const char *p, STRLEN n) {
c311cef3 275 STRLEN sv_len;
276 const char *sv_p = SvPV(sv, sv_len);
59016bfb 277 return memcmp(sv_p, p, n) == 0;
c311cef3 278}
279
280
281#include "padop_on_crack.c.inc"
282
283
c311cef3 284enum {
285 MY_ATTR_LVALUE = 0x01,
286 MY_ATTR_METHOD = 0x02,
287 MY_ATTR_SPECIAL = 0x04
288};
289
31534187 290static void my_sv_cat_c(pTHX_ SV *sv, U32 c) {
291 char ds[UTF8_MAXBYTES + 1], *d;
67fc1ddb 292 d = (char *)uvchr_to_utf8((U8 *)ds, c);
31534187 293 if (d - ds > 1) {
294 sv_utf8_upgrade(sv);
295 }
296 sv_catpvn(sv, ds, d - ds);
297}
298
31534187 299
e6d62383 300#define MY_UNI_IDFIRST(C) isIDFIRST_uni(C)
301#define MY_UNI_IDCONT(C) isALNUM_uni(C)
31534187 302
e4648f19 303static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) {
31534187 304 bool at_start, at_substart;
305 I32 c;
e4648f19 306 SV *sv = sentinel_mortalize(sen, newSVpvs(""));
31534187 307 if (lex_bufutf8()) {
308 SvUTF8_on(sv);
309 }
310
311 at_start = at_substart = TRUE;
312 c = lex_peek_unichar(0);
313
314 while (c != -1) {
e6d62383 315 if (at_substart ? MY_UNI_IDFIRST(c) : MY_UNI_IDCONT(c)) {
31534187 316 lex_read_unichar(0);
317 my_sv_cat_c(aTHX_ sv, c);
318 at_substart = FALSE;
319 c = lex_peek_unichar(0);
320 } else if (allow_package && !at_substart && c == '\'') {
321 lex_read_unichar(0);
322 c = lex_peek_unichar(0);
e6d62383 323 if (!MY_UNI_IDFIRST(c)) {
31534187 324 lex_stuff_pvs("'", 0);
325 break;
326 }
327 sv_catpvs(sv, "'");
328 at_substart = TRUE;
329 } else if (allow_package && (at_start || !at_substart) && c == ':') {
330 lex_read_unichar(0);
331 if (lex_peek_unichar(0) != ':') {
332 lex_stuff_pvs(":", 0);
333 break;
334 }
335 lex_read_unichar(0);
336 c = lex_peek_unichar(0);
e6d62383 337 if (!MY_UNI_IDFIRST(c)) {
31534187 338 lex_stuff_pvs("::", 0);
339 break;
340 }
341 sv_catpvs(sv, "::");
342 at_substart = TRUE;
343 } else {
344 break;
345 }
346 at_start = FALSE;
347 }
348
349 return SvCUR(sv) ? sv : NULL;
350}
351
e4648f19 352static SV *my_scan_parens_tail(pTHX_ Sentinel sen, bool keep_backslash) {
31534187 353 I32 c, nesting;
354 SV *sv;
355 line_t start;
356
357 start = CopLINE(PL_curcop);
358
e4648f19 359 sv = sentinel_mortalize(sen, newSVpvs(""));
31534187 360 if (lex_bufutf8()) {
361 SvUTF8_on(sv);
362 }
363
364 nesting = 0;
365 for (;;) {
366 c = lex_read_unichar(0);
367 if (c == EOF) {
368 CopLINE_set(PL_curcop, start);
369 return NULL;
370 }
371
372 if (c == '\\') {
373 c = lex_read_unichar(0);
374 if (c == EOF) {
375 CopLINE_set(PL_curcop, start);
376 return NULL;
377 }
378 if (keep_backslash || (c != '(' && c != ')')) {
379 sv_catpvs(sv, "\\");
380 }
381 } else if (c == '(') {
382 nesting++;
383 } else if (c == ')') {
384 if (!nesting) {
385 break;
386 }
387 nesting--;
388 }
389
390 my_sv_cat_c(aTHX_ sv, c);
391 }
392
393 return sv;
394}
395
e4648f19 396static void my_check_prototype(pTHX_ Sentinel sen, const SV *declarator, SV *proto) {
31534187 397 char *start, *r, *w, *end;
398 STRLEN len;
399
400 /* strip spaces */
401 start = SvPV(proto, len);
402 end = start + len;
403
404 for (w = r = start; r < end; r++) {
405 if (!isSPACE(*r)) {
406 *w++ = *r;
407 }
408 }
409 *w = '\0';
410 SvCUR_set(proto, w - start);
411 end = w;
412 len = end - start;
413
414 if (!ckWARN(WARN_ILLEGALPROTO)) {
415 return;
416 }
417
418 /* check for bad characters */
419 if (strspn(start, "$@%*;[]&\\_+") != len) {
e4648f19 420 SV *dsv = sentinel_mortalize(sen, newSVpvs(""));
31534187 421 warner(
422 packWARN(WARN_ILLEGALPROTO),
423 "Illegal character in prototype for %"SVf" : %s",
424 SVfARG(declarator),
425 SvUTF8(proto)
426 ? sv_uni_display(
427 dsv,
428 proto,
429 len,
430 UNI_DISPLAY_ISPRINT
431 )
432 : pv_pretty(dsv, start, len, 60, NULL, NULL,
433 PERL_PV_ESCAPE_NONASCII
434 )
435 );
436 return;
437 }
438
439 for (r = start; r < end; r++) {
440 switch (*r) {
441 default:
442 warner(
443 packWARN(WARN_ILLEGALPROTO),
444 "Illegal character in prototype for %"SVf" : %s",
445 SVfARG(declarator), r
446 );
447 return;
448
449 case '_':
450 if (r[1] && !strchr(";@%", *r)) {
451 warner(
452 packWARN(WARN_ILLEGALPROTO),
453 "Illegal character after '_' in prototype for %"SVf" : %s",
454 SVfARG(declarator), r
455 );
456 return;
457 }
458 break;
459
460 case '@':
461 case '%':
462 if (r[1]) {
463 warner(
464 packWARN(WARN_ILLEGALPROTO),
465 "prototype after '%c' for %"SVf": %s",
466 *r, SVfARG(declarator), r + 1
467 );
468 return;
469 }
470 break;
471
472 case '\\':
473 r++;
474 if (strchr("$@%&*", *r)) {
475 break;
476 }
477 if (*r == '[') {
478 r++;
479 for (; r < end && *r != ']'; r++) {
480 if (!strchr("$@%&*", *r)) {
481 break;
482 }
483 }
484 if (*r == ']' && r[-1] != '[') {
485 break;
486 }
487 }
488 warner(
489 packWARN(WARN_ILLEGALPROTO),
490 "Illegal character after '\\' in prototype for %"SVf" : %s",
491 SVfARG(declarator), r
492 );
493 return;
494
495 case '$':
496 case '*':
497 case '&':
498 case ';':
499 case '+':
500 break;
501 }
502 }
503}
504
51a483f8 505static SV *parse_type(pTHX_ Sentinel, const SV *);
506
507static SV *parse_type_paramd(pTHX_ Sentinel sen, const SV *declarator) {
508 I32 c;
509 SV *t;
510
511 t = my_scan_word(aTHX_ sen, TRUE);
512 lex_read_space(0);
513
514 c = lex_peek_unichar(0);
515 if (c == '[') {
516 SV *u;
517
518 lex_read_unichar(0);
519 lex_read_space(0);
520 my_sv_cat_c(aTHX_ t, c);
521
522 u = parse_type(aTHX_ sen, declarator);
523 sv_catsv(t, u);
524
525 c = lex_peek_unichar(0);
526 if (c != ']') {
527 croak("In %"SVf": missing ']' after '%"SVf"'", SVfARG(declarator), SVfARG(t));
528 }
529 lex_read_unichar(0);
530 lex_read_space(0);
531
532 my_sv_cat_c(aTHX_ t, c);
533 }
534
535 return t;
536}
537
538static SV *parse_type(pTHX_ Sentinel sen, const SV *declarator) {
539 I32 c;
540 SV *t;
541
542 t = parse_type_paramd(aTHX_ sen, declarator);
543
544 c = lex_peek_unichar(0);
545 while (c == '|') {
546 SV *u;
547
548 lex_read_unichar(0);
549 lex_read_space(0);
550
551 my_sv_cat_c(aTHX_ t, c);
552 u = parse_type_paramd(aTHX_ sen, declarator);
553 sv_catsv(t, u);
554
555 c = lex_peek_unichar(0);
556 }
557
558 return t;
559}
560
561static SV *reify_type(pTHX_ Sentinel sen, const SV *declarator, SV *name) {
562 SV *t;
563 int n;
564 dSP;
565
566 ENTER;
567 SAVETMPS;
568
569 PUSHMARK(SP);
570 EXTEND(SP, 1);
571 PUSHs(name);
572 PUTBACK;
573
700071de 574 n = call_pv("Moose::Util::TypeConstraints::find_or_create_isa_type_constraint", G_SCALAR);
51a483f8 575 SPAGAIN;
576
577 assert(n == 1);
a8492ba4 578 /* don't warn about n being unused if assert() is compiled out */
579 n = n;
580
51a483f8 581 t = sentinel_mortalize(sen, SvREFCNT_inc(POPs));
582
583 PUTBACK;
584 FREETMPS;
585 LEAVE;
586
587 if (!SvTRUE(t)) {
588 croak("In %"SVf": undefined type '%"SVf"'", SVfARG(declarator), SVfARG(name));
589 }
590
591 return t;
592}
593
e158cf8f 594
595DEFSTRUCT(Param) {
596 SV *name;
597 PADOFFSET padoff;
51a483f8 598 SV *type;
e158cf8f 599};
600
601DEFSTRUCT(ParamInit) {
602 Param param;
ed95eeff 603 OpGuard init;
e158cf8f 604};
605
606#define VEC(B) B ## _Vec
607
608#define DEFVECTOR(B) DEFSTRUCT(VEC(B)) { \
609 B (*data); \
610 size_t used, size; \
611}
612
613DEFVECTOR(Param);
614DEFVECTOR(ParamInit);
615
616#define DEFVECTOR_INIT(N, B) static void N(VEC(B) *p) { \
617 p->used = 0; \
618 p->size = 23; \
619 Newx(p->data, p->size, B); \
620} static void N(VEC(B) *)
621
622DEFSTRUCT(ParamSpec) {
623 Param invocant;
624 VEC(Param) positional_required;
625 VEC(ParamInit) positional_optional;
626 VEC(Param) named_required;
627 VEC(ParamInit) named_optional;
628 Param slurpy;
fc634bba 629 PADOFFSET rest_hash;
e158cf8f 630};
631
632DEFVECTOR_INIT(pv_init, Param);
633DEFVECTOR_INIT(piv_init, ParamInit);
634
635static void p_init(Param *p) {
636 p->name = NULL;
637 p->padoff = NOT_IN_PAD;
51a483f8 638 p->type = NULL;
e158cf8f 639}
640
641static void ps_init(ParamSpec *ps) {
642 p_init(&ps->invocant);
643 pv_init(&ps->positional_required);
644 piv_init(&ps->positional_optional);
645 pv_init(&ps->named_required);
646 piv_init(&ps->named_optional);
647 p_init(&ps->slurpy);
fc634bba 648 ps->rest_hash = NOT_IN_PAD;
e158cf8f 649}
650
651#define DEFVECTOR_EXTEND(N, B) static B (*N(VEC(B) *p)) { \
652 assert(p->used <= p->size); \
653 if (p->used == p->size) { \
654 const size_t n = p->size / 2 * 3 + 1; \
655 Renew(p->data, n, B); \
656 p->size = n; \
657 } \
658 return &p->data[p->used]; \
659} static B (*N(VEC(B) *))
660
661DEFVECTOR_EXTEND(pv_extend, Param);
662DEFVECTOR_EXTEND(piv_extend, ParamInit);
663
664#define DEFVECTOR_CLEAR(N, B, F) static void N(pTHX_ VEC(B) *p) { \
665 while (p->used) { \
666 p->used--; \
667 F(aTHX_ &p->data[p->used]); \
668 } \
669 Safefree(p->data); \
670 p->data = NULL; \
671 p->size = 0; \
672} static void N(pTHX_ VEC(B) *)
673
674static void p_clear(pTHX_ Param *p) {
675 p->name = NULL;
676 p->padoff = NOT_IN_PAD;
51a483f8 677 p->type = NULL;
e158cf8f 678}
679
680static void pi_clear(pTHX_ ParamInit *pi) {
681 p_clear(aTHX_ &pi->param);
ed95eeff 682 op_guard_clear(aTHX_ &pi->init);
e158cf8f 683}
684
685DEFVECTOR_CLEAR(pv_clear, Param, p_clear);
686DEFVECTOR_CLEAR(piv_clear, ParamInit, pi_clear);
687
688static void ps_clear(pTHX_ ParamSpec *ps) {
689 p_clear(aTHX_ &ps->invocant);
690
691 pv_clear(aTHX_ &ps->positional_required);
692 piv_clear(aTHX_ &ps->positional_optional);
693
694 pv_clear(aTHX_ &ps->named_required);
695 piv_clear(aTHX_ &ps->named_optional);
696
697 p_clear(aTHX_ &ps->slurpy);
698}
699
700static int ps_contains(pTHX_ const ParamSpec *ps, SV *sv) {
701 size_t i, lim;
702
703 if (ps->invocant.name && sv_eq(sv, ps->invocant.name)) {
704 return 1;
705 }
706
707 for (i = 0, lim = ps->positional_required.used; i < lim; i++) {
708 if (sv_eq(sv, ps->positional_required.data[i].name)) {
709 return 1;
710 }
711 }
712
713 for (i = 0, lim = ps->positional_optional.used; i < lim; i++) {
714 if (sv_eq(sv, ps->positional_optional.data[i].param.name)) {
715 return 1;
716 }
717 }
718
719 for (i = 0, lim = ps->named_required.used; i < lim; i++) {
720 if (sv_eq(sv, ps->named_required.data[i].name)) {
721 return 1;
722 }
723 }
724
725 for (i = 0, lim = ps->named_optional.used; i < lim; i++) {
726 if (sv_eq(sv, ps->named_optional.data[i].param.name)) {
727 return 1;
728 }
729 }
730
731 return 0;
732}
733
734static void ps_free_void(pTHX_ void *p) {
735 ps_clear(aTHX_ p);
736 Safefree(p);
737}
738
739static int args_min(pTHX_ const ParamSpec *ps, const KWSpec *ks) {
740 int n = 0;
741 if (!ps) {
742 return SvTRUE(ks->shift) ? 1 : 0;
743 }
744 if (ps->invocant.name) {
745 n++;
746 }
747 n += ps->positional_required.used;
748 n += ps->named_required.used * 2;
749 return n;
750}
751
752static int args_max(const ParamSpec *ps) {
753 int n = 0;
754 if (!ps) {
755 return -1;
756 }
757 if (ps->invocant.name) {
758 n++;
759 }
760 n += ps->positional_required.used;
761 n += ps->positional_optional.used;
762 if (ps->named_required.used || ps->named_optional.used || ps->slurpy.name) {
763 n = -1;
764 }
765 return n;
766}
767
768static size_t count_positional_params(const ParamSpec *ps) {
769 return ps->positional_required.used + ps->positional_optional.used;
770}
771
772static size_t count_named_params(const ParamSpec *ps) {
773 return ps->named_required.used + ps->named_optional.used;
774}
775
51a483f8 776static void my_require(pTHX_ const char *file) {
777 require_pv(file);
778 if (SvTRUE(ERRSV)) {
779 croak_sv(ERRSV);
780 }
781}
782
783static SV *my_eval(pTHX_ Sentinel sen, I32 floor, OP *op) {
784 SV *sv;
785 CV *cv;
786 dSP;
787
788 cv = newATTRSUB(floor, NULL, NULL, NULL, op);
789
790 ENTER;
791 SAVETMPS;
792
793 PUSHMARK(SP);
794 call_sv((SV *)cv, G_SCALAR | G_NOARGS);
795 SPAGAIN;
796 sv = sentinel_mortalize(sen, SvREFCNT_inc(POPs));
797
798 PUTBACK;
799 FREETMPS;
800 LEAVE;
801
802 return sv;
803}
804
e158cf8f 805enum {
806 PARAM_INVOCANT = 0x01,
807 PARAM_NAMED = 0x02
808};
809
e158cf8f 810static PADOFFSET parse_param(
811 pTHX_
e4648f19 812 Sentinel sen,
e158cf8f 813 const SV *declarator, const KWSpec *spec, ParamSpec *param_spec,
ed95eeff 814 int *pflags, SV **pname, OpGuard *ginit, SV **ptype
e158cf8f 815) {
816 I32 c;
817 char sigil;
a4c13d40 818 SV *name;
e158cf8f 819
ed95eeff 820 assert(!ginit->op);
e158cf8f 821 *pflags = 0;
51a483f8 822 *ptype = NULL;
e158cf8f 823
824 c = lex_peek_unichar(0);
825
51a483f8 826 if (spec->flags & FLAG_TYPES_OK) {
827 if (c == '(') {
828 I32 floor;
829 OP *expr;
a4c13d40 830 Resource *expr_sentinel;
51a483f8 831
832 lex_read_unichar(0);
833
a4c13d40 834 floor = start_subparse(FALSE, 0);
835 SAVEFREESV(PL_compcv);
836 CvSPECIAL_on(PL_compcv);
51a483f8 837
838 if (!(expr = parse_fullexpr(PARSE_OPTIONAL))) {
839 croak("In %"SVf": invalid type expression", SVfARG(declarator));
840 }
ed95eeff 841 if (MY_OP_SLABBED(expr)) {
842 expr_sentinel = NULL;
843 } else {
844 expr_sentinel = sentinel_register(sen, expr, free_op_void);
845 }
51a483f8 846
847 lex_read_space(0);
848 c = lex_peek_unichar(0);
849 if (c != ')') {
850 croak("In %"SVf": missing ')' after type expression", SVfARG(declarator));
851 }
852 lex_read_unichar(0);
853 lex_read_space(0);
854
a4c13d40 855 SvREFCNT_inc_simple_void(PL_compcv);
ed95eeff 856 if (expr_sentinel) {
857 sentinel_disarm(expr_sentinel);
858 }
51a483f8 859 *ptype = my_eval(aTHX_ sen, floor, expr);
a4c13d40 860 *ptype = reify_type(aTHX_ sen, declarator, *ptype);
51a483f8 861 if (!sv_isobject(*ptype)) {
862 croak("In %"SVf": (%"SVf") doesn't look like a type object", SVfARG(declarator), SVfARG(*ptype));
863 }
864
865 c = lex_peek_unichar(0);
e6d62383 866 } else if (MY_UNI_IDFIRST(c)) {
a4c13d40 867 *ptype = parse_type(aTHX_ sen, declarator);
51a483f8 868 my_require(aTHX_ "Moose/Util/TypeConstraints.pm");
a4c13d40 869 *ptype = reify_type(aTHX_ sen, declarator, *ptype);
51a483f8 870
871 c = lex_peek_unichar(0);
872 }
873 }
874
e158cf8f 875 if (c == ':') {
876 lex_read_unichar(0);
877 lex_read_space(0);
878
879 *pflags |= PARAM_NAMED;
880
881 c = lex_peek_unichar(0);
882 }
883
884 if (c == -1) {
885 croak("In %"SVf": unterminated parameter list", SVfARG(declarator));
886 }
51a483f8 887
e158cf8f 888 if (!(c == '$' || c == '@' || c == '%')) {
889 croak("In %"SVf": unexpected '%c' in parameter list (expecting a sigil)", SVfARG(declarator), (int)c);
890 }
891
892 sigil = c;
893
894 lex_read_unichar(0);
895 lex_read_space(0);
896
e4648f19 897 if (!(name = my_scan_word(aTHX_ sen, FALSE))) {
e158cf8f 898 croak("In %"SVf": missing identifier after '%c'", SVfARG(declarator), sigil);
899 }
900 sv_insert(name, 0, 0, &sigil, 1);
901 *pname = name;
902
903 lex_read_space(0);
904 c = lex_peek_unichar(0);
905
906 if (c == '=') {
907 lex_read_unichar(0);
908 lex_read_space(0);
909
910
911 if (!param_spec->invocant.name && SvTRUE(spec->shift)) {
912 param_spec->invocant.name = spec->shift;
913 param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL);
914 }
915
ed95eeff 916 op_guard_update(ginit, parse_termexpr(0));
e158cf8f 917
918 lex_read_space(0);
919 c = lex_peek_unichar(0);
920 }
921
922 if (c == ':') {
923 *pflags |= PARAM_INVOCANT;
924 lex_read_unichar(0);
925 lex_read_space(0);
926 } else if (c == ',') {
927 lex_read_unichar(0);
928 lex_read_space(0);
929 } else if (c != ')') {
930 if (c == -1) {
931 croak("In %"SVf": unterminated parameter list", SVfARG(declarator));
932 }
933 croak("In %"SVf": unexpected '%c' in parameter list (expecting ',')", SVfARG(declarator), (int)c);
934 }
935
936 return pad_add_name_sv(*pname, IF_HAVE_PERL_5_16(padadd_NO_DUP_CHECK, 0), NULL, NULL);
937}
938
939static OP *my_var_g(pTHX_ I32 type, I32 flags, PADOFFSET padoff) {
940 OP *var = newOP(type, flags);
941 var->op_targ = padoff;
942 return var;
943}
944
945static OP *my_var(pTHX_ I32 flags, PADOFFSET padoff) {
946 return my_var_g(aTHX_ OP_PADSV, flags, padoff);
947}
948
fc634bba 949static OP *mkhvelem(pTHX_ PADOFFSET h, OP *k) {
950 OP *hv = my_var_g(aTHX_ OP_PADHV, OPf_REF, h);
951 return newBINOP(OP_HELEM, 0, hv, k);
952}
953
954static OP *mkconstsv(pTHX_ SV *sv) {
955 return newSVOP(OP_CONST, 0, sv);
956}
957
958static OP *mkconstiv(pTHX_ IV i) {
959 return mkconstsv(aTHX_ newSViv(i));
960}
961
962static OP *mkconstpv(pTHX_ const char *p, size_t n) {
963 return mkconstsv(aTHX_ newSVpv(p, n));
964}
965
966#define mkconstpvs(S) mkconstpv(aTHX_ "" S "", sizeof S - 1)
967
51a483f8 968static OP *mktypecheck(pTHX_ const SV *declarator, int nr, SV *name, PADOFFSET padoff, SV *type) {
969 /* $type->check($value) or Carp::croak "...: " . $type->get_message($value) */
a8492ba4 970 OP *chk, *err, *msg, *xcroak;
51a483f8 971
972 err = mkconstsv(aTHX_ newSVpvf("In %"SVf": parameter %d (%"SVf"): ", SVfARG(declarator), nr, SVfARG(name)));
973 {
974 OP *args = NULL;
975
976 args = op_append_elem(OP_LIST, args, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(type)));
977 args = op_append_elem(
978 OP_LIST, args,
979 padoff == NOT_IN_PAD
980 ? S_newDEFSVOP(aTHX)
981 : my_var(aTHX_ 0, padoff)
982 );
983 args = op_append_elem(OP_LIST, args, newUNOP(OP_METHOD, 0, mkconstpvs("get_message")));
984
985 msg = args;
986 msg->op_type = OP_ENTERSUB;
987 msg->op_ppaddr = PL_ppaddr[OP_ENTERSUB];
988 msg->op_flags |= OPf_STACKED;
989 }
990
991 msg = newBINOP(OP_CONCAT, 0, err, msg);
992
993 xcroak = newCVREF(
994 OPf_WANT_SCALAR,
995 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
996 );
997 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
998
999 {
1000 OP *args = NULL;
1001
1002 args = op_append_elem(OP_LIST, args, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(type)));
1003 args = op_append_elem(
1004 OP_LIST, args,
1005 padoff == NOT_IN_PAD
1006 ? S_newDEFSVOP(aTHX)
1007 : my_var(aTHX_ 0, padoff)
1008 );
1009 args = op_append_elem(OP_LIST, args, newUNOP(OP_METHOD, 0, mkconstpvs("check")));
1010
1011 chk = args;
1012 chk->op_type = OP_ENTERSUB;
1013 chk->op_ppaddr = PL_ppaddr[OP_ENTERSUB];
1014 chk->op_flags |= OPf_STACKED;
1015 }
1016
1017 chk = newLOGOP(OP_OR, 0, chk, xcroak);
1018 return chk;
1019}
1020
1021static OP *mktypecheckp(pTHX_ const SV *declarator, int nr, const Param *param) {
1022 return mktypecheck(aTHX_ declarator, nr, param->name, param->padoff, param->type);
1023}
1024
53c979f0 1025static void register_info(pTHX_ UV key, SV *declarator, const KWSpec *kws, const ParamSpec *ps) {
1026 dSP;
1027
1028 ENTER;
1029 SAVETMPS;
1030
1031 PUSHMARK(SP);
51a483f8 1032 EXTEND(SP, 10);
53c979f0 1033
1034 /* 0 */ {
1035 mPUSHu(key);
1036 }
1037 /* 1 */ {
1038 size_t n;
1039 char *p = SvPV(declarator, n);
1040 char *q = memchr(p, ' ', n);
79bce2d4 1041 mPUSHp(p, q ? (size_t)(q - p) : n);
53c979f0 1042 }
1043 if (!ps) {
1044 if (SvTRUE(kws->shift)) {
1045 PUSHs(kws->shift);
1046 } else {
1047 PUSHmortal;
1048 }
51a483f8 1049 PUSHmortal;
53c979f0 1050 mPUSHs(newRV_noinc((SV *)newAV()));
1051 mPUSHs(newRV_noinc((SV *)newAV()));
1052 mPUSHs(newRV_noinc((SV *)newAV()));
1053 mPUSHs(newRV_noinc((SV *)newAV()));
1054 mPUSHp("@_", 2);
51a483f8 1055 PUSHmortal;
53c979f0 1056 } else {
51a483f8 1057 /* 2, 3 */ {
53c979f0 1058 if (ps->invocant.name) {
1059 PUSHs(ps->invocant.name);
51a483f8 1060 if (ps->invocant.type) {
1061 PUSHs(ps->invocant.type);
1062 } else {
1063 PUSHmortal;
1064 }
53c979f0 1065 } else {
1066 PUSHmortal;
51a483f8 1067 PUSHmortal;
53c979f0 1068 }
1069 }
51a483f8 1070 /* 4 */ {
53c979f0 1071 size_t i, lim;
1072 AV *av;
1073
1074 lim = ps->positional_required.used;
1075
1076 av = newAV();
1077 if (lim) {
51a483f8 1078 av_extend(av, (lim - 1) * 2);
53c979f0 1079 for (i = 0; i < lim; i++) {
51a483f8 1080 Param *cur = &ps->positional_required.data[i];
1081 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1082 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1083 }
1084 }
1085
1086 mPUSHs(newRV_noinc((SV *)av));
1087 }
51a483f8 1088 /* 5 */ {
53c979f0 1089 size_t i, lim;
1090 AV *av;
1091
1092 lim = ps->positional_optional.used;
1093
1094 av = newAV();
1095 if (lim) {
51a483f8 1096 av_extend(av, (lim - 1) * 2);
53c979f0 1097 for (i = 0; i < lim; i++) {
51a483f8 1098 Param *cur = &ps->positional_optional.data[i].param;
1099 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1100 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1101 }
1102 }
1103
1104 mPUSHs(newRV_noinc((SV *)av));
1105 }
51a483f8 1106 /* 6 */ {
53c979f0 1107 size_t i, lim;
1108 AV *av;
1109
1110 lim = ps->named_required.used;
1111
1112 av = newAV();
1113 if (lim) {
51a483f8 1114 av_extend(av, (lim - 1) * 2);
53c979f0 1115 for (i = 0; i < lim; i++) {
51a483f8 1116 Param *cur = &ps->named_required.data[i];
1117 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1118 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1119 }
1120 }
1121
1122 mPUSHs(newRV_noinc((SV *)av));
1123 }
51a483f8 1124 /* 7 */ {
53c979f0 1125 size_t i, lim;
1126 AV *av;
1127
1128 lim = ps->named_optional.used;
1129
1130 av = newAV();
1131 if (lim) {
51a483f8 1132 av_extend(av, (lim - 1) * 2);
53c979f0 1133 for (i = 0; i < lim; i++) {
51a483f8 1134 Param *cur = &ps->named_optional.data[i].param;
1135 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1136 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1137 }
1138 }
1139
1140 mPUSHs(newRV_noinc((SV *)av));
1141 }
51a483f8 1142 /* 8, 9 */ {
53c979f0 1143 if (ps->slurpy.name) {
1144 PUSHs(ps->slurpy.name);
51a483f8 1145 if (ps->slurpy.type) {
1146 PUSHs(ps->slurpy.type);
1147 } else {
1148 PUSHmortal;
1149 }
53c979f0 1150 } else {
1151 PUSHmortal;
51a483f8 1152 PUSHmortal;
53c979f0 1153 }
1154 }
1155 }
1156 PUTBACK;
1157
1158 call_pv(MY_PKG "::_register_info", G_VOID);
1159
1160 FREETMPS;
1161 LEAVE;
1162}
1163
e4648f19 1164static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) {
e158cf8f 1165 ParamSpec *param_spec;
c311cef3 1166 SV *declarator;
1167 I32 floor_ix;
63915d26 1168 int save_ix;
c311cef3 1169 SV *saw_name;
ed95eeff 1170 OpGuard *prelude_sentinel;
c311cef3 1171 SV *proto;
ed95eeff 1172 OpGuard *attrs_sentinel;
1173 OP *body;
c311cef3 1174 unsigned builtin_attrs;
db81d362 1175 I32 c;
1176
e4648f19 1177 declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len));
db81d362 1178
db81d362 1179 lex_read_space(0);
1180
c311cef3 1181 builtin_attrs = 0;
1182
db81d362 1183 /* function name */
c311cef3 1184 saw_name = NULL;
e4648f19 1185 if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ sen, TRUE))) {
c311cef3 1186
1187 if (PL_parser->expect != XSTATE) {
1188 /* bail out early so we don't predeclare $saw_name */
1189 croak("In %"SVf": I was expecting a function body, not \"%"SVf"\"", SVfARG(declarator), SVfARG(saw_name));
1190 }
1191
db81d362 1192 sv_catpvs(declarator, " ");
c311cef3 1193 sv_catsv(declarator, saw_name);
1194
1195 if (
1196 sv_eq_pvs(saw_name, "BEGIN") ||
1197 sv_eq_pvs(saw_name, "END") ||
1198 sv_eq_pvs(saw_name, "INIT") ||
1199 sv_eq_pvs(saw_name, "CHECK") ||
1200 sv_eq_pvs(saw_name, "UNITCHECK")
1201 ) {
1202 builtin_attrs |= MY_ATTR_SPECIAL;
1203 }
1204
db81d362 1205 lex_read_space(0);
63915d26 1206 } else if (!(spec->flags & FLAG_ANON_OK)) {
31534187 1207 croak("I was expecting a function name, not \"%.*s\"", (int)(PL_parser->bufend - PL_parser->bufptr), PL_parser->bufptr);
db81d362 1208 } else {
1209 sv_catpvs(declarator, " (anon)");
1210 }
1211
63915d26 1212 /* we're a subroutine declaration */
c311cef3 1213 floor_ix = start_subparse(FALSE, saw_name ? 0 : CVf_ANON);
1214 SAVEFREESV(PL_compcv);
1215
63915d26 1216 /* create outer block: '{' */
1217 save_ix = S_block_start(aTHX_ TRUE);
1218
1e0f1595 1219 /* initialize synthetic optree */
ed95eeff 1220 Newx(prelude_sentinel, 1, OpGuard);
1221 op_guard_init(prelude_sentinel);
1222 sentinel_register(sen, prelude_sentinel, free_op_guard_void);
1e0f1595 1223
db81d362 1224 /* parameters */
e158cf8f 1225 param_spec = NULL;
63915d26 1226
db81d362 1227 c = lex_peek_unichar(0);
1228 if (c == '(') {
ed95eeff 1229 OpGuard *init_sentinel;
e158cf8f 1230
ed95eeff 1231 Newx(init_sentinel, 1, OpGuard);
1232 op_guard_init(init_sentinel);
1233 sentinel_register(sen, init_sentinel, free_op_guard_void);
e158cf8f 1234
1235 Newx(param_spec, 1, ParamSpec);
1236 ps_init(param_spec);
e4648f19 1237 sentinel_register(sen, param_spec, ps_free_void);
db81d362 1238
1239 lex_read_unichar(0);
1240 lex_read_space(0);
1241
e158cf8f 1242 while ((c = lex_peek_unichar(0)) != ')') {
1243 int flags;
51a483f8 1244 SV *name, *type;
e158cf8f 1245 char sigil;
1246 PADOFFSET padoff;
c311cef3 1247
51a483f8 1248 padoff = parse_param(aTHX_ sen, declarator, spec, param_spec, &flags, &name, init_sentinel, &type);
c311cef3 1249
e158cf8f 1250 S_intro_my(aTHX);
63915d26 1251
e158cf8f 1252 sigil = SvPV_nolen(name)[0];
db81d362 1253
e158cf8f 1254 /* internal consistency */
1255 if (flags & PARAM_NAMED) {
1256 if (flags & PARAM_INVOCANT) {
1257 croak("In %"SVf": invocant %"SVf" can't be a named parameter", SVfARG(declarator), SVfARG(name));
db81d362 1258 }
e158cf8f 1259 if (sigil != '$') {
1260 croak("In %"SVf": named parameter %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash");
db81d362 1261 }
e158cf8f 1262 } else if (flags & PARAM_INVOCANT) {
ed95eeff 1263 if (init_sentinel->op) {
e158cf8f 1264 croak("In %"SVf": invocant %"SVf" can't have a default value", SVfARG(declarator), SVfARG(name));
db81d362 1265 }
e158cf8f 1266 if (sigil != '$') {
1267 croak("In %"SVf": invocant %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash");
1268 }
ed95eeff 1269 } else if (sigil != '$' && init_sentinel->op) {
e158cf8f 1270 croak("In %"SVf": %s %"SVf" can't have a default value", SVfARG(declarator), sigil == '@' ? "array" : "hash", SVfARG(name));
1271 }
db81d362 1272
e158cf8f 1273 /* external constraints */
1274 if (param_spec->slurpy.name) {
1275 croak("In %"SVf": I was expecting \")\" after \"%"SVf"\", not \"%"SVf"\"", SVfARG(declarator), SVfARG(param_spec->slurpy.name), SVfARG(name));
1276 }
1277 if (sigil != '$') {
ed95eeff 1278 assert(!init_sentinel->op);
e158cf8f 1279 param_spec->slurpy.name = name;
1280 param_spec->slurpy.padoff = padoff;
51a483f8 1281 param_spec->slurpy.type = type;
e158cf8f 1282 continue;
1283 }
d8e5d540 1284
e158cf8f 1285 if (!(flags & PARAM_NAMED) && count_named_params(param_spec)) {
1286 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));
1287 }
d8e5d540 1288
e158cf8f 1289 if (flags & PARAM_INVOCANT) {
1290 if (param_spec->invocant.name) {
1291 croak("In %"SVf": invalid double invocants %"SVf", %"SVf"", SVfARG(declarator), SVfARG(param_spec->invocant.name), SVfARG(name));
1292 }
1293 if (count_positional_params(param_spec) || count_named_params(param_spec)) {
1294 croak("In %"SVf": invocant %"SVf" must be first in parameter list", SVfARG(declarator), SVfARG(name));
63915d26 1295 }
e158cf8f 1296 if (!(spec->flags & FLAG_INVOCANT)) {
1297 croak("In %"SVf": invocant %"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
1298 }
1299 param_spec->invocant.name = name;
1300 param_spec->invocant.padoff = padoff;
51a483f8 1301 param_spec->invocant.type = type;
e158cf8f 1302 continue;
1303 }
63915d26 1304
ed95eeff 1305 if (init_sentinel->op && !(spec->flags & FLAG_DEFAULT_ARGS)) {
e158cf8f 1306 croak("In %"SVf": default argument for %"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
1307 }
1e0f1595 1308
e158cf8f 1309 if (ps_contains(aTHX_ param_spec, name)) {
1310 croak("In %"SVf": %"SVf" can't appear twice in the same parameter list", SVfARG(declarator), SVfARG(name));
1311 }
1e0f1595 1312
e158cf8f 1313 if (flags & PARAM_NAMED) {
1314 if (!(spec->flags & FLAG_NAMED_PARAMS)) {
1315 croak("In %"SVf": named parameter :%"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
1e0f1595 1316 }
1317
ed95eeff 1318 if (init_sentinel->op) {
e158cf8f 1319 ParamInit *pi = piv_extend(&param_spec->named_optional);
1320 pi->param.name = name;
1321 pi->param.padoff = padoff;
51a483f8 1322 pi->param.type = type;
ed95eeff 1323 pi->init = op_guard_transfer(init_sentinel);
e158cf8f 1324 param_spec->named_optional.used++;
1325 } else {
67fc1ddb 1326 Param *p;
1327
e158cf8f 1328 if (param_spec->positional_optional.used) {
1329 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));
1330 }
d8e5d540 1331
67fc1ddb 1332 p = pv_extend(&param_spec->named_required);
e158cf8f 1333 p->name = name;
1334 p->padoff = padoff;
51a483f8 1335 p->type = type;
e158cf8f 1336 param_spec->named_required.used++;
1337 }
1338 } else {
ed95eeff 1339 if (init_sentinel->op || param_spec->positional_optional.used) {
e158cf8f 1340 ParamInit *pi = piv_extend(&param_spec->positional_optional);
1341 pi->param.name = name;
1342 pi->param.padoff = padoff;
51a483f8 1343 pi->param.type = type;
ed95eeff 1344 pi->init = op_guard_transfer(init_sentinel);
e158cf8f 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);
db81d362 1358
e158cf8f 1359 if (!param_spec->invocant.name && SvTRUE(spec->shift)) {
1360 if (ps_contains(aTHX_ param_spec, spec->shift)) {
1361 croak("In %"SVf": %"SVf" can't appear twice in the same parameter list", SVfARG(declarator), SVfARG(spec->shift));
db81d362 1362 }
e158cf8f 1363
1364 param_spec->invocant.name = spec->shift;
1365 param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL);
db81d362 1366 }
1367 }
1368
1369 /* prototype */
c311cef3 1370 proto = NULL;
db81d362 1371 c = lex_peek_unichar(0);
1372 if (c == ':') {
1373 lex_read_unichar(0);
1374 lex_read_space(0);
1375
1376 c = lex_peek_unichar(0);
1377 if (c != '(') {
c311cef3 1378 lex_stuff_pvs(":", 0);
1379 c = ':';
db81d362 1380 } else {
31534187 1381 lex_read_unichar(0);
e4648f19 1382 if (!(proto = my_scan_parens_tail(aTHX_ sen, FALSE))) {
f34187b8 1383 croak("In %"SVf": prototype not terminated", SVfARG(declarator));
db81d362 1384 }
e4648f19 1385 my_check_prototype(aTHX_ sen, declarator, proto);
db81d362 1386 lex_read_space(0);
c311cef3 1387 c = lex_peek_unichar(0);
514bcaa6 1388 if (!(c == ':' || c == '{')) {
1389 lex_stuff_pvs(":", 0);
1390 c = ':';
1391 }
db81d362 1392 }
1393 }
1394
db81d362 1395 /* attributes */
ed95eeff 1396 Newx(attrs_sentinel, 1, OpGuard);
1397 op_guard_init(attrs_sentinel);
1398 sentinel_register(sen, attrs_sentinel, free_op_guard_void);
c311cef3 1399
63915d26 1400 if (c == ':' || c == '{') /* '}' - hi, vim */ {
c311cef3 1401
1402 /* kludge default attributes in */
1403 if (SvTRUE(spec->attrs) && SvPV_nolen(spec->attrs)[0] == ':') {
1404 lex_stuff_sv(spec->attrs, 0);
1405 c = ':';
1406 }
b72eb6ee 1407
db81d362 1408 if (c == ':') {
db81d362 1409 lex_read_unichar(0);
1410 lex_read_space(0);
db81d362 1411 c = lex_peek_unichar(0);
c311cef3 1412
1413 for (;;) {
1414 SV *attr;
1415
e4648f19 1416 if (!(attr = my_scan_word(aTHX_ sen, FALSE))) {
c311cef3 1417 break;
db81d362 1418 }
c311cef3 1419
db81d362 1420 lex_read_space(0);
1421 c = lex_peek_unichar(0);
c311cef3 1422
1423 if (c != '(') {
1424 if (sv_eq_pvs(attr, "lvalue")) {
1425 builtin_attrs |= MY_ATTR_LVALUE;
1426 attr = NULL;
1427 } else if (sv_eq_pvs(attr, "method")) {
1428 builtin_attrs |= MY_ATTR_METHOD;
1429 attr = NULL;
1430 }
1431 } else {
31534187 1432 SV *sv;
1433 lex_read_unichar(0);
e4648f19 1434 if (!(sv = my_scan_parens_tail(aTHX_ sen, TRUE))) {
c311cef3 1435 croak("In %"SVf": unterminated attribute parameter in attribute list", SVfARG(declarator));
1436 }
31534187 1437 sv_catpvs(attr, "(");
c311cef3 1438 sv_catsv(attr, sv);
31534187 1439 sv_catpvs(attr, ")");
c311cef3 1440
1441 lex_read_space(0);
1442 c = lex_peek_unichar(0);
1443 }
1444
1445 if (attr) {
ed95eeff 1446 op_guard_update(attrs_sentinel, op_append_elem(OP_LIST, attrs_sentinel->op, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(attr))));
c311cef3 1447 }
1448
1449 if (c == ':') {
1450 lex_read_unichar(0);
1451 lex_read_space(0);
1452 c = lex_peek_unichar(0);
1453 }
db81d362 1454 }
1455 }
1456 }
1457
1458 /* body */
63915d26 1459 if (c != '{') /* '}' - hi, vim */ {
85bc3fbd 1460 croak("In %"SVf": I was expecting a function body, not \"%c\"", SVfARG(declarator), (int)c);
db81d362 1461 }
c311cef3 1462
63915d26 1463 /* surprise predeclaration! */
1464 if (saw_name) {
1465 /* 'sub NAME (PROTO);' to make name/proto known to perl before it
1466 starts parsing the body */
1467 const I32 sub_ix = start_subparse(FALSE, 0);
1468 SAVEFREESV(PL_compcv);
1469
1470 SvREFCNT_inc_simple_void(PL_compcv);
1471
1472 newATTRSUB(
1473 sub_ix,
fc634bba 1474 mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(saw_name)),
1475 proto ? mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(proto)) : NULL,
63915d26 1476 NULL,
1477 NULL
1478 );
1479 }
1480
c311cef3 1481 if (builtin_attrs & MY_ATTR_LVALUE) {
1482 CvLVALUE_on(PL_compcv);
db81d362 1483 }
c311cef3 1484 if (builtin_attrs & MY_ATTR_METHOD) {
1485 CvMETHOD_on(PL_compcv);
1486 }
1487 if (builtin_attrs & MY_ATTR_SPECIAL) {
1488 CvSPECIAL_on(PL_compcv);
db81d362 1489 }
1490
e158cf8f 1491 /* check number of arguments */
1e0f1595 1492 if (spec->flags & FLAG_CHECK_NARGS) {
e158cf8f 1493 int amin, amax;
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
ed95eeff 1521 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, chk)));
1e0f1595 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
ed95eeff 1554 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, chk)));
1e0f1595 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
ed95eeff 1584 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, 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
ed95eeff 1600 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
e158cf8f 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
ed95eeff 1614 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
51a483f8 1615
1616 if (param_spec->invocant.type && (spec->flags & FLAG_CHECK_TARGS)) {
ed95eeff 1617 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, 0, &param_spec->invocant))));
51a483f8 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
ed95eeff 1706 op_guard_update(prelude_sentinel, op_append_list(
1707 OP_LINESEQ, prelude_sentinel->op,
e158cf8f 1708 newSTATEOP(
1709 0, NULL,
1710 newASSIGNOP(OPf_STACKED, lhs, 0, rhs)
1711 )
ed95eeff 1712 ));
e158cf8f 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,
ed95eeff 1738 newASSIGNOP(OPf_STACKED, var, 0, op_guard_relinquish(&cur->init))
e158cf8f 1739 );
e158cf8f 1740 nest = newCONDOP(
1741 0,
1742 cond,
1743 nest,
1744 NULL
1745 );
1746 }
1e0f1595 1747
ed95eeff 1748 op_guard_update(prelude_sentinel, op_append_list(
1749 OP_LINESEQ, prelude_sentinel->op,
e158cf8f 1750 nest
ed95eeff 1751 ));
c311cef3 1752 }
1753
e158cf8f 1754 /* named parameters */
1755 if (count_named_params(param_spec)) {
fc634bba 1756 size_t i, lim;
1757
1758 assert(param_spec->rest_hash != NOT_IN_PAD);
1759
1760 for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1761 Param *cur = &param_spec->named_required.data[i];
1762 size_t n;
1763 char *p = SvPV(cur->name, n);
1764 OP *var, *cond;
1765
1766 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1767
1768 if (spec->flags & FLAG_CHECK_NARGS) {
51a483f8 1769 OP *xcroak, *msg;
fc634bba 1770
1771 var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1772 var = newUNOP(OP_DELETE, 0, var);
1773
1774 msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": missing named parameter: %.*s", SVfARG(declarator), (int)(n - 1), p + 1));
51a483f8 1775 xcroak = newCVREF(
fc634bba 1776 OPf_WANT_SCALAR,
1777 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1778 );
51a483f8 1779 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
fc634bba 1780
1781 cond = newUNOP(OP_EXISTS, 0, cond);
1782
51a483f8 1783 cond = newCONDOP(0, cond, var, xcroak);
fc634bba 1784 }
1785
1786 var = my_var(
1787 aTHX_
1788 OPf_MOD | (OPpLVAL_INTRO << 8),
1789 cur->padoff
1790 );
1791 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1792
ed95eeff 1793 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
fc634bba 1794 }
1795
1796 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1797 ParamInit *cur = &param_spec->named_optional.data[i];
1798 size_t n;
1799 char *p = SvPV(cur->param.name, n);
1800 OP *var, *cond;
1801
1802 var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1803 var = newUNOP(OP_DELETE, 0, var);
1804
1805 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1806 cond = newUNOP(OP_EXISTS, 0, cond);
1807
ed95eeff 1808 cond = newCONDOP(0, cond, var, op_guard_relinquish(&cur->init));
fc634bba 1809
1810 var = my_var(
1811 aTHX_
1812 OPf_MOD | (OPpLVAL_INTRO << 8),
1813 cur->param.padoff
1814 );
1815 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1816
ed95eeff 1817 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
fc634bba 1818 }
1819
1820 if (!param_spec->slurpy.name) {
1821 if (spec->flags & FLAG_CHECK_NARGS) {
1822 /* croak if %{rest} */
51a483f8 1823 OP *xcroak, *cond, *keys, *msg;
fc634bba 1824
1825 keys = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1826 keys = newLISTOP(OP_SORT, 0, newOP(OP_PUSHMARK, 0), keys);
1827 {
1828 OP *first, *mid, *last;
1829
1830 last = keys;
1831
1832 mid = mkconstpvs(", ");
1833 mid->op_sibling = last;
1834
1835 first = newOP(OP_PUSHMARK, 0);
1836
1837 keys = newLISTOP(OP_JOIN, 0, first, mid);
1838 keys->op_targ = pad_alloc(OP_JOIN, SVs_PADTMP);
1839 ((LISTOP *)keys)->op_last = last;
1840 }
1841
1842 msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": no such named parameter: ", SVfARG(declarator)));
1843 msg = newBINOP(OP_CONCAT, 0, msg, keys);
1844
51a483f8 1845 xcroak = newCVREF(
fc634bba 1846 OPf_WANT_SCALAR,
1847 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1848 );
51a483f8 1849 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
fc634bba 1850
1851 cond = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
51a483f8 1852 xcroak = newCONDOP(0, cond, xcroak, NULL);
fc634bba 1853
ed95eeff 1854 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, xcroak)));
fc634bba 1855 } else {
1856 OP *clear;
1857
1858 clear = newASSIGNOP(
1859 OPf_STACKED,
1860 my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1861 0,
1862 newNULLLIST()
1863 );
1864
ed95eeff 1865 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, clear)));
fc634bba 1866 }
1867 } else if (param_spec->slurpy.padoff != param_spec->rest_hash) {
1868 OP *var, *clear;
1869
1870 assert(SvPV_nolen(param_spec->slurpy.name)[0] == '@');
1871
1872 var = my_var_g(
1873 aTHX_
1874 OP_PADAV,
1875 OPf_MOD | (OPpLVAL_INTRO << 8),
1876 param_spec->slurpy.padoff
1877 );
1878
1879 var = newASSIGNOP(OPf_STACKED, var, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1880
ed95eeff 1881 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
fc634bba 1882
1883 clear = newASSIGNOP(
1884 OPf_STACKED,
1885 my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1886 0,
1887 newNULLLIST()
1888 );
1889
ed95eeff 1890 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, clear)));
fc634bba 1891 }
1892 }
51a483f8 1893
1894 if (spec->flags & FLAG_CHECK_TARGS) {
1895 size_t i, lim, base;
1896
1897 base = 1;
1898 for (i = 0, lim = param_spec->positional_required.used; i < lim; i++) {
1899 Param *cur = &param_spec->positional_required.data[i];
1900
1901 if (cur->type) {
ed95eeff 1902 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))));
51a483f8 1903 }
1904 }
1905 base += i;
1906
1907 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1908 Param *cur = &param_spec->positional_optional.data[i].param;
1909
1910 if (cur->type) {
ed95eeff 1911 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))));
51a483f8 1912 }
1913 }
1914 base += i;
1915
1916 for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1917 Param *cur = &param_spec->named_required.data[i];
1918
1919 if (cur->type) {
ed95eeff 1920 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))));
51a483f8 1921 }
1922 }
1923 base += i;
1924
1925 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1926 Param *cur = &param_spec->named_optional.data[i].param;
1927
1928 if (cur->type) {
ed95eeff 1929 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))));
51a483f8 1930 }
1931 }
1932 base += i;
1933
1934 if (param_spec->slurpy.type) {
1935 /* $type->valid($_) or croak $type->get_message($_) for @rest / values %rest */
a8492ba4 1936 OP *check, *list, *loop;
51a483f8 1937
a8492ba4 1938 check = mktypecheck(aTHX_ declarator, base, param_spec->slurpy.name, NOT_IN_PAD, param_spec->slurpy.type);
51a483f8 1939
1940 if (SvPV_nolen(param_spec->slurpy.name)[0] == '@') {
1941 list = my_var_g(aTHX_ OP_PADAV, 0, param_spec->slurpy.padoff);
1942 } else {
1943 list = my_var_g(aTHX_ OP_PADHV, 0, param_spec->slurpy.padoff);
1944 list = newUNOP(OP_VALUES, 0, list);
1945 }
1946
a8492ba4 1947 loop = newFOROP(0, NULL, list, check, NULL);
51a483f8 1948
ed95eeff 1949 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, loop)));
51a483f8 1950 }
1951 }
1e0f1595 1952 }
c311cef3 1953
1e0f1595 1954 /* finally let perl parse the actual subroutine body */
1955 body = parse_block(0);
c311cef3 1956
1e0f1595 1957 /* add '();' to make function return nothing by default */
1958 /* (otherwise the invisible parameter initialization can "leak" into
1959 the return value: fun ($x) {}->("asdf", 0) == 2) */
ed95eeff 1960 if (prelude_sentinel->op) {
1e0f1595 1961 body = newSTATEOP(0, NULL, body);
db81d362 1962 }
1963
ed95eeff 1964 body = op_append_list(OP_LINESEQ, op_guard_relinquish(prelude_sentinel), body);
1e0f1595 1965
c311cef3 1966 /* it's go time. */
1967 {
53c979f0 1968 CV *cv;
ed95eeff 1969 OP *const attrs = op_guard_relinquish(attrs_sentinel);
53c979f0 1970
c311cef3 1971 SvREFCNT_inc_simple_void(PL_compcv);
1972
63915d26 1973 /* close outer block: '}' */
1974 S_block_end(aTHX_ save_ix, body);
1975
53c979f0 1976 cv = newATTRSUB(
c311cef3 1977 floor_ix,
53c979f0 1978 saw_name ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)) : NULL,
c311cef3 1979 proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL,
1980 attrs,
1981 body
1982 );
53c979f0 1983
2c1cb7bd 1984 if (cv) {
1985 register_info(aTHX_ PTR2UV(CvROOT(cv)), declarator, spec, param_spec);
1986 }
53c979f0 1987
1988 if (saw_name) {
1989 *pop = newOP(OP_NULL, 0);
1990 return KEYWORD_PLUGIN_STMT;
1991 }
1992
1993 *pop = newUNOP(
1994 OP_REFGEN, 0,
1995 newSVOP(
1996 OP_ANONCODE, 0,
1997 (SV *)cv
1998 )
1999 );
2000 return KEYWORD_PLUGIN_EXPR;
db81d362 2001 }
db81d362 2002}
2003
2004static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) {
63915d26 2005 KWSpec spec;
db81d362 2006 int ret;
e4648f19 2007 Sentinel sen = { NULL };
db81d362 2008
e4648f19 2009 ENTER;
db81d362 2010 SAVETMPS;
2011
e4648f19 2012 SAVEDESTRUCTOR_X(sentinel_clear_void, sen);
2013
2014 if (kw_flags(aTHX_ sen, keyword_ptr, keyword_len, &spec)) {
2015 ret = parse_fun(aTHX_ sen, op_ptr, keyword_ptr, keyword_len, &spec);
db81d362 2016 } else {
7dd35535 2017 ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
db81d362 2018 }
2019
2020 FREETMPS;
e4648f19 2021 LEAVE;
db81d362 2022
2023 return ret;
2024}
2025
2026WARNINGS_RESET
2027
53c979f0 2028MODULE = Function::Parameters PACKAGE = Function::Parameters PREFIX = fp_
db81d362 2029PROTOTYPES: ENABLE
2030
53c979f0 2031UV
2032fp__cv_root(sv)
2033 SV * sv
2034 PREINIT:
79bce2d4 2035 CV *xcv;
53c979f0 2036 HV *hv;
2037 GV *gv;
2038 CODE:
79bce2d4 2039 xcv = sv_2cv(sv, &hv, &gv, 0);
2040 RETVAL = PTR2UV(xcv ? CvROOT(xcv) : NULL);
53c979f0 2041 OUTPUT:
2042 RETVAL
2043
db81d362 2044BOOT:
2045WARNINGS_ENABLE {
2046 HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);
426a4d69 2047 /**/
d8e5d540 2048 newCONSTSUB(stash, "FLAG_NAME_OK", newSViv(FLAG_NAME_OK));
2049 newCONSTSUB(stash, "FLAG_ANON_OK", newSViv(FLAG_ANON_OK));
63915d26 2050 newCONSTSUB(stash, "FLAG_DEFAULT_ARGS", newSViv(FLAG_DEFAULT_ARGS));
d8e5d540 2051 newCONSTSUB(stash, "FLAG_CHECK_NARGS", newSViv(FLAG_CHECK_NARGS));
2052 newCONSTSUB(stash, "FLAG_INVOCANT", newSViv(FLAG_INVOCANT));
e158cf8f 2053 newCONSTSUB(stash, "FLAG_NAMED_PARAMS", newSViv(FLAG_NAMED_PARAMS));
51a483f8 2054 newCONSTSUB(stash, "FLAG_TYPES_OK", newSViv(FLAG_TYPES_OK));
2055 newCONSTSUB(stash, "FLAG_CHECK_TARGS", newSViv(FLAG_CHECK_TARGS));
db81d362 2056 newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS));
d8e5d540 2057 newCONSTSUB(stash, "HINTK_FLAGS_", newSVpvs(HINTK_FLAGS_));
2058 newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_));
2059 newCONSTSUB(stash, "HINTK_ATTRS_", newSVpvs(HINTK_ATTRS_));
426a4d69 2060 /**/
db81d362 2061 next_keyword_plugin = PL_keyword_plugin;
2062 PL_keyword_plugin = my_keyword_plugin;
2063} WARNINGS_RESET
Unnamed repository; edit this file to name it for gitweb.