perlio.c: (Coverity) eliminate temp ptr that confuses Coverity into thinking there...
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
index 1fcbbac..5288c66 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1695,11 +1695,10 @@ PP(pp_caller)
     /* XXX only hints propagated via op_private are currently
      * visible (others are not easily accessible, since they
      * use the global PL_hints) */
-    PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->op_private &
-                            HINT_PRIVATE_MASK)));
+    PUSHs(sv_2mortal(newSViv(CopHINTS_get(cx->blk_oldcop))));
     {
        SV * mask ;
-       SV * const old_warnings = cx->blk_oldcop->cop_warnings ;
+       STRLEN * const old_warnings = cx->blk_oldcop->cop_warnings ;
 
        if  (old_warnings == pWARN_NONE ||
                (old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0))
@@ -1718,7 +1717,7 @@ PP(pp_caller)
            }
        }
         else
-            mask = newSVsv(old_warnings);
+            mask = newSVpvn((char *) (old_warnings + 1), old_warnings[0]);
         PUSHs(sv_2mortal(mask));
     }
 
@@ -2815,7 +2814,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     *padp = (AV*)SvREFCNT_inc_simple(PL_comppad);
     LEAVE;
     if (IN_PERL_COMPILETIME)
-       PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+       CopHINTS_set(&PL_compiling, PL_hints);
 #ifdef OP_IN_REGISTER
     op = PL_opsave;
 #endif
@@ -2925,7 +2924,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     PL_eval_root = NULL;
     PL_error_count = 0;
     PL_curcop = &PL_compiling;
-    PL_curcop->cop_arybase = 0;
+    CopARYBASE_set(PL_curcop, 0);
     if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL))
        PL_in_eval |= EVAL_KEEPERR;
     else
@@ -3364,13 +3363,15 @@ PP(pp_require)
     PL_rsfp = tryrsfp;
     SAVEHINTS();
     PL_hints = 0;
-    SAVESPTR(PL_compiling.cop_warnings);
+    SAVECOPWARNINGS(&PL_compiling);
     if (PL_dowarn & G_WARN_ALL_ON)
         PL_compiling.cop_warnings = pWARN_ALL ;
     else if (PL_dowarn & G_WARN_ALL_OFF)
         PL_compiling.cop_warnings = pWARN_NONE ;
-    else if (PL_taint_warn)
-        PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
+    else if (PL_taint_warn) {
+        PL_compiling.cop_warnings
+           = Perl_new_warnings_bitfield(aTHX_ NULL, WARN_TAINTstring, WARNsize);
+    }
     else
         PL_compiling.cop_warnings = pWARN_STD ;
     SAVESPTR(PL_compiling.cop_io);
@@ -3462,13 +3463,8 @@ PP(pp_entereval)
     PL_hints = PL_op->op_targ;
     if (saved_hh)
        GvHV(PL_hintgv) = saved_hh;
-    SAVESPTR(PL_compiling.cop_warnings);
-    if (specialWARN(PL_curcop->cop_warnings))
-        PL_compiling.cop_warnings = PL_curcop->cop_warnings;
-    else {
-        PL_compiling.cop_warnings = newSVsv(PL_curcop->cop_warnings);
-        SAVEFREESV(PL_compiling.cop_warnings);
-    }
+    SAVECOPWARNINGS(&PL_compiling);
+    PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
     SAVESPTR(PL_compiling.cop_io);
     if (specialCopIO(PL_curcop->cop_io))
         PL_compiling.cop_io = PL_curcop->cop_io;
@@ -3477,27 +3473,13 @@ PP(pp_entereval)
         SAVEFREESV(PL_compiling.cop_io);
     }
     if (PL_compiling.cop_hints) {
-       PL_compiling.cop_hints->refcounted_he_refcnt--;
+       Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints);
     }
     PL_compiling.cop_hints = PL_curcop->cop_hints;
     if (PL_compiling.cop_hints) {
-#ifdef USE_ITHREADS
-       /* PL_curcop could be pointing to an optree owned by another /.*parent/
-          thread. We can't manipulate the reference count of the refcounted he
-          there (race condition) so we have to do something less than
-          pleasant to keep it read only. The simplest solution seems to be to
-          copy their chain. We might want to cache this.
-          Alternatively we could add a flag to the refcounted he *we* point to
-          here saying "I don't own a reference count on the thing I point to",
-          and arrange for Perl_refcounted_he_free() to spot that. If so, we'd
-          still need to copy the topmost refcounted he so that we could change
-          its flag. So still not trivial. (Flag bits could be hung from the
-          shared HEK) */
-       PL_compiling.cop_hints
-           = Perl_refcounted_he_copy(aTHX_ PL_compiling.cop_hints);
-#else
+       HINTS_REFCNT_LOCK;
        PL_compiling.cop_hints->refcounted_he_refcnt++;
-#endif
+       HINTS_REFCNT_UNLOCK;
     }
     /* special case: an eval '' executed within the DB package gets lexically
      * placed in the first non-DB CV rather than the current CV - this
@@ -4091,7 +4073,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
                PUSHs(other);
                PUSHs(*svp);
                PUTBACK;
-               if ((PL_curcop->op_private & HINT_INTEGER) == HINT_INTEGER)
+               if (CopHINTS_get(PL_curcop) & HINT_INTEGER)
                    (void) pp_i_eq();
                else
                    (void) pp_eq();
@@ -4185,7 +4167,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
        /* Otherwise, numeric comparison */
        PUSHs(d); PUSHs(e);
        PUTBACK;
-       if ((PL_curcop->op_private & HINT_INTEGER) == HINT_INTEGER)
+       if (CopHINTS_get(PL_curcop) & HINT_INTEGER)
            (void) pp_i_eq();
        else
            (void) pp_eq();