slurping an empty file should return '' rather than undef, with
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index 0bd4842..348cff9 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -107,8 +107,6 @@ static SV* refto _((SV* sv));
 static U32 seed _((void));
 #endif
 
-static bool srand_called = FALSE;
-
 /* variations on pp_null */
 
 #ifdef I_UNISTD
@@ -226,6 +224,7 @@ PP(pp_rv2gv)
     else {
        if (SvTYPE(sv) != SVt_PVGV) {
            char *sym;
+           STRLEN n_a;
 
            if (SvGMAGICAL(sv)) {
                mg_get(sv);
@@ -240,10 +239,19 @@ PP(pp_rv2gv)
                    warner(WARN_UNINITIALIZED, PL_warn_uninit);
                RETSETUNDEF;
            }
-           sym = SvPV(sv, PL_na);
-           if (PL_op->op_private & HINT_STRICT_REFS)
-               DIE(PL_no_symref, sym, "a symbol");
-           sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
+           sym = SvPV(sv, n_a);
+           if ((PL_op->op_flags & OPf_SPECIAL) &&
+               !(PL_op->op_flags & OPf_MOD))
+           {
+               sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV);
+               if (!sv)
+                   RETSETUNDEF;
+           }
+           else {
+               if (PL_op->op_private & HINT_STRICT_REFS)
+                   DIE(PL_no_symref, sym, "a symbol");
+               sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
+           }
        }
     }
     if (PL_op->op_private & OPpLVAL_INTRO)
@@ -271,6 +279,7 @@ PP(pp_rv2sv)
     else {
        GV *gv = (GV*)sv;
        char *sym;
+       STRLEN n_a;
 
        if (SvTYPE(gv) != SVt_PVGV) {
            if (SvGMAGICAL(sv)) {
@@ -286,10 +295,19 @@ PP(pp_rv2sv)
                    warner(WARN_UNINITIALIZED, PL_warn_uninit);
                RETSETUNDEF;
            }
-           sym = SvPV(sv, PL_na);
-           if (PL_op->op_private & HINT_STRICT_REFS)
-               DIE(PL_no_symref, sym, "a SCALAR");
-           gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
+           sym = SvPV(sv, n_a);
+           if ((PL_op->op_flags & OPf_SPECIAL) &&
+               !(PL_op->op_flags & OPf_MOD))
+           {
+               gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV);
+               if (!gv)
+                   RETSETUNDEF;
+           }
+           else {
+               if (PL_op->op_private & HINT_STRICT_REFS)
+                   DIE(PL_no_symref, sym, "a SCALAR");
+               gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
+           }
        }
        sv = GvSV(gv);
     }
@@ -544,9 +562,10 @@ PP(pp_gelem)
     SV *tmpRef;
     char *elem;
     djSP;
-
+    STRLEN n_a;
     sv = POPs;
-    elem = SvPV(sv, PL_na);
+    elem = SvPV(sv, n_a);
     gv = (GV*)POPs;
     tmpRef = Nullsv;
     sv = Nullsv;
@@ -1342,9 +1361,7 @@ PP(pp_negate)
 
 PP(pp_not)
 {
-#ifdef OVERLOAD
     djSP; tryAMAGICunSET(not);
-#endif /* OVERLOAD */
     *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
     return NORMAL;
 }
@@ -1593,9 +1610,9 @@ PP(pp_rand)
        value = POPn;
     if (value == 0.0)
        value = 1.0;
-    if (!srand_called) {
+    if (!PL_srand_called) {
        (void)seedDrand01((Rand_seed_t)seed());
-       srand_called = TRUE;
+       PL_srand_called = TRUE;
     }
     value *= Drand01();
     XPUSHn(value);
@@ -1611,7 +1628,7 @@ PP(pp_srand)
     else
        anum = POPu;
     (void)seedDrand01((Rand_seed_t)anum);
-    srand_called = TRUE;
+    PL_srand_called = TRUE;
     EXTEND(SP, 1);
     RETPUSHYES;
 }
@@ -1797,8 +1814,9 @@ PP(pp_hex)
     djSP; dTARGET;
     char *tmps;
     I32 argtype;
+    STRLEN n_a;
 
-    tmps = POPp;
+    tmps = POPpx;
     XPUSHu(scan_hex(tmps, 99, &argtype));
     RETURN;
 }
@@ -1809,14 +1827,17 @@ PP(pp_oct)
     UV value;
     I32 argtype;
     char *tmps;
+    STRLEN n_a;
 
-    tmps = POPp;
+    tmps = POPpx;
     while (*tmps && isSPACE(*tmps))
        tmps++;
     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, 99, &argtype);
     XPUSHu(value);
