This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
More descriptive names for operators.
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index 770b07d..07bb33d 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -406,6 +406,8 @@ PP(pp_rv2cv)
     if (cv) {
        if (CvCLONE(cv))
            cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+       if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv))
+           Perl_croak(aTHX_ "Can't modify non-lvalue subroutine call");
     }
     else
        cv = (CV*)&PL_sv_undef;
@@ -1776,9 +1778,9 @@ S_seed(pTHX)
 #  endif
 #endif
     u += SEED_C3 * (U32)getpid();
-    u += SEED_C4 * (U32)(UV)PL_stack_sp;
+    u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
 #ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
-    u += SEED_C5 * (U32)(UV)&when;
+    u += SEED_C5 * (U32)PTR2UV(&when);
 #endif
     return u;
 }
@@ -1885,14 +1887,14 @@ PP(pp_hex)
     STRLEN n_a;
 
     tmps = POPpx;
-    XPUSHu(scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype));
+    XPUSHn(scan_hex(tmps, 99, &argtype));
     RETURN;
 }
 
 PP(pp_oct)
 {
     djSP; dTARGET;
-    UV value;
+    NV value;
     I32 argtype;
     char *tmps;
     STRLEN n_a;
@@ -1900,15 +1902,15 @@ PP(pp_oct)
     tmps = POPpx;
     while (*tmps && isSPACE(*tmps))
        tmps++;
-    /* Do not eat the leading 0[bx] because we need them
-     * to detect malformed binary and hexadecimal numbers. */
-    if ((tmps[0] == '0' && tmps[1] == 'x') || tmps[0] == 'x')
-       value = scan_hex(tmps, sizeof(UV) * 2 + 1, &argtype);
-    else if ((tmps[0] == '0' && tmps[1] == 'b') || tmps[0] == 'b')
-       value = scan_bin(tmps, sizeof(UV) * 8 + 1, &argtype);
+    if (*tmps == '0')
+       tmps++;
+    if (*tmps == 'x')
+       value = scan_hex(++tmps, 99, &argtype);
+    else if (*tmps == 'b')
+       value = scan_bin(++tmps, 99, &argtype);
     else
-       value = scan_oct(tmps, sizeof(UV) * 4 + 1, &argtype);
-    XPUSHu(value);
+       value = scan_oct(tmps, 99, &argtype);
+    XPUSHn(value);
     RETURN;
 }
 
@@ -2052,74 +2054,24 @@ PP(pp_vec)
     register I32 offset = POPi;
     register SV *src = POPs;
     I32 lvalue = PL_op->op_flags & OPf_MOD;
