#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)
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))
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
}
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;
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++] = ';';
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);
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 */
0x00014204, /* helem */
0x00024401, /* hslice */
0x00004b00, /* boolkeys */
- 0x00091400, /* unpack */
+ 0x00091480, /* unpack */
0x0002140d, /* pack */
0x00111408, /* split */
0x0002140d, /* join */
#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);
# 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
undef undef
unless undef
unlink (@)
-unpack ($;$)
+unpack ($_)
unshift (+@)
untie (\[$@%*])
until undef