@@ -1922,7 +1943,8 @@ PP(pp_substr)
        if (lvalue) {                   /* it's an lvalue! */
            if (!SvGMAGICAL(sv)) {
                if (SvROK(sv)) {
-                   SvPV_force(sv,PL_na);
+                   STRLEN n_a;
+                   SvPV_force(sv,n_a);
                    if (ckWARN(WARN_SUBSTR))
                        warner(WARN_SUBSTR,
                                "Attempt to use reference as lvalue in substr");
@@ -2131,7 +2153,8 @@ PP(pp_ord)
 {
     djSP; dTARGET;
     UV value;
-    U8 *tmps = (U8*)POPp;
+    STRLEN n_a;
+    U8 *tmps = (U8*)POPpx;
     I32 retlen;
 
     if (IN_UTF8 && (*tmps & 0x80))
@@ -2174,12 +2197,13 @@ PP(pp_chr)
 PP(pp_crypt)
 {
     djSP; dTARGET; dPOPTOPssrl;
+    STRLEN n_a;
 #ifdef HAS_CRYPT
-    char *tmps = SvPV(left, PL_na);
+    char *tmps = SvPV(left, n_a);
 #ifdef FCRYPT
-    sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na)));
+    sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
 #else
-    sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na)));
+    sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
 #endif
 #else
     DIE(
@@ -2231,7 +2255,7 @@ PP(pp_ucfirst)
        sv = TARG;
        SETs(sv);
     }
