Adding the new test would be swell.

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

diff --git a/pp.c b/pp.c
index 6730f29..976d449 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -341,7 +341,7 @@ PP(pp_av2arylen)
     if (!sv) {
        AvARYLEN(av) = sv = NEWSV(0,0);
        sv_upgrade(sv, SVt_IV);
-       sv_magic(sv, (SV*)av, '#', Nullch, 0);
+       sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
     }
     SETs(sv);
     RETURN;
@@ -354,7 +354,7 @@ PP(pp_pos)
     if (PL_op->op_flags & OPf_MOD || LVRET) {
        if (SvTYPE(TARG) < SVt_PVLV) {
            sv_upgrade(TARG, SVt_PVLV);
-           sv_magic(TARG, Nullsv, '.', Nullch, 0);
+           sv_magic(TARG, Nullsv, PERL_MAGIC_pos, Nullch, 0);
        }
 
        LvTYPE(TARG) = '.';
@@ -370,7 +370,7 @@ PP(pp_pos)
        MAGIC* mg;
 
        if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
-           mg = mg_find(sv, 'g');
+           mg = mg_find(sv, PERL_MAGIC_regex_global);
            if (mg && mg->mg_len >= 0) {
                I32 i = mg->mg_len;
                if (DO_UTF8(sv))
@@ -715,7 +715,8 @@ PP(pp_study)
     }
 
     SvSCREAM_on(sv);
-    sv_magic(sv, Nullsv, 'g', Nullch, 0);      /* piggyback on m//g magic */
+    /* piggyback on m//g magic */
+    sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
     RETPUSHYES;
 }
 
@@ -783,11 +784,13 @@ PP(pp_defined)
        RETPUSHNO;
     switch (SvTYPE(sv)) {
     case SVt_PVAV:
-       if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
+       if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
+               || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
            RETPUSHYES;
        break;
     case SVt_PVHV:
-       if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
+       if (HvARRAY(sv) || SvGMAGICAL(sv)
+               || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
            RETPUSHYES;
        break;
     case SVt_PVCV:
@@ -1978,12 +1981,6 @@ PP(pp_sne)
 PP(pp_scmp)
 {
     dSP; dTARGET;  tryAMAGICbin(scmp,0);
-#ifndef NV_PRESERVES_UV
-    if (SvROK(TOPs) && SvROK(TOPm1s)) {
-       SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
-       RETURN;
-    }
-#endif
     {
       dPOPTOPssrl;
       int cmp = ((PL_op->op_private & OPpLOCALE)
@@ -2814,6 +2811,9 @@ PP(pp_substr)
            sv_pos_u2b(sv, &pos, &rem);
        tmps += pos;
        sv_setpvn(TARG, tmps, rem);
+#ifdef USE_LOCALE_COLLATE
+       sv_unmagic(TARG, PERL_MAGIC_collxfrm);
+#endif
        if (utf8_curlen)
            SvUTF8_on(TARG);
        if (repl) {
@@ -2848,7 +2848,7 @@ PP(pp_substr)
 
            if (SvTYPE(TARG) < SVt_PVLV) {
                sv_upgrade(TARG, SVt_PVLV);
-               sv_magic(TARG, Nullsv, 'x', Nullch, 0);
+               sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
            }
 
            LvTYPE(TARG) = 'x';
@@ -2878,7 +2878,7 @@ PP(pp_vec)
     if (lvalue) {                      /* it's an lvalue! */
        if (SvTYPE(TARG) < SVt_PVLV) {
            sv_upgrade(TARG, SVt_PVLV);
-           sv_magic(TARG, Nullsv, 'v', Nullch, 0);
+           sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);
        }
        LvTYPE(TARG) = 'v';
        if (LvTARG(TARG) != src) {
@@ -3563,7 +3563,9 @@ PP(pp_hslice)
        while (++MARK <= SP) {
            SV *keysv = *MARK;
            SV **svp;
-           I32 preeminent = SvRMAGICAL(hv) ? 1 : hv_exists_ent(hv, keysv, 0);
+           I32 preeminent = SvRMAGICAL(hv) ? 1 :
+                               realhv ? hv_exists_ent(hv, keysv, 0)
+                                      : avhv_exists_ent((AV*)hv, keysv, 0);
            if (realhv) {
                HE *he = hv_fetch_ent(hv, keysv, lval, 0);
                svp = he ? &HeVAL(he) : 0;
@@ -3711,7 +3713,7 @@ PP(pp_splice)
     SV **tmparyval = 0;
     MAGIC *mg;
 
-    if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+    if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
        *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
@@ -3905,7 +3907,7 @@ PP(pp_push)
     register SV *sv = &PL_sv_undef;
     MAGIC *mg;
 
-    if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+    if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
        *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
@@ -3961,7 +3963,7 @@ PP(pp_unshift)
     register I32 i = 0;
     MAGIC *mg;
 
-    if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+    if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
        *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
@@ -5463,9 +5465,26 @@ PP(pp_pack)
        case 'c':
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               aint = SvIV(fromstr);
-               achar = aint;
-               sv_catpvn(cat, &achar, sizeof(char));
+               switch (datumtype) {
+               case 'C':
+                   aint = SvIV(fromstr);
+                   if ((aint < 0 || aint > 255) &&
+                       ckWARN(WARN_PACK))
+                       Perl_warner(aTHX_ WARN_PACK,
+                                   "Character in \"C\" format wrapped");
+                   achar = aint & 255;
+                   sv_catpvn(cat, &achar, sizeof(char));
+                   break;
+               case 'c':
+                   aint = SvIV(fromstr);
+                   if ((aint < -128 || aint > 127) &&
+                       ckWARN(WARN_PACK))
+                       Perl_warner(aTHX_ WARN_PACK,
+                                   "Character in \"c\" format wrapped");
+                   achar = aint & 255;
+                   sv_catpvn(cat, &achar, sizeof(char));
+                   break;
+               }
            }
            break;
        case 'U':
@@ -5844,7 +5863,7 @@ PP(pp_split)
        av_extend(ary,0);
        av_clear(ary);
        SPAGAIN;
-       if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+       if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
            PUSHMARK(SP);
            XPUSHs(SvTIED_obj((SV*)ary, mg));
        }
@@ -6091,7 +6110,7 @@ PP(pp_split)
 void
 Perl_unlock_condpair(pTHX_ void *svv)
 {
-    MAGIC *mg = mg_find((SV*)svv, 'm');
+    MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex);
 
     if (!mg)
        Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");