Use reentrant API glibc

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

diff --git a/op.c b/op.c
index 2e6a13d..c7c53e4 100644 (file)
--- a/op.c
+++ b/op.c
@@ -842,12 +842,12 @@ clear_pmop:
                    lastpmop = pmop;
                    pmop = pmop->op_pmnext;
                }
+           }
 #ifdef USE_ITHREADS
-               Safefree(PmopSTASHPV(cPMOPo));
+           Safefree(PmopSTASHPV(cPMOPo));
 #else
-               /* NOTE: PMOP.op_pmstash is not refcounted */
+           /* NOTE: PMOP.op_pmstash is not refcounted */
 #endif
-           }
        }
        cPMOPo->op_pmreplroot = Nullop;
        ReREFCNT_dec(PM_GETRE(cPMOPo));
@@ -2035,9 +2035,15 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
        right->op_type == OP_SUBST ||
        right->op_type == OP_TRANS)) {
        right->op_flags |= OPf_STACKED;
-       if (right->op_type != OP_MATCH &&
-            ! (right->op_type == OP_TRANS &&
-               right->op_private & OPpTRANS_IDENTICAL))
+       if ((right->op_type != OP_MATCH &&
+            ! (right->op_type == OP_TRANS &&
+               right->op_private & OPpTRANS_IDENTICAL)) ||
+           /* if SV has magic, then match on original SV, not on its copy.
+              see note in pp_helem() */
+           (right->op_type == OP_MATCH &&      
+            (left->op_type == OP_AELEM ||
+             left->op_type == OP_HELEM ||
+             left->op_type == OP_AELEMFAST)))
            left = mod(left, right->op_type);
        if (right->op_type == OP_TRANS)
            o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
@@ -2320,7 +2326,11 @@ Perl_fold_constants(pTHX_ register OP *o)
            SvIV_please(sv);
 #endif
        }
-       return newSVOP(OP_CONST, 0, sv);
+       o = newSVOP(OP_CONST, 0, sv);
+       /* We don't want folded constants to trigger OCTMODE warnings,
+          so we cheat a bit and mark them OCTAL. AMS 20010709 */
+       o->op_private |= OPpCONST_OCTAL;
+       return o;
     }
 
   nope:
@@ -2942,7 +2952,16 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
        pmop->op_pmpermflags |= PMf_LOCALE;
     pmop->op_pmflags = pmop->op_pmpermflags;
 
-    /* link into pm list */
+ #ifdef USE_ITHREADS
+        {
+                SV* repointer = newSViv(0);
+                av_push(PL_regex_padav,repointer);
+                pmop->op_pmoffset = av_len(PL_regex_padav);
+                PL_regex_pad = AvARRAY(PL_regex_padav);
+        }
+ #endif
+        
+        /* link into pm list */
     if (type != OP_TRANS && PL_curstash) {
        pmop->op_pmnext = HvPMROOT(PL_curstash);
        HvPMROOT(PL_curstash) = pmop;
@@ -3187,6 +3206,7 @@ Perl_package(pTHX_ OP *o)
        op_free(o);
     }
     else {
+       deprecate("\"package\" with no arguments");
        sv_setpv(PL_curstname,"<none>");
        PL_curstash = Nullhv;
     }
@@ -4154,9 +4174,10 @@ Perl_cv_undef(pTHX_ CV *cv)
 
 #ifdef USE_ITHREADS
     if (CvFILE(cv) && !CvXSUB(cv)) {
+       /* for XSUBs CvFILE point directly to static memory; __FILE__ */
        Safefree(CvFILE(cv));
-       CvFILE(cv) = 0;
     }
+    CvFILE(cv) = 0;
 #endif
 
     if (!CvXSUB(cv) && CvROOT(cv)) {
@@ -6111,6 +6132,39 @@ Perl_ck_null(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_octmode(pTHX_ OP *o)
+{
+    OP *p;
+
+    if ((ckWARN(WARN_OCTMODE)
+       /* Add WARN_MKDIR instead of getting rid of WARN_{CHMOD,UMASK}.
+          Backwards compatibility and consistency are terrible things.
+          AMS 20010705 */
+       || (o->op_type == OP_CHMOD && ckWARN(WARN_CHMOD))
+       || (o->op_type == OP_UMASK && ckWARN(WARN_UMASK))
+       || (o->op_type == OP_MKDIR && ckWARN(WARN_MKDIR)))
+       && o->op_flags & OPf_KIDS)
+    {
+       if (o->op_type == OP_MKDIR)
+           p = cLISTOPo->op_last;              /* mkdir $foo, 0777 */
+       else if (o->op_type == OP_CHMOD)
+           p = cLISTOPo->op_first->op_sibling; /* chmod 0777, $foo */
+       else
+           p = cUNOPo->op_first;               /* umask 0222 */
+
+       if (p->op_type == OP_CONST && !(p->op_private & OPpCONST_OCTAL)) {
+           int mode = SvIV(cSVOPx_sv(p));
+
+           Perl_warner(aTHX_ WARN_OCTMODE,
+                       "Non-octal literal mode (%d) specified", mode);
+           Perl_warner(aTHX_ WARN_OCTMODE,
+                       "\t(Did you mean 0%d instead?)\n", mode);
+       }
+    }
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_open(pTHX_ OP *o)
 {
     HV *table = GvHV(PL_hintgv);