Integrate with Sarathy; manual resolve on regcomp.c conflicts

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

diff --git a/op.c b/op.c
index bc47f6d..b8006a1 100644 (file)
--- a/op.c
+++ b/op.c
@@ -450,12 +450,14 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
     SvFLAGS(sv) |= tmptype;
     PL_curpad = AvARRAY(PL_comppad);
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad,
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" alloc %ld for %s\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad),
                          (long) retval, PL_op_name[optype]));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n",
-                         (unsigned long) PL_curpad,
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "Pad 0x%"UVxf" alloc %ld for %s\n",
+                         PTR2UV(PL_curpad),
                          (long) retval, PL_op_name[optype]));
 #endif /* USE_THREADS */
     return (PADOFFSET)retval;
@@ -466,13 +468,14 @@ Perl_pad_sv(pTHX_ PADOFFSET po)
 {
     dTHR;
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" sv %d\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), po));
 #else
     if (!po)
        Perl_croak(aTHX_ "panic: pad_sv po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n",
-                         (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %d\n",
+                         PTR2UV(PL_curpad), po));
 #endif /* USE_THREADS */
     return PL_curpad[po];              /* eventually we'll turn this into a macro */
 }
@@ -488,11 +491,12 @@ Perl_pad_free(pTHX_ PADOFFSET po)
     if (!po)
        Perl_croak(aTHX_ "panic: pad_free po");
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" free %d\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n",
-                         (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %d\n",
+                         PTR2UV(PL_curpad), po));
 #endif /* USE_THREADS */
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
        SvPADTMP_off(PL_curpad[po]);
@@ -509,11 +513,12 @@ Perl_pad_swipe(pTHX_ PADOFFSET po)
     if (!po)
        Perl_croak(aTHX_ "panic: pad_swipe po");
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" swipe %d\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad), po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n",
-                         (unsigned long) PL_curpad, po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %d\n",
+                         PTR2UV(PL_curpad), po));
 #endif /* USE_THREADS */
     SvPADTMP_off(PL_curpad[po]);
     PL_curpad[po] = NEWSV(1107,0);
@@ -538,11 +543,12 @@ Perl_pad_reset(pTHX)
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad");
 #ifdef USE_THREADS
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
-                         (unsigned long) thr, (unsigned long) PL_curpad));
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+                         "0x%"UVxf" Pad 0x%"UVxf" reset\n",
+                         PTR2UV(thr), PTR2UV(PL_curpad)));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n",
-                         (unsigned long) PL_curpad));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" reset\n",
+                         PTR2UV(PL_curpad)));
 #endif /* USE_THREADS */
     if (!PL_tainting) {        /* Can't mix tainted and non-tainted temporaries. */
        for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
@@ -1810,9 +1816,9 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
       char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
                             right->op_type == OP_TRANS)
                            ? right->op_type : OP_MATCH];
-      char *sample = ((left->op_type == OP_RV2AV ||
-                       left->op_type == OP_PADAV)
-                      ? "@array" : "%hash");
+      const char *sample = ((left->op_type == OP_RV2AV ||
+                            left->op_type == OP_PADAV)
+                           ? "@array" : "%hash");
       Perl_warner(aTHX_ WARN_UNSAFE,
              "Applying %s to %s will act on scalar(%s)", 
              desc, sample, sample);
@@ -1861,10 +1867,8 @@ Perl_scope(pTHX_ OP *o)
                o->op_type = OP_SCOPE;
                o->op_ppaddr = PL_ppaddr[OP_SCOPE];
                kid = ((LISTOP*)o)->op_first;
-               if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
-                   kid->op_type = OP_SETSTATE;
-                   kid->op_ppaddr = PL_ppaddr[OP_SETSTATE];
-               }
+               if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
+                   null(kid);
            }
            else
                o = newLISTOP(OP_SCOPE, 0, o, Nullop);
@@ -2114,8 +2118,12 @@ Perl_fold_constants(pTHX_ register OP *o)
        return o;
 
     if (!(PL_hints & HINT_INTEGER)) {
-       if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
+       if (type == OP_MODULO
+           || type == OP_DIVIDE
+           || !(o->op_flags & OPf_KIDS))
+       {
            return o;
+       }
 
        for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
            if (curop->op_type == OP_CONST) {
@@ -3001,6 +3009,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
                newSTATEOP(0, Nullch, veop)),
            newSTATEOP(0, Nullch, imop) ));
 
+    PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
     PL_expect = XSTATE;
 }
