CV* startcv, I32 cx_ix, I32 saweval));
static OP *newDEFSVOP _((void));
static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
+static void simplify_sort _((OP *o));
#endif
STATIC char*
SV* sv;
/* assumes no premature commitment */
- if (!o || (o->op_flags & OPf_WANT) == OPf_WANT_LIST || PL_error_count
+ U8 want = o->op_flags & OPf_WANT;
+ if (!o || (want && want != OPf_WANT_SCALAR) || PL_error_count
|| o->op_type == OP_RETURN)
return o;
sibl = kid->op_sibling;
switch (oa & 7) {
case OA_SCALAR:
+ /* list seen where single (scalar) arg expected? */
+ if (numargs == 1 && !(oa >> 4)
+ && kid->op_type == OP_LIST && type != OP_SCALAR)
+ {
+ return too_many_arguments(o,PL_op_desc[type]);
+ }
scalar(kid);
break;
case OA_LIST:
break;
case OA_AVREF:
if (kid->op_type == OP_CONST &&
- (kid->op_private & OPpCONST_BARE)) {
+ (kid->op_private & OPpCONST_BARE))
+ {
char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newAVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVAV) ));
break;
case OA_HVREF:
if (kid->op_type == OP_CONST &&
- (kid->op_private & OPpCONST_BARE)) {
+ (kid->op_private & OPpCONST_BARE))
+ {
char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newHVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVHV) ));
case OA_FILEREF:
if (kid->op_type != OP_GV && kid->op_type != OP_RV2GV) {
if (kid->op_type == OP_CONST &&
- (kid->op_private & OPpCONST_BARE)) {
+ (kid->op_private & OPpCONST_BARE))
+ {
OP *newop = newGVOP(OP_GV, 0,
gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
SVt_PVIO) );
gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
if (gv && GvIMPORTED_CV(gv)) {
- static int glob_index;
-
append_elem(OP_GLOB, o,
- newSVOP(OP_CONST, 0, newSViv(glob_index++)));
+ newSVOP(OP_CONST, 0, newSViv(PL_glob_index++)));
o->op_type = OP_LIST;
o->op_ppaddr = PL_ppaddr[OP_LIST];
cLISTOPo->op_first->op_type = OP_PUSHMARK;
o->op_private |= OPpLOCALE;
#endif
- if (o->op_flags & OPf_STACKED) {
+ if (o->op_flags & OPf_STACKED)
+ simplify_sort(o);
+ if (o->op_flags & OPf_STACKED) { /* may have been cleared */
OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
OP *k;
kid = kUNOP->op_first; /* get past rv2gv */
return o;
}
+STATIC void
+simplify_sort(OP *o)
+{
+ dTHR;
+ register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
+ OP *k;
+ int reversed;
+ if (!(o->op_flags & OPf_STACKED))
+ return;
+ kid = kUNOP->op_first; /* get past rv2gv */
+ if (kid->op_type != OP_SCOPE)
+ return;
+ kid = kLISTOP->op_last; /* get past scope */
+ switch(kid->op_type) {
+ case OP_NCMP:
+ case OP_I_NCMP:
+ case OP_SCMP:
+ break;
+ default:
+ return;
+ }
+ k = kid; /* remember this node*/
+ if (kBINOP->op_first->op_type != OP_RV2SV)
+ return;
+ kid = kBINOP->op_first; /* get past cmp */
+ if (kUNOP->op_first->op_type != OP_GV)
+ return;
+ kid = kUNOP->op_first; /* get past rv2sv */
+ if (GvSTASH(kGVOP->op_gv) != PL_curstash)
+ return;
+ if (strEQ(GvNAME(kGVOP->op_gv), "a"))
+ reversed = 0;
+ else if(strEQ(GvNAME(kGVOP->op_gv), "b"))
+ reversed = 1;
+ else
+ return;
+ kid = k; /* back to cmp */
+ if (kBINOP->op_last->op_type != OP_RV2SV)
+ return;
+ kid = kBINOP->op_last; /* down to 2nd arg */
+ if (kUNOP->op_first->op_type != OP_GV)
+ return;
+ kid = kUNOP->op_first; /* get past rv2sv */
+ if (GvSTASH(kGVOP->op_gv) != PL_curstash
+ || ( reversed
+ ? strNE(GvNAME(kGVOP->op_gv), "a")
+ : strNE(GvNAME(kGVOP->op_gv), "b")))
+ return;
+ o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL);
+ if (reversed)
+ o->op_private |= OPpSORT_REVERSE;
+ if (k->op_type == OP_NCMP)
+ o->op_private |= OPpSORT_NUMERIC;
+ if (k->op_type == OP_I_NCMP)
+ o->op_private |= OPpSORT_NUMERIC | OPpSORT_INTEGER;
+ op_free(cLISTOPo->op_first->op_sibling); /* delete comparison block */
+ cLISTOPo->op_first->op_sibling = cLISTOPo->op_last;
+ cLISTOPo->op_children = 1;
+}
+
OP *
ck_split(OP *o)
{