perlfaq typos
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index 9d9ad5c..2686116 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -211,6 +211,8 @@ PP(pp_rv2gv)
 
     if (SvROK(sv)) {
       wasref:
+       tryAMAGICunDEREF(to_gv);
+
        sv = SvRV(sv);
        if (SvTYPE(sv) == SVt_PVIO) {
            GV *gv = (GV*) sv_newmortal();
@@ -233,14 +235,14 @@ PP(pp_rv2gv)
            if (!SvOK(sv)) {
                if (PL_op->op_flags & OPf_REF ||
                    PL_op->op_private & HINT_STRICT_REFS)
-                   DIE(no_usym, "a symbol");
+                   DIE(PL_no_usym, "a symbol");
                if (ckWARN(WARN_UNINITIALIZED))
-                   warner(WARN_UNINITIALIZED, warn_uninit);
+                   warner(WARN_UNINITIALIZED, PL_warn_uninit);
                RETSETUNDEF;
            }
            sym = SvPV(sv, PL_na);
            if (PL_op->op_private & HINT_STRICT_REFS)
-               DIE(no_symref, sym, "a symbol");
+               DIE(PL_no_symref, sym, "a symbol");
            sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
        }
     }
@@ -256,6 +258,8 @@ PP(pp_rv2sv)
 
     if (SvROK(sv)) {
       wasref:
+       tryAMAGICunDEREF(to_sv);
+
        sv = SvRV(sv);
        switch (SvTYPE(sv)) {
        case SVt_PVAV:
@@ -277,14 +281,14 @@ PP(pp_rv2sv)
            if (!SvOK(sv)) {
                if (PL_op->op_flags & OPf_REF ||
                    PL_op->op_private & HINT_STRICT_REFS)
-                   DIE(no_usym, "a SCALAR");
+                   DIE(PL_no_usym, "a SCALAR");
                if (ckWARN(WARN_UNINITIALIZED))
-                   warner(WARN_UNINITIALIZED, warn_uninit);
+                   warner(WARN_UNINITIALIZED, PL_warn_uninit);
                RETSETUNDEF;
            }
            sym = SvPV(sv, PL_na);
            if (PL_op->op_private & HINT_STRICT_REFS)
-               DIE(no_symref, sym, "a SCALAR");
+               DIE(PL_no_symref, sym, "a SCALAR");
            gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
        }
        sv = GvSV(gv);
@@ -390,13 +394,16 @@ PP(pp_prototype)
                char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
 
                while (i < MAXO) {      /* The slow way. */
-                   if (strEQ(s + 6, op_name[i]) || strEQ(s + 6, op_desc[i]))
+                   if (strEQ(s + 6, PL_op_name[i])
+                       || strEQ(s + 6, PL_op_desc[i]))
+                   {
                        goto found;
+                   }
                    i++;
                }
                goto nonesuch;          /* Should not happen... */
              found:
-               oa = opargs[i] >> OASHIFT;
+               oa = PL_opargs[i] >> OASHIFT;
                while (oa) {
                    if (oa & OA_OPTIONAL) {
                        seen_question = 1;
@@ -812,7 +819,7 @@ PP(pp_predec)
 {
     djSP;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       croak(no_modify);
+       croak(PL_no_modify);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MIN)
     {
@@ -829,7 +836,7 @@ PP(pp_postinc)
 {
     djSP; dTARGET;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       croak(no_modify);
+       croak(PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MAX)
@@ -850,7 +857,7 @@ PP(pp_postdec)
 {
     djSP; dTARGET;
     if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       croak(no_modify);
+       croak(PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MIN)
@@ -1316,6 +1323,10 @@ PP(pp_negate)
                sv_setsv(TARG, sv);
                *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
            }
+           else if (IN_UTF8 && *(U8*)s >= 0xc0 && isIDFIRST_utf8((U8*)s)) {
+               sv_setpvn(TARG, "-", 1);
+               sv_catsv(TARG, sv);
+           }
            else
                sv_setnv(TARG, -SvNV(sv));
            SETTARG;
@@ -2116,15 +2127,15 @@ PP(pp_sprintf)
 PP(pp_ord)
 {
     djSP; dTARGET;
-    I32 value;
+    UV value;
     U8 *tmps = (U8*)POPp;
     I32 retlen;
 
     if (IN_UTF8 && (*tmps & 0x80))
-       value = (I32) utf8_to_uv(tmps, &retlen);
+       value = utf8_to_uv(tmps, &retlen);
     else
-       value = (I32) (*tmps & 255);
-    XPUSHi(value);
+       value = (UV)(*tmps & 255);
+    XPUSHu(value);
     RETURN;
 }
 
@@ -2132,7 +2143,7 @@ PP(pp_chr)
 {
     djSP; dTARGET;
     char *tmps;
-    I32 value = POPi;
+    U32 value = POPu;
 
     (void)SvUPGRADE(TARG,SVt_PV);
 
@@ -2440,10 +2451,30 @@ PP(pp_quotemeta)
        (void)SvUPGRADE(TARG, SVt_PV);
        SvGROW(TARG, (len * 2) + 1);
        d = SvPVX(TARG);
-       while (len--) {
-           if (!(*s & 0x80) && !isALNUM(*s))
-               *d++ = '\\';
-           *d++ = *s++;
+       if (IN_UTF8) {
+           while (len) {
+               if (*s & 0x80) {
+                   STRLEN ulen = UTF8SKIP(s);
+                   if (ulen > len)
+                       ulen = len;
+                   len -= ulen;
+                   while (ulen--)
+                       *d++ = *s++;
+               }
+               else {
+                   if (!isALNUM(*s))
+                       *d++ = '\\';
+                   *d++ = *s++;
+                   len--;
+               }
+           }
+       }
+       else {
+           while (len--) {
+               if (!isALNUM(*s))
+                   *d++ = '\\';
+               *d++ = *s++;
+           }
        }
        *d = '\0';
        SvCUR_set(TARG, d - SvPVX(TARG));
@@ -2485,7 +2516,7 @@ PP(pp_aslice)
            svp = av_fetch(av, elem, lval);
            if (lval) {
                if (!svp || *svp == &PL_sv_undef)
-                   DIE(no_aelem, elem);
+                   DIE(PL_no_aelem, elem);
                if (PL_op->op_private & OPpLVAL_INTRO)
                    save_aelem(av, elem, svp);
            }
@@ -2625,7 +2656,7 @@ PP(pp_hslice)
            }
            if (lval) {
                if (!svp || *svp == &PL_sv_undef)
-                   DIE(no_helem, SvPV(keysv, PL_na));
+                   DIE(PL_no_helem, SvPV(keysv, PL_na));
                if (PL_op->op_private & OPpLVAL_INTRO)
                    save_helem(hv, keysv, svp);
            }
@@ -2757,8 +2788,8 @@ PP(pp_splice)
     SV **tmparyval = 0;
     MAGIC *mg;
 
-    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
-       *MARK-- = mg->mg_obj;
+    if (mg = SvTIED_mg((SV*)ary, 'P')) {
+       *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
        ENTER;
@@ -2777,7 +2808,7 @@ PP(pp_splice)
        else
            offset -= PL_curcop->cop_arybase;
        if (offset < 0)
-           DIE(no_aelem, i);
+           DIE(PL_no_aelem, i);
        if (++MARK < SP) {
            length = SvIVx(*MARK++);
            if (length < 0) {
@@ -2955,8 +2986,8 @@ PP(pp_push)
     register SV *sv = &PL_sv_undef;
     MAGIC *mg;
 
-    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
-       *MARK-- = mg->mg_obj;
+    if (mg = SvTIED_mg((SV*)ary, 'P')) {
+       *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
        ENTER;
@@ -3011,8 +3042,8 @@ PP(pp_unshift)
     register I32 i = 0;
     MAGIC *mg;
 
-    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
-       *MARK-- = mg->mg_obj;
+    if (mg = SvTIED_mg((SV*)ary, 'P')) {
+       *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
        ENTER;
@@ -3172,7 +3203,7 @@ PP(pp_unpack)
     unsigned int auint;
     U32 aulong;
 #ifdef HAS_QUAD
-    unsigned Quad_t auquad;
+    Uquad_t auquad;
 #endif
     char *aptr;
     float afloat;
@@ -3429,7 +3460,7 @@ PP(pp_unpack)
                    auint = utf8_to_uv((U8*)s, &along);
                    s += along;
                    sv = NEWSV(37, 0);
-                   sv_setiv(sv, (IV)auint);
+                   sv_setuv(sv, (UV)auint);
                    PUSHs(sv_2mortal(sv));
                }
            }
@@ -3729,11 +3760,11 @@ PP(pp_unpack)
            EXTEND(SP, len);
            EXTEND_MORTAL(len);
            while (len-- > 0) {
-               if (s + sizeof(unsigned Quad_t) > strend)
+               if (s + sizeof(Uquad_t) > strend)
                    auquad = 0;
                else {
-                   Copy(s, &auquad, 1, unsigned Quad_t);
-                   s += sizeof(unsigned Quad_t);
+                   Copy(s, &auquad, 1, Uquad_t);
+                   s += sizeof(Uquad_t);
                }
                sv = NEWSV(43, 0);
                if (auquad <= UV_MAX)
@@ -4020,7 +4051,7 @@ PP(pp_pack)
     U32 aulong;
 #ifdef HAS_QUAD
     Quad_t aquad;
-    unsigned Quad_t auquad;
+    Uquad_t auquad;
 #endif
     char *aptr;
     float afloat;
@@ -4407,8 +4438,8 @@ PP(pp_pack)
        case 'Q':
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               auquad = (unsigned Quad_t)SvIV(fromstr);
-               sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
+               auquad = (Uquad_t)SvIV(fromstr);
+               sv_catpvn(cat, (char*)&auquad, sizeof(Uquad_t));
            }
            break;
        case 'q':
@@ -4528,9 +4559,9 @@ PP(pp_split)
        av_extend(ary,0);
        av_clear(ary);
        SPAGAIN;
-       if (SvRMAGICAL(ary) && (mg = mg_find((SV *) ary, 'P'))) {
+       if (mg = SvTIED_mg((SV*)ary, 'P')) {
            PUSHMARK(SP);
-           XPUSHs(mg->mg_obj);
+           XPUSHs(SvTIED_obj((SV*)ary, mg));
        }
        else {
            if (!AvREAL(ary)) {
@@ -4779,7 +4810,6 @@ PP(pp_lock)
        DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
                              (unsigned long)thr, (unsigned long)sv);)
        MUTEX_UNLOCK(MgMUTEXP(mg));
-       SvREFCNT_inc(sv);       /* keep alive until magic_mutexfree */
        save_destructor(unlock_condpair, sv);
     }
 #endif /* USE_THREADS */