@@ -3352,14 +3361,20 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
            if (k2 && k2->op_type == OP_READLINE
                  && (k2->op_flags & OPf_STACKED)
                  && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
+           {
                warnop = k2->op_type;
+           }
            break;
 
        case OP_SASSIGN:
            if (k1->op_type == OP_READDIR
                  || k1->op_type == OP_GLOB
+                 || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
                  || k1->op_type == OP_EACH)
-               warnop = k1->op_type;
+           {
+               warnop = ((k1->op_type == OP_NULL)
+                         ? k1->op_targ : k1->op_type);
+           }
            break;
        }
        if (warnop) {
@@ -3531,6 +3546,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
              case OP_SASSIGN:
                if (k1->op_type == OP_READDIR
                      || k1->op_type == OP_GLOB
+                     || (k1->op_type == OP_NULL && k1->op_targ == OP_NULL)
                      || k1->op_type == OP_EACH)
                    expr = newUNOP(OP_DEFINED, 0, expr);
                break;
@@ -3584,6 +3600,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *
          case OP_SASSIGN:
            if (k1->op_type == OP_READDIR
                  || k1->op_type == OP_GLOB
+                 || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
                  || k1->op_type == OP_EACH)
                expr = newUNOP(OP_DEFINED, 0, expr);
            break;
@@ -3835,13 +3852,14 @@ cv_dump(CV *cv)
     SV** ppad;
     I32 ix;
 
-    PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n",
-                 cv,
+    PerlIO_printf(Perl_debug_log,
+                 "\tCV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
+                 PTR2UV(cv),
                  (CvANON(cv) ? "ANON"
                   : (cv == PL_main_cv) ? "MAIN"
                   : CvUNIQUE(cv) ? "UNIQUE"
                   : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
-                 outside,
+                 PTR2UV(outside),
                  (!outside ? "null"
                   : CvANON(outside) ? "ANON"
                   : (outside == PL_main_cv) ? "MAIN"
@@ -3858,12 +3876,13 @@ cv_dump(CV *cv)
 
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
        if (SvPOK(pname[ix]))
-           PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
-                         ix, ppad[ix],
+           PerlIO_printf(Perl_debug_log,
+                         "\t%4d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
+                         ix, PTR2UV(ppad[ix]),
                          SvFAKE(pname[ix]) ? "FAKE " : "",
                          SvPVX(pname[ix]),
-                         (long)I_32(SvNVX(pname[ix])),
-                         (long)SvIVX(pname[ix]));
+                         (IV)I_32(SvNVX(pname[ix])),
+                         SvIVX(pname[ix]));
     }
 }
 #endif /* DEBUG_CLOSURES */
@@ -5048,17 +5067,10 @@ Perl_ck_fun(pTHX_ OP *o)
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
-#ifdef IV_IS_QUAD
                    if (ckWARN(WARN_SYNTAX))
                        Perl_warner(aTHX_ WARN_SYNTAX,
-                           "Array @%s missing the @ in argument %" PERL_PRId64 " of %s()",
+                           "Array @%s missing the @ in argument %"IVdf" of %s()",
                            name, (IV)numargs, PL_op_desc[type]);
-#else
-                   if (ckWARN(WARN_SYNTAX))
-                       Perl_warner(aTHX_ WARN_SYNTAX,
-                           "Array @%s missing the @ in argument %ld of %s()",
-                           name, (long)numargs, PL_op_desc[type]);
-#endif
                    op_free(kid);
                    kid = newop;
                    kid->op_sibling = sibl;
@@ -5075,17 +5087,10 @@ Perl_ck_fun(pTHX_ OP *o)
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
-#ifdef IV_IS_QUAD
                    if (ckWARN(WARN_SYNTAX))
                        Perl_warner(aTHX_ WARN_SYNTAX,
-                           "Hash %%%s missing the %% in argument %" PERL_PRId64 " of %s()",
+                           "Hash %%%s missing the %% in argument %"IVdf" of %s()",
                            name, (IV)numargs, PL_op_desc[type]);
-#else
-                   if (ckWARN(WARN_SYNTAX))
-                       Perl_warner(aTHX_ WARN_SYNTAX,
-                           "Hash %%%s missing the %% in argument %ld of %s()",
-                           name, (long)numargs, PL_op_desc[type]);
-#endif
                    op_free(kid);
                    kid = newop;
                    kid->op_sibling = sibl;
@@ -5188,6 +5193,19 @@ Perl_ck_glob(pTHX_ OP *o)
     if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 
+#if defined(PERL_INTERNAL_GLOB) && !defined(MINIPERL_BUILD)
+    /* XXX this can be tightened up and made more failsafe. */
+    if (!gv) {
+       OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10));
+       modname->op_private |= OPpCONST_BARE;
+       ENTER;
+       utilize(1, start_subparse(FALSE, 0), Nullop, modname,
+               newSVOP(OP_CONST, 0, newSVpvn("globally", 8)));
+       gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
+       LEAVE;
+    }
+#endif /* PERL_INTERNAL_GLOB && !MINIPERL_BUILD */
+
     if (gv && GvIMPORTED_CV(gv)) {
        append_elem(OP_GLOB, o,
                    newSVOP(OP_CONST, 0, newSViv(PL_glob_index++)));
@@ -6155,7 +6173,7 @@ Perl_peep(pTHX_ register OP *o)
            key = SvPV(*svp, keylen);
            indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
            if (!indsvp) {
-               Perl_croak(aTHX_ "No such field \"%s\" in variable %s of type %s",
+               Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s",
                      key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
            }
            ind = SvIV(*indsvp);
@@ -6173,13 +6191,15 @@ Perl_peep(pTHX_ register OP *o)
        case OP_RV2AV:
        case OP_RV2HV:
            if (!(o->op_flags & OPf_WANT)
-               || o->op_flags & OPf_WANT == OPf_WANT_LIST)
+               || (o->op_flags & OPf_WANT) == OPf_WANT_LIST)
+           {
                last_composite = o;
+           }
            o->op_seq = PL_op_seqmax++;
            break;
 
        case OP_RETURN:
-           if (o->op_next->op_type != OP_LEAVESUBLV) {
+           if (o->op_next && o->op_next->op_type != OP_LEAVESUBLV) {
                o->op_seq = PL_op_seqmax++;
                break;
            }