remove double typeglob deref (suggested by RonaldWS <ronaldws@aol.com>)

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 58f26e1..8f15a10 100644 (file)
--- a/op.c
+++ b/op.c
@@ -51,6 +51,7 @@ static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
        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*
@@ -4641,6 +4642,12 @@ ck_fun(OP *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:
@@ -4653,7 +4660,8 @@ ck_fun(OP *o)
                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) ));
@@ -4672,7 +4680,8 @@ ck_fun(OP *o)
                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) ));
@@ -4703,7 +4712,8 @@ ck_fun(OP *o)
            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) );
@@ -4762,10 +4772,8 @@ ck_glob(OP *o)
        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;
@@ -5048,7 +5056,9 @@ ck_sort(OP *o)
        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 */
@@ -5090,6 +5100,66 @@ ck_sort(OP *o)
     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)
 {