-    s = (U8*)SvPV_force(sv, PL_na);
+    s = (U8*)SvPV_force(sv, slen);
     if (*s) {
        if (PL_op->op_private & OPpLOCALE) {
            TAINT;
@@ -2287,7 +2311,7 @@ PP(pp_lcfirst)
        sv = TARG;
        SETs(sv);
     }
-    s = (U8*)SvPV_force(sv, PL_na);
+    s = (U8*)SvPV_force(sv, slen);
     if (*s) {
        if (PL_op->op_private & OPpLOCALE) {
            TAINT;
@@ -2658,8 +2682,10 @@ PP(pp_hslice)
                svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
            }
            if (lval) {
-               if (!svp || *svp == &PL_sv_undef)
-                   DIE(PL_no_helem, SvPV(keysv, PL_na));
+               if (!svp || *svp == &PL_sv_undef) {
+                   STRLEN n_a;
+                   DIE(PL_no_helem, SvPV(keysv, n_a));
+               }
                if (PL_op->op_private & OPpLVAL_INTRO)
                    save_helem(hv, keysv, svp);
            }
@@ -2841,12 +2867,8 @@ PP(pp_splice)
 
     newlen = SP - MARK;
     diff = newlen - length;
-    if (newlen && !AvREAL(ary)) {
-       if (AvREIFY(ary))
-           av_reify(ary);
-       else
-           assert(AvREAL(ary));                /* would leak, so croak */
-    }
+    if (newlen && !AvREAL(ary) && AvREIFY(ary))
+       av_reify(ary);
 
     if (diff < 0) {                            /* shrinking the area */
        if (newlen) {
@@ -3163,9 +3185,6 @@ mul128(SV *sv, U8 m)
 
 /* Explosives and implosives. */
 
-static const char uuemap[] =
-    "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
-static char uudmap[256];        /* Initialised on first use */
 #if 'I' == 73 && 'J' == 74
 /* On an ASCII/ISO kind of system */
 #define ISUUCHAR(ch)    ((ch) >= ' ' && (ch) < 'a')
@@ -3174,7 +3193,7 @@ static char uudmap[256];        /* Initialised on first use */
   Some other sort of character set - use memchr() so we don't match
   the null byte.
  */
-#define ISUUCHAR(ch)    (memchr(uuemap, (ch), sizeof(uuemap)-1) || (ch) == ' ')
+#define ISUUCHAR(ch)    (memchr(PL_uuemap, (ch), sizeof(PL_uuemap)-1) || (ch) == ' ')
 #endif
 
 PP(pp_unpack)
@@ -3214,13 +3233,12 @@ PP(pp_unpack)
     I32 checksum = 0;
     register U32 culong;
     double cdouble;
-    static char* bitcount = 0;
     int commas = 0;
 
     if (gimme != G_ARRAY) {            /* arrange to do first one only */
        /*SUPPRESS 530*/
        for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
-       if (strchr("aAbBhHP", *patend) || *pat == '%') {
+       if (strchr("aAZbBhHP", *patend) || *pat == '%') {
            patend++;
            while (isDIGIT(*patend) || *patend == '*')
                patend++;
@@ -3278,6 +3296,7 @@ PP(pp_unpack)
            s += len;
            break;
        case 'A':
+       case 'Z':
        case 'a':
            if (len > strend - s)
                len = strend - s;
@@ -3286,12 +3305,19 @@ PP(pp_unpack)
            sv = NEWSV(35, len);
            sv_setpvn(sv, s, len);
            s += len;
-           if (datumtype == 'A') {
+           if (datumtype == 'A' || datumtype == 'Z') {
                aptr = s;       /* borrow register */
-               s = SvPVX(sv) + len - 1;
-               while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
-                   s--;
-               *++s = '\0';
+               if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
+                   s = SvPVX(sv);
+                   while (*s)
+                       s++;
+               }
+               else {          /* 'A' strips both nulls and spaces */
+                   s = SvPVX(sv) + len - 1;
+                   while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
+                       s--;
+                   *++s = '\0';
+               }
                SvCUR_set(sv, s - SvPVX(sv));
                s = aptr;       /* unborrow register */
            }
@@ -3302,21 +3328,21 @@ PP(pp_unpack)
            if (pat[-1] == '*' || len > (strend - s) * 8)
                len = (strend - s) * 8;
            if (checksum) {
-               if (!bitcount) {
-                   Newz(601, bitcount, 256, char);
+               if (!PL_bitcount) {
+                   Newz(601, PL_bitcount, 256, char);
                    for (bits = 1; bits < 256; bits++) {
-                       if (bits & 1)   bitcount[bits]++;
-                       if (bits & 2)   bitcount[bits]++;
-                       if (bits & 4)   bitcount[bits]++;
-                       if (bits & 8)   bitcount[bits]++;
-                       if (bits & 16)  bitcount[bits]++;
-                       if (bits & 32)  bitcount[bits]++;
-                       if (bits & 64)  bitcount[bits]++;
-                       if (bits & 128) bitcount[bits]++;
+                       if (bits & 1)   PL_bitcount[bits]++;
+                       if (bits & 2)   PL_bitcount[bits]++;
+                       if (bits & 4)   PL_bitcount[bits]++;
+                       if (bits & 8)   PL_bitcount[bits]++;
+                       if (bits & 16)  PL_bitcount[bits]++;
+                       if (bits & 32)  PL_bitcount[bits]++;
+                       if (bits & 64)  PL_bitcount[bits]++;
+                       if (bits & 128) PL_bitcount[bits]++;
                    }
                }
                while (len >= 8) {
-                   culong += bitcount[*(unsigned char*)s++];
+                   culong += PL_bitcount[*(unsigned char*)s++];
                    len -= 8;
                }
                if (len) {
@@ -3586,6 +3612,17 @@ PP(pp_unpack)
                    Copy(s, &auint, 1, unsigned int);
                    s += sizeof(unsigned int);
                    sv = NEWSV(41, 0);
+#ifdef __osf__
+                    /* Without the dummy below unpack("I", pack("I",0xFFFFFFFF))
+                     * returns 1.84467440737096e+19 instead of 0xFFFFFFFF for
+                    * DEC C V5.8-009 on Digital UNIX V4.0 (Rev. 1091) (aka V4.0D)
+                    * with optimization turned on.
+                    * (DEC C V5.2-040 on Digital UNIX V4.0 (Rev. 564) (aka V4.0B)
+                    * does not have this problem even with -O4)
+                    */
+                    (auint) ?
+                       sv_setuv(sv, (UV)auint) :
+#endif
                    sv_setuv(sv, (UV)auint);
                    PUSHs(sv_2mortal(sv));
                }
@@ -3699,6 +3736,7 @@ PP(pp_unpack)
                    }
                    else if (++bytes >= sizeof(UV)) {   /* promote to string */
                        char *t;
+                       STRLEN n_a;
 
                        sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
                        while (s < strend) {
@@ -3708,7 +3746,7 @@ PP(pp_unpack)
                                break;
                            }
                        }
-                       t = SvPV(sv, PL_na);
+                       t = SvPV(sv, n_a);
                        while (*t == '0')
                            t++;
                        sv_chop(sv, t);
@@ -3833,16 +3871,16 @@ PP(pp_unpack)
              * algorithm, the code will be character-set independent
              * (and just as fast as doing character arithmetic)
              */
-            if (uudmap['M'] == 0) {
+            if (PL_uudmap['M'] == 0) {
                 int i;
  
-                for (i = 0; i < sizeof(uuemap); i += 1)
-                    uudmap[uuemap[i]] = i;
+                for (i = 0; i < sizeof(PL_uuemap); i += 1)
+                    PL_uudmap[PL_uuemap[i]] = i;
                 /*
                  * Because ' ' and '`' map to the same value,
                  * we need to decode them both the same.
                  */
-                uudmap[' '] = 0;
+                PL_uudmap[' '] = 0;
             }
 
            along = (strend - s) * 3 / 4;
@@ -3854,22 +3892,22 @@ PP(pp_unpack)
                char hunk[4];
 
                hunk[3] = '\0';
-               len = uudmap[*s++] & 077;
+               len = PL_uudmap[*s++] & 077;
                while (len > 0) {
                    if (s < strend && ISUUCHAR(*s))
-                       a = uudmap[*s++] & 077;
+                       a = PL_uudmap[*s++] & 077;
                    else
                        a = 0;
                    if (s < strend && ISUUCHAR(*s))
-                       b = uudmap[*s++] & 077;
+                       b = PL_uudmap[*s++] & 077;
                    else
                        b = 0;
                    if (s < strend && ISUUCHAR(*s))
-                       c = uudmap[*s++] & 077;
+                       c = PL_uudmap[*s++] & 077;
                    else
                        c = 0;
                    if (s < strend && ISUUCHAR(*s))
-                       d = uudmap[*s++] & 077;
+                       d = PL_uudmap[*s++] & 077;
                    else
                        d = 0;
                    hunk[0] = (a << 2) | (b >> 4);
@@ -3930,24 +3968,24 @@ doencodes(register SV *sv, register char *s, register I32 len)
 {
     char hunk[5];
 
-    *hunk = uuemap[len];
+    *hunk = PL_uuemap[len];
     sv_catpvn(sv, hunk, 1);
     hunk[4] = '\0';
     while (len > 2) {
-       hunk[0] = uuemap[(077 & (*s >> 2))];
-       hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))];
-       hunk[2] = uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))];
-       hunk[3] = uuemap[(077 & (s[2] & 077))];
+       hunk[0] = PL_uuemap[(077 & (*s >> 2))];
+       hunk[1] = PL_uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))];
+       hunk[2] = PL_uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))];
+       hunk[3] = PL_uuemap[(077 & (s[2] & 077))];
        sv_catpvn(sv, hunk, 4);
        s += 3;
        len -= 3;
     }
     if (len > 0) {
        char r = (len > 1 ? s[1] : '\0');
-       hunk[0] = uuemap[(077 & (*s >> 2))];
-       hunk[1] = uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))];
-       hunk[2] = uuemap[(077 & ((r << 2) & 074))];
-       hunk[3] = uuemap[0];
+       hunk[0] = PL_uuemap[(077 & (*s >> 2))];
+       hunk[1] = PL_uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))];
+       hunk[2] = PL_uuemap[(077 & ((r << 2) & 074))];
+       hunk[3] = PL_uuemap[0];
        sv_catpvn(sv, hunk, 4);
     }
     sv_catpvn(sv, "\n", 1);
