Re: stability of sort()?

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

diff --git a/pp.c b/pp.c
index fde8473..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))
@@ -448,10 +448,12 @@ PP(pp_prototype)
                    else if (n && str[0] == ';' && seen_question)
                        goto set;       /* XXXX system, exec */
                    if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
-                       && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
+                       && (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
+                       /* But globs are already references (kinda) */
+                       && (oa & (OA_OPTIONAL - 1)) != OA_FILEREF
+                   ) {
                        str[n++] = '\\';
                    }
-                   /* What to do with R ((un)tie, tied, (sys)read, recv)? */
                    str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
                    oa = oa >> 4;
                }
@@ -713,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;
 }
 
@@ -781,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:
@@ -1976,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)
@@ -2667,11 +2666,11 @@ PP(pp_hex)
     dSP; dTARGET;
     char *tmps;
     STRLEN argtype;
-    STRLEN n_a;
+    STRLEN len;
 
-    tmps = POPpx;
+    tmps = (SvPVx(POPs, len));
     argtype = 1;               /* allow underscores */
-    XPUSHn(scan_hex(tmps, 99, &argtype));
+    XPUSHn(scan_hex(tmps, len, &argtype));
     RETURN;
 }
 
@@ -2681,20 +2680,20 @@ PP(pp_oct)
     NV value;
     STRLEN argtype;
     char *tmps;
-    STRLEN n_a;
+    STRLEN len;
 
-    tmps = POPpx;
-    while (*tmps && isSPACE(*tmps))
-       tmps++;
+    tmps = (SvPVx(POPs, len));
+    while (*tmps && len && isSPACE(*tmps))
+       tmps++, len--;
     if (*tmps == '0')
-       tmps++;
+       tmps++, len--;
     argtype = 1;               /* allow underscores */
     if (*tmps == 'x')
-       value = scan_hex(++tmps, 99, &argtype);
+       value = scan_hex(++tmps, --len, &argtype);
     else if (*tmps == 'b')
-       value = scan_bin(++tmps, 99, &argtype);
+       value = scan_bin(++tmps, --len, &argtype);
     else
-       value = scan_oct(tmps, 99, &argtype);
+       value = scan_oct(tmps, len, &argtype);
     XPUSHn(value);
     RETURN;
 }
@@ -2812,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) {
@@ -2846,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';
@@ -2876,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) {
@@ -3561,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;
@@ -3709,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;
@@ -3903,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;
@@ -3959,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;
@@ -5461,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':
@@ -5842,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));
        }
@@ -6089,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");