diff options
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | op.c | 34 | ||||
| -rw-r--r-- | opcode.h | 4 | ||||
| -rw-r--r-- | proto.h | 6 | ||||
| -rw-r--r-- | regen/opcodes | 2 | ||||
| -rw-r--r-- | t/op/cproto.t | 2 |
6 files changed, 17 insertions, 32 deletions
@@ -1006,7 +1006,6 @@ #define ck_substr(a) Perl_ck_substr(aTHX_ a) #define ck_svconst(a) Perl_ck_svconst(aTHX_ a) #define ck_trunc(a) Perl_ck_trunc(aTHX_ a) -#define ck_unpack(a) Perl_ck_unpack(aTHX_ a) #define convert(a,b,c) Perl_convert(aTHX_ a,b,c) #define core_prototype(a,b,c,d) Perl_core_prototype(aTHX_ a,b,c,d) #define create_eval_scope(a) Perl_create_eval_scope(aTHX_ a) @@ -7672,6 +7672,7 @@ Perl_ck_fun(pTHX_ OP *o) register OP *kid = cLISTOPo->op_first; OP *sibl; I32 numargs = 0; + bool seen_optional = FALSE; if (kid->op_type == OP_PUSHMARK || (kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)) @@ -7679,10 +7680,15 @@ Perl_ck_fun(pTHX_ OP *o) tokid = &kid->op_sibling; kid = kid->op_sibling; } - if (!kid && PL_opargs[type] & OA_DEFGV) - *tokid = kid = newDEFSVOP(); - while (oa && kid) { + while (oa) { + if (oa & OA_OPTIONAL) { + if (!kid && !seen_optional && PL_opargs[type] & OA_DEFGV) + *tokid = kid = newDEFSVOP(); + seen_optional = TRUE; + } + if (!kid) break; + numargs++; sibl = kid->op_sibling; #ifdef PERL_MAD @@ -9509,21 +9515,6 @@ Perl_ck_trunc(pTHX_ OP *o) } OP * -Perl_ck_unpack(pTHX_ OP *o) -{ - OP *kid = cLISTOPo->op_first; - - PERL_ARGS_ASSERT_CK_UNPACK; - - if (kid->op_sibling) { - kid = kid->op_sibling; - if (!kid->op_sibling) - kid->op_sibling = newDEFSVOP(); - } - return ck_fun(o); -} - -OP * Perl_ck_substr(pTHX_ OP *o) { PERL_ARGS_ASSERT_CK_SUBSTR; @@ -10363,7 +10354,7 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, oa = PL_opargs[i] >> OASHIFT; while (oa) { if (oa & OA_OPTIONAL && !seen_question && ( - !defgv || n || (oa & (OA_OPTIONAL - 1)) == OA_FILEREF + !defgv || (oa & (OA_OPTIONAL - 1)) == OA_FILEREF )) { seen_question = 1; str[n++] = ';'; @@ -10386,10 +10377,11 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, str[n++] = ']'; } else str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)]; + if (oa & OA_OPTIONAL && defgv && str[n-1] == '$') { + str[n-1] = '_'; defgv = 0; + } oa = oa >> 4; } - if (defgv && str[0] == '$') - str[0] = '_'; if (code == -KEY_not || code == -KEY_getprotobynumber) str[n++] = ';'; str[n++] = '\0'; sv_setpvn(sv, str, n - 1); @@ -1452,7 +1452,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_null, /* helem */ Perl_ck_null, /* hslice */ Perl_ck_fun, /* boolkeys */ - Perl_ck_unpack, /* unpack */ + Perl_ck_fun, /* unpack */ Perl_ck_fun, /* pack */ Perl_ck_split, /* split */ Perl_ck_join, /* join */ @@ -1836,7 +1836,7 @@ EXTCONST U32 PL_opargs[] = { 0x00014204, /* helem */ 0x00024401, /* hslice */ 0x00004b00, /* boolkeys */ - 0x00091400, /* unpack */ + 0x00091480, /* unpack */ 0x0002140d, /* pack */ 0x00111408, /* split */ 0x0002140d, /* join */ @@ -544,12 +544,6 @@ PERL_CALLCONV OP * Perl_ck_trunc(pTHX_ OP *o) #define PERL_ARGS_ASSERT_CK_TRUNC \ assert(o) -PERL_CALLCONV OP * Perl_ck_unpack(pTHX_ OP *o) - __attribute__warn_unused_result__ - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_CK_UNPACK \ - assert(o) - PERL_CALLCONV void Perl_ck_warner(pTHX_ U32 err, const char* pat, ...) __attribute__format__(__printf__,pTHX_2,pTHX_3) __attribute__nonnull__(pTHX_2); diff --git a/regen/opcodes b/regen/opcodes index c9c6984fbc..d6720c3cb3 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -235,7 +235,7 @@ boolkeys boolkeys ck_fun % H # Explosives and implosives. -unpack unpack ck_unpack @ S S? +unpack unpack ck_fun u@ S S? pack pack ck_fun mst@ S L split split ck_split t@ S S S join join or string ck_join mst@ S L diff --git a/t/op/cproto.t b/t/op/cproto.t index a587a316a8..2c54c0c655 100644 --- a/t/op/cproto.t +++ b/t/op/cproto.t @@ -253,7 +253,7 @@ umask (;$) undef undef unless undef unlink (@) -unpack ($;$) +unpack ($_) unshift (+@) untie (\[$@%*]) until undef |