Allow option to treat barewords at start of Unix paths as simple words rather than...

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

diff --git a/sv.c b/sv.c
index 6392f54..4bdf847 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -294,17 +294,17 @@ S_visit(pTHX_ SVFUNC_t f)
 void
 Perl_sv_report_used(pTHX)
 {
-    visit(FUNC_NAME_TO_PTR(do_report_used));
+    visit(do_report_used);
 }
 
 void
 Perl_sv_clean_objs(pTHX)
 {
     PL_in_clean_objs = TRUE;
-    visit(FUNC_NAME_TO_PTR(do_clean_objs));
+    visit(do_clean_objs);
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
     /* some barnacles may yet remain, clinging to typeglobs */
-    visit(FUNC_NAME_TO_PTR(do_clean_named_objs));
+    visit(do_clean_named_objs);
 #endif
     PL_in_clean_objs = FALSE;
 }
@@ -313,7 +313,7 @@ void
 Perl_sv_clean_all(pTHX)
 {
     PL_in_clean_all = TRUE;
-    visit(FUNC_NAME_TO_PTR(do_clean_all));
+    visit(do_clean_all);
     PL_in_clean_all = FALSE;
 }
 
@@ -1107,17 +1107,10 @@ Perl_sv_2iv(pTHX_ register SV *sv)
              return SvIV(tmpstr);
          return (IV)SvRV(sv);
        }
-       if (SvREADONLY(sv)) {
-           if (SvNOKp(sv)) {
-               return I_V(SvNVX(sv));
-           }
-           if (SvPOKp(sv) && SvLEN(sv))
-               return asIV(sv);
-           {
-               dTHR;
-               if (ckWARN(WARN_UNINITIALIZED))
-                   Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
-           }
+       if (SvREADONLY(sv) && !SvOK(sv)) {
+           dTHR;
+           if (ckWARN(WARN_UNINITIALIZED))
+               Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
            return 0;
        }
     }
@@ -1252,17 +1245,10 @@ Perl_sv_2uv(pTHX_ register SV *sv)
              return SvUV(tmpstr);
          return (UV)SvRV(sv);
        }
-       if (SvREADONLY(sv)) {
-           if (SvNOKp(sv)) {
-               return U_V(SvNVX(sv));
-           }
-           if (SvPOKp(sv) && SvLEN(sv))
-               return asUV(sv);
-           {
-               dTHR;
-               if (ckWARN(WARN_UNINITIALIZED))
-                   Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
-           }
+       if (SvREADONLY(sv) && !SvOK(sv)) {
+           dTHR;
+           if (ckWARN(WARN_UNINITIALIZED))
+               Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
            return 0;
        }
     }
@@ -1423,19 +1409,8 @@ Perl_sv_2nv(pTHX_ register SV *sv)
              return SvNV(tmpstr);
          return (NV)(unsigned long)SvRV(sv);
        }
-       if (SvREADONLY(sv)) {
+       if (SvREADONLY(sv) && !SvOK(sv)) {
            dTHR;
-           if (SvPOKp(sv) && SvLEN(sv)) {
-               if (ckWARN(WARN_NUMERIC) && !SvIOKp(sv) && !looks_like_number(sv))
-                   not_a_number(sv);
-               return Atof(SvPVX(sv));
-           }
-           if (SvIOKp(sv)) {
-               if (SvIsUV(sv)) 
-                   return (NV)SvUVX(sv);
-               else
-                   return (NV)SvIVX(sv);
-           }
            if (ckWARN(WARN_UNINITIALIZED))
                Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
            return 0.0;
@@ -1817,29 +1792,10 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
            *lp = strlen(s);
            return s;
        }
-       if (SvREADONLY(sv)) {
-           if (SvNOKp(sv)) {           /* See note in sv_2uv() */
-               /* XXXX 64-bit?  IV may have better precision... */
-               Gconvert(SvNVX(sv), DBL_DIG, 0, tmpbuf);
-               tsv = Nullsv;
-               goto tokensave;
-           }
-           if (SvIOKp(sv)) {
-               char *ebuf;
-
-               if (SvIsUV(sv))
-                   tmpbuf = uiv_2buf(tbuf, 0, SvUVX(sv), 1, &ebuf);
-               else
-                   tmpbuf = uiv_2buf(tbuf, SvIVX(sv), 0, 0, &ebuf);
-               *ebuf = 0;
-               tsv = Nullsv;
-               goto tokensave;
-           }
-           {
-               dTHR;
-               if (ckWARN(WARN_UNINITIALIZED))
-                   Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
-           }
+       if (SvREADONLY(sv) && !SvOK(sv)) {
+           dTHR;
+           if (ckWARN(WARN_UNINITIALIZED))
+               Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
            *lp = 0;
            return "";
        }
@@ -1872,30 +1828,36 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
     }
     else if (SvIOKp(sv)) {
        U32 isIOK = SvIOK(sv);
+       U32 isUIOK = SvIsUV(sv);
        char buf[TYPE_CHARS(UV)];
        char *ebuf, *ptr;
 
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);
-       if (SvIsUV(sv)) {
+       if (isUIOK)
            ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf);
-           sv_setpvn(sv, ptr, ebuf - ptr);
-           SvIsUV_on(sv);
-       }
-       else {
+       else
            ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf);
-           sv_setpvn(sv, ptr, ebuf - ptr);
-       }
+       SvGROW(sv, ebuf - ptr + 1);     /* inlined from sv_setpvn */
+       Move(ptr,SvPVX(sv),ebuf - ptr,char);
+       SvCUR_set(sv, ebuf - ptr);
        s = SvEND(sv);
+       *s = '\0';
        if (isIOK)
            SvIOK_on(sv);
        else
            SvIOKp_on(sv);
+       if (isUIOK)
+           SvIsUV_on(sv);
+       SvPOK_on(sv);
     }
     else {
        dTHR;
-       if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+       if (ckWARN(WARN_UNINITIALIZED)
+           && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP))
+       {
            Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+       }
        *lp = 0;
        if (SvTYPE(sv) < SVt_PV)
            /* Typically the caller expects that sv_any is not NULL now.  */
@@ -1905,7 +1867,8 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
     *lp = s - SvPVX(sv);
     SvCUR_set(sv, *lp);
     SvPOK_on(sv);
-    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",(unsigned long)sv,SvPVX(sv)));
+    DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n",
+                         (unsigned long)sv,SvPVX(sv)));
     return SvPVX(sv);
 
   tokensave:
@@ -3016,7 +2979,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
            IoIFP(sv) != PerlIO_stdout() &&
            IoIFP(sv) != PerlIO_stderr())
        {
-         io_close((IO*)sv);
+           io_close((IO*)sv, FALSE);
        }
        if (IoDIRP(sv)) {
            PerlDir_close(IoDIRP(sv));
@@ -4051,7 +4014,7 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
     register I32 i;
     register PMOP *pm;
     register I32 max;
-    char todo[256];
+    char todo[PERL_UCHAR_MAX+1];
 
     if (!stash)
        return;
@@ -4070,11 +4033,11 @@ Perl_sv_reset(pTHX_ register char *s, HV *stash)
 
     Zero(todo, 256, char);
     while (*s) {
-       i = *s;
+       i = (unsigned char)*s;
        if (s[1] == '-') {
            s += 2;
        }
-       max = *s++;
+       max = (unsigned char)*s++;
        for ( ; i <= max; i++) {
            todo[i] = 1;
        }