add notes about effect of loop control statements inside

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

diff --git a/pp.c b/pp.c
index 07bb33d..2948d3a 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -407,7 +407,7 @@ PP(pp_rv2cv)
        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");
+           DIE(aTHX_ "Can't modify non-lvalue subroutine call");
     }
     else
        cv = (CV*)&PL_sv_undef;
@@ -469,7 +469,7 @@ PP(pp_prototype)
                goto set;
            else {                      /* None such */
              nonesuch:
-               Perl_croak(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
+               DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
            }
        }
     }
@@ -530,6 +530,12 @@ S_refto(pTHX_ SV *sv)
        else
            (void)SvREFCNT_inc(sv);
     }
+    else if (SvTYPE(sv) == SVt_PVAV) {
+       if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
+           av_reify((AV*)sv);
+       SvTEMP_off(sv);
+       (void)SvREFCNT_inc(sv);
+    }
     else if (SvPADTMP(sv))
        sv = newSVsv(sv);
     else {
@@ -865,7 +871,7 @@ PP(pp_predec)
 {
     djSP;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       Perl_croak(aTHX_ PL_no_modify);
+       DIE(aTHX_ PL_no_modify);
     if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MIN)
     {
@@ -882,7 +888,7 @@ PP(pp_postinc)
 {
     djSP; dTARGET;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       Perl_croak(aTHX_ PL_no_modify);
+       DIE(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MAX)
@@ -903,7 +909,7 @@ PP(pp_postdec)
 {
     djSP; dTARGET;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       Perl_croak(aTHX_ PL_no_modify);
+       DIE(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MIN)
@@ -3282,6 +3288,11 @@ PP(pp_unpack)
 #endif
        if (isSPACE(datumtype))
            continue;
+       if (datumtype == '#') {
+           while (pat < patend && *pat != '\n')
+               pat++;
+           continue;
+       }
        if (*pat == '!') {
            char *natstr = "sSiIlL";
 
@@ -3292,7 +3303,7 @@ PP(pp_unpack)
                pat++;
            }
            else
-               Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
+               DIE(aTHX_ "'!' allowed only after types %s", natstr);
        }
        if (pat >= patend)
            len = 1;
@@ -3305,17 +3316,18 @@ PP(pp_unpack)
            while (isDIGIT(*pat)) {
                len = (len * 10) + (*pat++ - '0');
                if (len < 0)
-                   Perl_croak(aTHX_ "Repeat count in unpack overflows");
+                   DIE(aTHX_ "Repeat count in unpack overflows");
            }
        }
        else
            len = (datumtype != '@');
        switch(datumtype) {
        default:
-           Perl_croak(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
+           DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
        case ',': /* grandfather in commas but with a warning */
            if (commas++ == 0 && ckWARN(WARN_UNSAFE))
-               Perl_warner(aTHX_ WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
+               Perl_warner(aTHX_ WARN_UNSAFE,
+                           "Invalid type in unpack: '%c'", (int)datumtype);
            break;
        case '%':
            if (len == 1 && pat[-1] != '1')
@@ -3341,16 +3353,16 @@ PP(pp_unpack)
                DIE(aTHX_ "x outside of string");
            s += len;
            break;
-       case '#':
+       case '/':
            if (oldsp >= SP)
-               DIE(aTHX_ "# must follow a numeric type");
+               DIE(aTHX_ "/ must follow a numeric type");
            if (*pat != 'a' && *pat != 'A' && *pat != 'Z')
-               DIE(aTHX_ "# must be followed by a, A or Z");
+               DIE(aTHX_ "/ must be followed by a, A or Z");
            datumtype = *pat++;
            if (*pat == '*')
                pat++;          /* ignore '*' for compatibility with pack */
            if (isDIGIT(*pat))
-               DIE(aTHX_ "# cannot take a count" );
+               DIE(aTHX_ "/ cannot take a count" );
            len = POPi;
            /* drop through */
        case 'A':
@@ -3981,7 +3993,7 @@ PP(pp_unpack)
                    }
                }
                if ((s >= strend) && bytes)
-                   Perl_croak(aTHX_ "Unterminated compressed integer");
+                   DIE(aTHX_ "Unterminated compressed integer");
            }
            break;
        case 'P':
@@ -4339,6 +4351,11 @@ PP(pp_pack)
 #endif
        if (isSPACE(datumtype))
            continue;
+       if (datumtype == '#') {
+           while (pat < patend && *pat != '\n')
+               pat++;
+           continue;
+       }
         if (*pat == '!') {
            char *natstr = "sSiIlL";
 
@@ -4349,7 +4366,7 @@ PP(pp_pack)
                pat++;
            }
            else
-               Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
+               DIE(aTHX_ "'!' allowed only after types %s", natstr);
        }
        if (*pat == '*') {
            len = strchr("@Xxu", datumtype) ? 0 : items;
@@ -4360,21 +4377,21 @@ PP(pp_pack)
            while (isDIGIT(*pat)) {
                len = (len * 10) + (*pat++ - '0');
                if (len < 0)
-                   Perl_croak(aTHX_ "Repeat count in pack overflows");
+                   DIE(aTHX_ "Repeat count in pack overflows");
            }
        }
        else
            len = 1;
-       if (*pat == '#') {
+       if (*pat == '/') {
            ++pat;
            if (*pat != 'a' && *pat != 'A' && *pat != 'Z' || pat[1] != '*')
-               DIE(aTHX_ "# must be followed by a*, A* or Z*");
+               DIE(aTHX_ "/ must be followed by a*, A* or Z*");
            lengthcode = sv_2mortal(newSViv(sv_len(items > 0
                                                   ? *MARK : &PL_sv_no)));
        }
        switch(datumtype) {
        default:
-           Perl_croak(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
+           DIE(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
        case ',': /* grandfather in commas but with a warning */
            if (commas++ == 0 && ckWARN(WARN_UNSAFE))
                Perl_warner(aTHX_ WARN_UNSAFE,
@@ -4663,7 +4680,7 @@ PP(pp_pack)
                adouble = Perl_floor(SvNV(fromstr));
 
                if (adouble < 0)
-                   Perl_croak(aTHX_ "Cannot compress negative numbers");
+                   DIE(aTHX_ "Cannot compress negative numbers");
 
                if (
 #ifdef BW_BITS
@@ -4697,7 +4714,7 @@ PP(pp_pack)
                    /* Copy string and check for compliance */
                    from = SvPV(fromstr, len);
                    if ((norm = is_an_int(from, len)) == NULL)
-                       Perl_croak(aTHX_ "can compress only unsigned integer");
+                       DIE(aTHX_ "can compress only unsigned integer");
 
                    New('w', result, len, char);
                    in = result + len;
@@ -4717,14 +4734,14 @@ PP(pp_pack)
                        double next = floor(adouble / 128);
                        *--in = (unsigned char)(adouble - (next * 128)) | 0x80;
                        if (--in < buf)  /* this cannot happen ;-) */
-                           Perl_croak(aTHX_ "Cannot compress integer");
+                           DIE(aTHX_ "Cannot compress integer");
                        adouble = next;
                    } while (adouble > 0);
                    buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
                    sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
                }
                else
-                   Perl_croak(aTHX_ "Cannot compress non integer");
+                   DIE(aTHX_ "Cannot compress non integer");
            }
             break;
        case 'i':