|
diff --git a/toke.c b/toke.c |
|
index 88524b4..b517e37 100644 |
|
--- a/toke.c |
|
+++ b/toke.c |
|
@@ -12432,6 +12432,48 @@ S_parse_opt_lexvar(pTHX) |
|
return var; |
|
} |
|
|
|
+void |
|
+Perl_parse_subsignature_remember_sub_arg(pTHX_ OP* var) |
|
+{ |
|
+ HV* signaturesubmap; |
|
+ SV* subid; |
|
+ SV* name; |
|
+ HE* signatures; |
|
+ AV* list; |
|
+ |
|
+ signaturesubmap = get_hv("signatures::subs", 0); |
|
+ if (!signaturesubmap) signaturesubmap = get_hv("signatures::subs", GV_ADD); |
|
+ |
|
+ subid = newSViv((IV)(PL_compcv)); |
|
+ name = newSVsv(PAD_COMPNAME_SV(var->op_targ)); |
|
+ signatures = hv_fetch_ent(signaturesubmap, subid, 0, 0); |
|
+ if (signatures) { |
|
+ list = (AV*)SvRV(HeVAL(signatures)); |
|
+ } else { |
|
+ list = newAV(); |
|
+ } |
|
+ av_push(list, name); |
|
+ hv_store_ent(signaturesubmap, subid, newRV_inc((SV*)list), 0); |
|
+} |
|
+ |
|
+void |
|
+Perl_parse_subsignature_remember_sub_arity(pTHX_ int min_arity, int max_arity) { |
|
+ HV* signaturearitymap; |
|
+ SV* subid; |
|
+ int arity; |
|
+ |
|
+ signaturearitymap = get_hv("signatures::arities", 0); |
|
+ if (!signaturearitymap) signaturearitymap = get_hv("signatures::arities", GV_ADD); |
|
+ |
|
+ subid = newSViv((IV)(PL_compcv)); |
|
+ if (max_arity == -1) { |
|
+ arity = -(min_arity + 1); |
|
+ } else { |
|
+ arity = min_arity; |
|
+ } |
|
+ hv_store_ent(signaturearitymap, subid, newSViv(arity), 0); |
|
+} |
|
+ |
|
OP * |
|
Perl_parse_subsignature(pTHX) |
|
{ |
|
@@ -12488,7 +12530,10 @@ Perl_parse_subsignature(pTHX) |
|
prev_type = 0; |
|
min_arity = pos + 1; |
|
} |
|
- if (var) expr = newASSIGNOP(OPf_STACKED, var, 0, expr); |
|
+ if (var) { |
|
+ expr = newASSIGNOP(OPf_STACKED, var, 0, expr); |
|
+ Perl_parse_subsignature_remember_sub_arg(var); |
|
+ } |
|
if (expr) |
|
initops = op_append_list(OP_LINESEQ, initops, |
|
newSTATEOP(0, NULL, expr)); |
|
@@ -12539,6 +12584,7 @@ Perl_parse_subsignature(pTHX) |
|
initops = op_append_list(OP_LINESEQ, initops, |
|
newSTATEOP(0, NULL, |
|
newASSIGNOP(OPf_STACKED, var, 0, slice))); |
|
+ Perl_parse_subsignature_remember_sub_arg(var); |
|
} |
|
prev_type = 2; |
|
max_arity = -1; |
|
@@ -12590,6 +12636,7 @@ Perl_parse_subsignature(pTHX) |
|
newSVpvs("Too many arguments for subroutine"))))), |
|
initops); |
|
} |
|
+ Perl_parse_subsignature_remember_sub_arity(min_arity, max_arity); |
|
return initops; |
|
} |
|
|