STATIC char*
S_form_short_octal_warning(pTHX_
const char * const s, /* Points to first non-octal */
const STRLEN len /* Length of octals string, so
(s-len) points to first
octal */
) {
/* Return a character string consisting of a warning message for when a
* string constant in octal is weird, like "\078". */
const char * sans_leading_zeros = s - len;
PERL_ARGS_ASSERT_FORM_SHORT_OCTAL_WARNING;
assert(*s == '8' || *s == '9');
/* Remove the leading zeros, retaining one zero so won't be zero length */
while (*sans_leading_zeros == '0') sans_leading_zeros++;
if (sans_leading_zeros == s) {
sans_leading_zeros--;
}
return Perl_form(aTHX_
"'%.*s' resolved to '\\o{%.*s}%c'",
(int) (len + 2), s - len - 1,
(int) (s - sans_leading_zeros), sans_leading_zeros,
*s);
}
OP *
Perl_scalar(pTHX_ OP *o)
{
dVAR;
OP *kid;
/* assumes no premature commitment */
if (!o || (PL_parser && PL_parser->error_count)
|| (o->op_flags & OPf_WANT)
|| o->op_type == OP_RETURN)
{
return o;
}
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
switch (o->op_type) {
case OP_REPEAT:
scalar(cBINOPo->op_first);
break;
case OP_COND_EXPR:
for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
scalar(kid);
break;
case OP_MATCH:
case OP_QR:
case OP_SUBST:
case OP_NULL:
default:
if (o->op_flags & OPf_KIDS) {
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
scalar(kid);
}
break;
case OP_LEAVE:
case OP_LEAVETRY:
kid = cLISTOPo->op_first;
scalar(kid);
while ((kid = kid->op_sibling)) {
if (kid->op_sibling)
scalarvoid(kid);
else
scalar(kid);
}
PL_curcop = &PL_compiling;
break;
case OP_SCOPE:
case OP_LINESEQ:
case OP_LISTLAST:
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling)
scalarvoid(kid);
else
scalar(kid);
}
PL_curcop = &PL_compiling;
break;
case OP_LISTFIRST:
assert(cLISTOPo->op_first->op_type == OP_PUSHMARK);
kid = cLISTOPo->op_first->op_sibling;
if (kid) {
scalar(kid);
for (kid = kid->op_sibling; kid; kid = kid->op_sibling) {
scalarvoid(kid);
}
}
PL_curcop = &PL_compiling;
break;
case OP_LIST:
#ifndef PERL_MAD
yyerror_at(o->op_location, Perl_form(aTHX_ "%s may not be used in scalar context", PL_op_desc[o->op_type]));
#endif /* PERL_MAD */
break;
case OP_ANONARRAY:
break;
}
return o;
}