@@ -3956,8 +3994,9 @@ doencodes(register SV *sv, register char *s, register I32 len)
 STATIC SV      *
 is_an_int(char *s, STRLEN l)
 {
+  STRLEN        n_a;
   SV             *result = newSVpv("", l);
-  char           *result_c = SvPV(result, PL_na);      /* convenience */
+  char           *result_c = SvPV(result, n_a);        /* convenience */
   char           *out = result_c;
   bool            skip = 1;
   bool            ignore = 0;
@@ -4113,6 +4152,7 @@ PP(pp_pack)
            sv_catpvn(cat, null10, len);
            break;
        case 'A':
+       case 'Z':
        case 'a':
            fromstr = NEXTFROM;
            aptr = SvPV(fromstr, fromlen);
@@ -4462,6 +4502,7 @@ PP(pp_pack)
                if (fromstr == &PL_sv_undef)
                    aptr = NULL;
                else {
+                   STRLEN n_a;
                    /* XXX better yet, could spirit away the string to
                     * a safe spot and hang on to it until the result
                     * of pack() (and all copies of the result) are
@@ -4471,9 +4512,9 @@ PP(pp_pack)
                        warner(WARN_UNSAFE,
                                "Attempt to pack pointer to temporary value");
                    if (SvPOK(fromstr) || SvNIOK(fromstr))
-                       aptr = SvPV(fromstr,PL_na);
+                       aptr = SvPV(fromstr,n_a);
                    else
-                       aptr = SvPV_force(fromstr,PL_na);
+                       aptr = SvPV_force(fromstr,n_a);
                }
                sv_catpvn(cat, (char*)&aptr, sizeof(char*));
            }
@@ -4672,7 +4713,7 @@ PP(pp_split)
     else {
        maxiters += (strend - s) * rx->nparens;
        while (s < strend && --limit &&
-              CALLREGEXEC(rx, s, strend, orig, 1, Nullsv, NULL, 0))
+              CALLREGEXEC(rx, s, strend, orig, 1, sv, NULL, 0))
        {
            TAINT_IF(RX_MATCH_TAINTED(rx));
            if (rx->subbase