$\1 and serious bug in evalling

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

diff --git a/sv.c b/sv.c
index 45fb77f..166dc07 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -889,6 +889,7 @@ register SV *sv;
     STRLEN prevlen;
     int unref = 0;
 
+    sv_setpvn(t, "", 0);
   retry:
     if (!sv) {
        sv_catpv(t, "VOID");
@@ -951,7 +952,7 @@ register SV *sv;
 
     case SVt_NULL:
        sv_catpv(t, "UNDEF");
-       return tokenbuf;
+       goto finish;
     case SVt_IV:
        sv_catpv(t, "IV");
        break;
@@ -1121,7 +1122,7 @@ IV i;
     case SVt_PVFM:
     case SVt_PVIO:
        croak("Can't coerce %s to integer in %s", sv_reftype(sv,0),
-           op_name[op->op_type]);
+           op_desc[op->op_type]);
     }
     (void)SvIOK_only(sv);                      /* validate number */
     SvIVX(sv) = i;
@@ -1709,12 +1710,17 @@ STRLEN *lp;
 #endif
     }
     else if (SvIOKp(sv)) {
+       U32 oldIOK = SvIOK(sv);
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);
        olderrno = errno;       /* some Xenix systems wipe out errno here */
        sv_setpvf(sv, "%Vd", SvIVX(sv));
        errno = olderrno;
        s = SvEND(sv);
+       if (oldIOK)
+           SvIOK_on(sv);
+       else
+           SvIOKp_on(sv);
     }
     else {
        if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP))
@@ -1928,6 +1934,11 @@ register SV *sstr;
                GvNAMELEN(dstr) = len;
                SvFAKE_on(dstr);        /* can coerce to non-glob */
            }
+           /* ahem, death to those who redefine active sort subs */
+           else if (curstack == sortstack
+                    && GvCV(dstr) && sortcop == CvSTART(GvCV(dstr)))
+               croak("Can't redefine active sort subroutine %s",
+                     GvNAME(dstr));
            (void)SvOK_off(dstr);
            GvINTRO_off(dstr);          /* one-shot flag */
            gp_free((GV*)dstr);
@@ -2010,6 +2021,13 @@ register SV *sstr;
                            if (!GvCVGEN((GV*)dstr) &&
                                (CvROOT(cv) || CvXSUB(cv)))
                            {
+                               /* ahem, death to those who redefine
+                                * active sort subs */
+                               if (curstack == sortstack &&
+                                     sortcop == CvSTART(cv))
+                                   croak(
+                                   "Can't redefine active sort subroutine %s",
+                                         GvENAME((GV*)dstr));
                                if (cv_const_sv(cv))
                                    warn("Constant subroutine %s redefined",
                                         GvENAME((GV*)dstr));
@@ -3241,7 +3259,19 @@ screamer2:
             memNE(SvPVX(sv) + SvCUR(sv) - rslen, rsptr, rslen)))
        {
            append = -1;
-           goto screamer2;
+           /*
+            * If we're reading from a TTY and we get a short read,
+            * indicating that the user hit his EOF character, we need
+            * to notice it now, because if we try to read from the TTY
+            * again, the EOF condition will disappear.
+            *
+            * The comparison of cnt to sizeof(buf) is an optimization
+            * that prevents unnecessary calls to feof().
+            *
+            * - jik 9/25/96
+            */
+           if (!(cnt < sizeof(buf) && PerlIO_eof(fp)))
+               goto screamer2;
        }
     }
 
@@ -4163,6 +4193,7 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
     char *patend;
     STRLEN origlen;
     I32 svix = 0;
+    static char nullstr[] = "(null)";
 
     /* no matter what, this is a string now */
     (void)SvPV_force(sv, origlen);
@@ -4173,8 +4204,10 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
     if (patlen == 2 && pat[0] == '%') {
        switch (pat[1]) {
        case 's':
-           if (args)
-               sv_catpv(sv, va_arg(*args, char*));
+           if (args) {
+               char *s = va_arg(*args, char*);
+               sv_catpv(sv, s ? s : nullstr);
+           }
            else if (svix < svmax)
                sv_catsv(sv, *svargs);
            return;
@@ -4340,7 +4373,12 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
        case 's':
            if (args) {
                eptr = va_arg(*args, char*);
-               elen = strlen(eptr);
+               if (eptr)
+                   elen = strlen(eptr);
+               else {
+                   eptr = nullstr;
+                   elen = sizeof nullstr - 1;
+               }
            }
            else if (svix < svmax)
                eptr = SvPVx(svargs[svix++], elen);
@@ -4498,8 +4536,8 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
                i = PERL_INT_MIN;
                (void)frexp(nv, &i);
                if (i == PERL_INT_MIN)
-                   need = 400; /* busted -- be safe */
-               else if (i > 0)
+                   die("panic: frexp");
+               if (i > 0)
                    need = BIT_DIGITS(i);
            }
            need += has_precis ? precis : 6; /* known default */
@@ -4555,8 +4593,12 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
        case 'n':
            i = SvCUR(sv) - origlen;
            if (args) {
-               int *ip = va_arg(*args, int*);
-               *ip = i;
+               switch (intsize) {
+               case 'h':       *(va_arg(*args, short*)) = i; break;
+               default:        *(va_arg(*args, int*)) = i; break;
+               case 'l':       *(va_arg(*args, long*)) = i; break;
+               case 'V':       *(va_arg(*args, IV*)) = i; break;
+               }
            }
            else if (svix < svmax)
                sv_setuv(svargs[svix++], (UV)i);
@@ -4566,7 +4608,19 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
 
        default:
       unknown:
-           /* output mangled stuff without comment */
+           if (!args && dowarn &&
+                 (op->op_type == OP_PRTF || op->op_type == OP_SPRINTF)) {
+               SV *msg = sv_newmortal();
+               sv_setpvf(msg, "Invalid conversion in %s: ",
+                         (op->op_type == OP_PRTF) ? "printf" : "sprintf");
+               if (c)
+                   sv_catpvf(msg, isPRINT(c) ? "\"%%%c\"" : "\"%%\\%03o\"",
+                             c & 0xFF);
+               else
+                   sv_catpv(msg, "end of string");
+               warn("%_", msg); /* yes, this is reentrant */
+           }
+           /* output mangled stuff */
            eptr = p;
            elen = q - p;
            break;
@@ -4576,7 +4630,7 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale)
        need = (have > width ? have : width);
        gap = need - have;
 
-       SvGROW(sv, SvLEN(sv) + need);
+       SvGROW(sv, SvCUR(sv) + need + 1);
        p = SvEND(sv);
        if (esignlen && fill == '0') {
            for (i = 0; i < esignlen; i++)