avoid "will not stay shared" warnings for our variables (from

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

diff --git a/op.c b/op.c
index 0cdeb92..7ca60ae 100644 (file)
--- a/op.c
+++ b/op.c
@@ -168,7 +168,7 @@ Perl_pad_allocmy(pTHX_ char *name)
                    Perl_warner(aTHX_ WARN_MISC,
                        "\"our\" variable %s redeclared", name);
                    Perl_warner(aTHX_ WARN_MISC,
-                       "(Did you mean \"local\" instead of \"our\"?)\n");
+                       "\t(Did you mean \"local\" instead of \"our\"?)\n");
                    break;
                }
            } while ( off-- > 0 );
@@ -321,9 +321,12 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                        }
                    }
                    else if (!CvUNIQUE(PL_compcv)) {
-                       if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv))
+                       if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
+                           && !(SvFLAGS(sv) & SVpad_OUR))
+                       {
                            Perl_warner(aTHX_ WARN_CLOSURE,
                                "Variable \"%s\" will not stay shared", name);
+                       }
                    }
                }
                av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
@@ -3848,7 +3851,10 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
        loopflags |= OPpLOOP_CONTINUE;
     }
     if (expr) {
-       cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
+       OP *unstack = newOP(OP_UNSTACK, 0);
+       if (!next)
+           next = unstack;
+       cont = append_elem(OP_LINESEQ, cont, unstack);
        if ((line_t)whileline != NOLINE) {
            PL_copline = whileline;
            cont = append_elem(OP_LINESEQ, cont,
@@ -3871,8 +3877,6 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
        if (listop)
            ((LISTOP*)listop)->op_last->op_next = condop =
                (o == listop ? redo : LINKLIST(o));
-       if (!next)
-           next = condop;
     }
     else
        o = listop;
@@ -5520,6 +5524,13 @@ Perl_ck_fun(pTHX_ OP *o)
                                name = GvNAME(gv);
                                len = GvNAMELEN(gv);
                            }
+                           else if (kid->op_type == OP_AELEM
+                                    || kid->op_type == OP_HELEM)
+                           {
+                               name = "__ANONIO__";
+                               len = 10;
+                               mod(kid,type);
+                           }
                            if (name) {
                                SV *namesv;
                                targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
@@ -5704,7 +5715,7 @@ Perl_ck_defined(pTHX_ OP *o)              /* 19990527 MJD */
            Perl_warner(aTHX_ WARN_DEPRECATED,
                        "defined(@array) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "(Maybe you should just omit the defined()?)\n");
+                       "\t(Maybe you should just omit the defined()?)\n");
        break;
        case OP_RV2HV:
            break;                      /* Globals via GV can be undef */ 
@@ -5712,7 +5723,7 @@ Perl_ck_defined(pTHX_ OP *o)              /* 19990527 MJD */
            Perl_warner(aTHX_ WARN_DEPRECATED,
                        "defined(%%hash) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "(Maybe you should just omit the defined()?)\n");
+                       "\t(Maybe you should just omit the defined()?)\n");
            break;
        default:
            /* no warning */
@@ -5987,6 +5998,7 @@ Perl_ck_shift(pTHX_ OP *o)
 OP *
 Perl_ck_sort(pTHX_ OP *o)
 {
+    OP *firstkid;
     o->op_private = 0;
 #ifdef USE_LOCALE
     if (PL_hints & HINT_LOCALE)
@@ -5995,10 +6007,10 @@ Perl_ck_sort(pTHX_ OP *o)
 
     if (o->op_type == OP_SORT && 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 */
+    firstkid = cLISTOPo->op_first->op_sibling;         /* get past pushmark */
+    if (o->op_flags & OPf_STACKED) {                   /* may have been cleared */
        OP *k;
-       kid = kUNOP->op_first;                          /* get past null */
+       OP *kid = cUNOPx(firstkid)->op_first;           /* get past null */
 
        if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
            linklist(kid);
@@ -6028,17 +6040,26 @@ Perl_ck_sort(pTHX_ OP *o)
            }
            peep(k);
 
-           kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
-           if (o->op_type == OP_SORT)
+           kid = firstkid;
+           if (o->op_type == OP_SORT) {
+               /* provide scalar context for comparison function/block */
+               kid = scalar(kid);
                kid->op_next = kid;
+           }
            else
                kid->op_next = k;
            o->op_flags |= OPf_SPECIAL;
        }
        else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV)
-           null(cLISTOPo->op_first->op_sibling);
+           null(firstkid);
+
+       firstkid = firstkid->op_sibling;
     }
 
+    /* provide list context for arguments */
+    if (o->op_type == OP_SORT)
+       list(firstkid);
+
     return o;
 }
 
@@ -6244,7 +6265,9 @@ Perl_ck_subr(pTHX_ OP *o)
                proto++;
                arg++;
                if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
-                   bad_type(arg, "block", gv_ename(namegv), o2);
+                   bad_type(arg,
+                       arg == 1 ? "block or sub {}" : "sub {}",
+                       gv_ename(namegv), o2);
                break;
            case '*':
                /* '*' allows any scalar type, including bareword */
@@ -6292,8 +6315,8 @@ Perl_ck_subr(pTHX_ OP *o)
                        bad_type(arg, "symbol", gv_ename(namegv), o2);
                    goto wrapref;
                case '&':
-                   if (o2->op_type != OP_RV2CV)
-                       bad_type(arg, "sub", gv_ename(namegv), o2);
+                   if (o2->op_type != OP_ENTERSUB)
+                       bad_type(arg, "subroutine entry", gv_ename(namegv), o2);
                    goto wrapref;
                case '$':
                    if (o2->op_type != OP_RV2SV
@@ -6555,7 +6578,7 @@ Perl_peep(pTHX_ register OP *o)
                    Perl_warner(aTHX_ WARN_EXEC,
                                "Statement unlikely to be reached");
                    Perl_warner(aTHX_ WARN_EXEC,
-                               "(Maybe you meant system() when you said exec()?)\n");
+                               "\t(Maybe you meant system() when you said exec()?)\n");
                    CopLINE_set(PL_curcop, oldline);
                }
            }