perldoc pod update

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

diff --git a/op.c b/op.c
index cc79dfe..6bfa1a1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -48,7 +48,7 @@ static OP *too_few_arguments _((OP *o, char* name));
 static OP *too_many_arguments _((OP *o, char* name));
 static void null _((OP* o));
 static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
-       CV* startcv, I32 cx_ix));
+       CV* startcv, I32 cx_ix, I32 saweval));
 static OP *newDEFSVOP _((void));
 static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
 #endif
@@ -170,7 +170,7 @@ pad_allocmy(char *name)
 }
 
 STATIC PADOFFSET
-pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
+pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval)
 {
     dTHR;
     CV *cv;
@@ -178,7 +178,6 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
     SV *sv;
     register I32 i;
     register PERL_CONTEXT *cx;
-    int saweval;
 
     for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
        AV *curlist = CvPADLIST(cv);
@@ -220,6 +219,12 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
                    SvNVX(namesv) = (double)PL_curcop->cop_seq;
                    SvIVX(namesv) = PAD_MAX;    /* A ref, intro immediately */
                    SvFAKE_on(namesv);          /* A ref, not a real var */
+                   if (SvOBJECT(sv)) {         /* A typed var */
+                       SvOBJECT_on(namesv);
+                       (void)SvUPGRADE(namesv, SVt_PVMG);
+                       SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(sv));
+                       PL_sv_objcount++;
+                   }
                    if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
                        /* "It's closures all the way down." */
                        CvCLONE_on(PL_compcv);
@@ -231,14 +236,18 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
                            CV *bcv;
                            for (bcv = startcv;
                                 bcv && bcv != cv && !CvCLONE(bcv);
-                                bcv = CvOUTSIDE(bcv)) {
+                                bcv = CvOUTSIDE(bcv))
+                           {
                                if (CvANON(bcv))
                                    CvCLONE_on(bcv);
                                else {
-                                   if (ckWARN(WARN_CLOSURE) && !CvUNIQUE(cv))
+                                   if (ckWARN(WARN_CLOSURE)
+                                       && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
+                                   {
                                        warner(WARN_CLOSURE,
                                          "Variable \"%s\" may be unavailable",
                                             name);
+                                   }
                                    break;
                                }
                            }
@@ -261,20 +270,20 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
      * XXX This will also probably interact badly with eval tree caching.
      */
 
-    saweval = 0;
     for (i = cx_ix; i >= 0; i--) {
        cx = &cxstack[i];
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        default:
            if (i == 0 && saweval) {
                seq = cxstack[saweval].blk_oldcop->cop_seq;
-               return pad_findlex(name, newoff, seq, PL_main_cv, 0);
+               return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval);
            }
            break;
        case CXt_EVAL:
            switch (cx->blk_eval.old_op_type) {
            case OP_ENTEREVAL:
-               saweval = i;
+               if (CxREALEVAL(cx))
+                   saweval = i;
                break;
            case OP_REQUIRE:
                /* require must have its own scope */
@@ -290,7 +299,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
                continue;
            }
            seq = cxstack[saweval].blk_oldcop->cop_seq;
-           return pad_findlex(name, newoff, seq, cv, i-1);
+           return pad_findlex(name, newoff, seq, cv, i-1, saweval);
        }
     }
 
@@ -306,6 +315,8 @@ pad_findmy(char *name)
     SV *sv;
     SV **svp = AvARRAY(PL_comppad_name);
     U32 seq = PL_cop_seqmax;
+    PERL_CONTEXT *cx;
+    CV *outside;
 
 #ifdef USE_THREADS
     /*
@@ -335,8 +346,20 @@ pad_findmy(char *name)
        }
     }
 
+    outside = CvOUTSIDE(PL_compcv);
+
+    /* Check if if we're compiling an eval'', and adjust seq to be the
+     * eval's seq number.  This depends on eval'' having a non-null
+     * CvOUTSIDE() while it is being compiled.  The eval'' itself is
+     * identified by CvUNIQUE being set and CvGV being null. */
+    if (outside && CvUNIQUE(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
+       cx = &cxstack[cxstack_ix];
+       if (CxREALEVAL(cx))
+           seq = cx->blk_oldcop->cop_seq;
+    }
+
     /* See if it's in a nested scope */
-    off = pad_findlex(name, 0, seq, CvOUTSIDE(PL_compcv), cxstack_ix);
+    off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0);
     if (off) {
        /* If there is a pending local definition, this new alias must die */
        if (pendoff)
@@ -1900,7 +1923,7 @@ append_list(I32 type, LISTOP *first, LISTOP *last)
     first->op_last = last->op_last;
     first->op_children += last->op_children;
     if (first->op_children)
-       last->op_flags |= OPf_KIDS;
+       first->op_flags |= OPf_KIDS;
 
     Safefree(last);
     return (OP*)first;
@@ -3488,7 +3511,7 @@ CV* cv;
                  cv,
                  (CvANON(cv) ? "ANON"
                   : (cv == PL_main_cv) ? "MAIN"
-                  : CvUNIQUE(outside) ? "UNIQUE"
+                  : CvUNIQUE(cv) ? "UNIQUE"
                   : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
                  outside,
                  (!outside ? "null"
@@ -3588,7 +3611,7 @@ cv_clone2(CV *proto, CV *outside)
            char *name = SvPVX(namesv);    /* XXX */
            if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
                I32 off = pad_findlex(name, ix, SvIVX(namesv),
-                                     CvOUTSIDE(cv), cxstack_ix);
+                                     CvOUTSIDE(cv), cxstack_ix, 0);
                if (!off)
                    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
                else if (off != ix)
@@ -3815,9 +3838,10 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     CvSTASH(cv) = PL_curstash;
 #ifdef USE_THREADS
     CvOWNER(cv) = 0;
-    if (!CvMUTEXP(cv))
+    if (!CvMUTEXP(cv)) {
        New(666, CvMUTEXP(cv), 1, perl_mutex);
-    MUTEX_INIT(CvMUTEXP(cv));
+       MUTEX_INIT(CvMUTEXP(cv));
+    }
 #endif /* USE_THREADS */
 
     if (ps)