-    STRLEN srclen;
-    unsigned char *s = (unsigned char*)SvPV(src, srclen);
-    unsigned long retnum;
-    I32 len;
-
-    SvTAINTED_off(TARG);                       /* decontaminate */
-    offset *= size;            /* turn into bit offset */
-    len = (offset + size + 7) / 8;
-    if (offset < 0 || size < 1)
-       retnum = 0;
-    else {
-       if (lvalue) {                      /* it's an lvalue! */
-           if (SvTYPE(TARG) < SVt_PVLV) {
-               sv_upgrade(TARG, SVt_PVLV);
-               sv_magic(TARG, Nullsv, 'v', Nullch, 0);
-           }
 
-           LvTYPE(TARG) = 'v';
-           if (LvTARG(TARG) != src) {
-               if (LvTARG(TARG))
-                   SvREFCNT_dec(LvTARG(TARG));
-               LvTARG(TARG) = SvREFCNT_inc(src);
-           }
-           LvTARGOFF(TARG) = offset;
-           LvTARGLEN(TARG) = size;
-       }
-       if (len > srclen) {
-           if (size <= 8)
-               retnum = 0;
-           else {
-               offset >>= 3;
-               if (size == 16) {
-                   if (offset >= srclen)
-                       retnum = 0;
-                   else
-                       retnum = (unsigned long) s[offset] << 8;
-               }
-               else if (size == 32) {
-                   if (offset >= srclen)
-                       retnum = 0;
-                   else if (offset + 1 >= srclen)
-                       retnum = (unsigned long) s[offset] << 24;
-                   else if (offset + 2 >= srclen)
-                       retnum = ((unsigned long) s[offset] << 24) +
-                           ((unsigned long) s[offset + 1] << 16);
-                   else
-                       retnum = ((unsigned long) s[offset] << 24) +
-                           ((unsigned long) s[offset + 1] << 16) +
-                           (s[offset + 2] << 8);
-               }
-           }
+    SvTAINTED_off(TARG);               /* decontaminate */
+    if (lvalue) {                      /* it's an lvalue! */
+       if (SvTYPE(TARG) < SVt_PVLV) {
+           sv_upgrade(TARG, SVt_PVLV);
+           sv_magic(TARG, Nullsv, 'v', Nullch, 0);
        }
-       else if (size < 8)
-           retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
-       else {
-           offset >>= 3;
-           if (size == 8)
-               retnum = s[offset];
-           else if (size == 16)
-               retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
-           else if (size == 32)
-               retnum = ((unsigned long) s[offset] << 24) +
-                       ((unsigned long) s[offset + 1] << 16) +
-                       (s[offset + 2] << 8) + s[offset+3];
+       LvTYPE(TARG) = 'v';
+       if (LvTARG(TARG) != src) {
+           if (LvTARG(TARG))
+               SvREFCNT_dec(LvTARG(TARG));
+           LvTARG(TARG) = SvREFCNT_inc(src);
        }
+       LvTARGOFF(TARG) = offset;
+       LvTARGLEN(TARG) = size;
     }
 
-    sv_setuv(TARG, (UV)retnum);
+    sv_setuv(TARG, do_vecget(src, offset, size));
     PUSHs(TARG);
     RETURN;
 }
@@ -3350,8 +3302,11 @@ PP(pp_unpack)
        }
        else if (isDIGIT(*pat)) {
            len = *pat++ - '0';
-           while (isDIGIT(*pat))
+           while (isDIGIT(*pat)) {
                len = (len * 10) + (*pat++ - '0');
+               if (len < 0)
+                   Perl_croak(aTHX_ "Repeat count in unpack overflows");
+           }
        }
        else
            len = (datumtype != '@');
@@ -3608,6 +3563,7 @@ PP(pp_unpack)
            if (checksum) {
 #if SHORTSIZE != SIZE16
                if (natint) {
+                   short ashort;
                    while (len-- > 0) {
                        COPYNN(s, &ashort, sizeof(short));
                        s += sizeof(short);
@@ -3634,6 +3590,7 @@ PP(pp_unpack)
                EXTEND_MORTAL(len);
 #if SHORTSIZE != SIZE16
                if (natint) {
+                   short ashort;
                    while (len-- > 0) {
                        COPYNN(s, &ashort, sizeof(short));
                        s += sizeof(short);
@@ -3673,6 +3630,7 @@ PP(pp_unpack)
            if (checksum) {
 #if SHORTSIZE != SIZE16
                if (unatint) {
+                   unsigned short aushort;
                    while (len-- > 0) {
                        COPYNN(s, &aushort, sizeof(unsigned short));
                        s += sizeof(unsigned short);
@@ -3702,6 +3660,7 @@ PP(pp_unpack)
                EXTEND_MORTAL(len);
 #if SHORTSIZE != SIZE16
                if (unatint) {
+                   unsigned short aushort;
                    while (len-- > 0) {
                        COPYNN(s, &aushort, sizeof(unsigned short));
                        s += sizeof(unsigned short);
@@ -3826,6 +3785,7 @@ PP(pp_unpack)
            if (checksum) {
 #if LONGSIZE != SIZE32
                if (natint) {
+                   long along;
                    while (len-- > 0) {
                        COPYNN(s, &along, sizeof(long));
                        s += sizeof(long);
@@ -3857,6 +3817,7 @@ PP(pp_unpack)
                EXTEND_MORTAL(len);
 #if LONGSIZE != SIZE32
                if (natint) {
+                   long along;
                    while (len-- > 0) {
                        COPYNN(s, &along, sizeof(long));
                        s += sizeof(long);
@@ -3896,6 +3857,7 @@ PP(pp_unpack)
            if (checksum) {
 #if LONGSIZE != SIZE32
                if (unatint) {
+                   unsigned long aulong;
                    while (len-- > 0) {
                        COPYNN(s, &aulong, sizeof(unsigned long));
                        s += sizeof(unsigned long);
@@ -3931,6 +3893,7 @@ PP(pp_unpack)
                EXTEND_MORTAL(len);
 #if LONGSIZE != SIZE32
                if (unatint) {
+                   unsigned long aulong;
                    while (len-- > 0) {
                        COPYNN(s, &aulong, sizeof(unsigned long));
                        s += sizeof(unsigned long);
@@ -4394,8 +4357,11 @@ PP(pp_pack)
        }
        else if (isDIGIT(*pat)) {
            len = *pat++ - '0';
-           while (isDIGIT(*pat))
+           while (isDIGIT(*pat)) {
                len = (len * 10) + (*pat++ - '0');
+               if (len < 0)
+                   Perl_croak(aTHX_ "Repeat count in pack overflows");
+           }
        }
        else
            len = 1;
@@ -4666,6 +4632,8 @@ PP(pp_pack)
        case 's':
 #if SHORTSIZE != SIZE16
            if (natint) {
+               short ashort;
+
                while (len-- > 0) {
                    fromstr = NEXTFROM;
                    ashort = SvIV(fromstr);
@@ -4789,6 +4757,8 @@ PP(pp_pack)
        case 'L':
 #if LONGSIZE != SIZE32
            if (natint) {
+               unsigned long aulong;
+
                while (len-- > 0) {
                    fromstr = NEXTFROM;
                    aulong = SvUV(fromstr);
@@ -4808,6 +4778,8 @@ PP(pp_pack)
        case 'l':
 #if LONGSIZE != SIZE32
            if (natint) {
+               long along;
+
                while (len-- > 0) {
                    fromstr = NEXTFROM;
                    along = SvIV(fromstr);
@@ -4828,7 +4800,7 @@ PP(pp_pack)
        case 'Q':
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               auquad = (Uquad_t)SvIV(fromstr);
+               auquad = (Uquad_t)SvUV(fromstr);
                sv_catpvn(cat, (char*)&auquad, sizeof(Uquad_t));
            }
            break;
@@ -4957,6 +4929,7 @@ PP(pp_split)
        else {
            if (!AvREAL(ary)) {
                AvREAL_on(ary);
+               AvREIFY_off(ary);
                for (i = AvFILLp(ary); i >= 0; i--)
                    AvARRAY(ary)[i] = &PL_sv_undef;     /* don't free mere refs */
            }
Unnamed repository; edit this file 'description' to name the repository.