make ~$x give warning is $x isn't initialised.

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index db9490a..f4b3696 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1,7 +1,7 @@
 /*    sv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -1455,6 +1455,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
        LvTARGLEN(sv)   = 0;
        LvTARG(sv)      = 0;
        LvTYPE(sv)      = 0;
+       GvGP(sv)        = 0;
+       GvNAME(sv)      = 0;
+       GvNAMELEN(sv)   = 0;
+       GvSTASH(sv)     = 0;
+       GvFLAGS(sv)     = 0;
        break;
     case SVt_PVAV:
        SvANY(sv) = new_XPVAV();
@@ -2039,22 +2044,34 @@ S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype)
 }
 #endif /* !NV_PRESERVES_UV*/
 
+/* sv_2iv() is now a macro using Perl_sv_2iv_flags();
+ * this function provided for binary compatibility only
+ */
+
+IV
+Perl_sv_2iv(pTHX_ register SV *sv)
+{
+    return sv_2iv_flags(sv, SV_GMAGIC);
+}
+
 /*
-=for apidoc sv_2iv
+=for apidoc sv_2iv_flags
 
-Return the integer value of an SV, doing any necessary string conversion,
-magic etc. Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
+Return the integer value of an SV, doing any necessary string
+conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
 
 =cut
 */
 
 IV
-Perl_sv_2iv(pTHX_ register SV *sv)
+Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
 {
     if (!sv)
        return 0;
     if (SvGMAGICAL(sv)) {
-       mg_get(sv);
+       if (flags & SV_GMAGIC)
+           mg_get(sv);
        if (SvIOKp(sv))
            return SvIVX(sv);
        if (SvNOKp(sv)) {
@@ -2336,23 +2353,34 @@ Perl_sv_2iv(pTHX_ register SV *sv)
     return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv);
 }
 
+/* sv_2uv() is now a macro using Perl_sv_2uv_flags();
+ * this function provided for binary compatibility only
+ */
+
+UV
+Perl_sv_2uv(pTHX_ register SV *sv)
+{
+    return sv_2uv_flags(sv, SV_GMAGIC);
+}
+
 /*
-=for apidoc sv_2uv
+=for apidoc sv_2uv_flags
 
 Return the unsigned integer value of an SV, doing any necessary string
-conversion, magic etc. Normally used via the C<SvUV(sv)> and C<SvUVx(sv)>
-macros.
+conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvUV(sv)> and C<SvUVx(sv)> macros.
 
 =cut
 */
 
 UV
-Perl_sv_2uv(pTHX_ register SV *sv)
+Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
 {
     if (!sv)
        return 0;
     if (SvGMAGICAL(sv)) {
-       mg_get(sv);
+       if (flags & SV_GMAGIC)
+           mg_get(sv);
        if (SvIOKp(sv))
            return SvUVX(sv);
        if (SvNOKp(sv))
@@ -3538,6 +3566,12 @@ void
 Perl_sv_utf8_encode(pTHX_ register SV *sv)
 {
     (void) sv_utf8_upgrade(sv);
+    if (SvIsCOW(sv)) {
+        sv_force_normal_flags(sv, 0);
+    }
+    if (SvREADONLY(sv)) {
+       Perl_croak(aTHX_ PL_no_modify);
+    }
     SvUTF8_off(sv);
 }
 
@@ -3760,7 +3794,9 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            if (dtype != SVt_PVGV) {
                char *name = GvNAME(sstr);
                STRLEN len = GvNAMELEN(sstr);
-               sv_upgrade(dstr, SVt_PVGV);
+               /* don't upgrade SVt_PVLV: it can hold a glob */
+               if (dtype != SVt_PVLV)
+                   sv_upgrade(dstr, SVt_PVGV);
                sv_magic(dstr, dstr, PERL_MAGIC_glob, Nullch, 0);
                GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr));
                GvNAME(dstr) = savepvn(name, len);
@@ -4197,7 +4233,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
     }
     else
        new_SV(dstr);
-    SvUPGRADE (dstr, SVt_PVIV);
+    (void)SvUPGRADE (dstr, SVt_PVIV);
 
     assert (SvPOK(sstr));
     assert (SvPOKp(sstr));
@@ -4220,7 +4256,7 @@ Perl_sv_setsv_cow(pTHX_ SV *dstr, SV *sstr)
        SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr));
     } else {
        assert ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS);
-       SvUPGRADE (sstr, SVt_PVIV);
+       (void)SvUPGRADE (sstr, SVt_PVIV);
        SvREADONLY_on(sstr);
        SvFAKE_on(sstr);
        DEBUG_C(PerlIO_printf(Perl_debug_log,
@@ -9484,6 +9520,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            continue;   /* not "break" */
        }
 
+       /* calculate width before utf8_upgrade changes it */
+       have = esignlen + zeros + elen;
+
        if (is_utf8 != has_utf8) {
             if (is_utf8) {
                  if (SvCUR(sv))
@@ -9507,7 +9546,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                "Newline in left-justified string for %sprintf",
                        (PL_op->op_type == OP_PRTF) ? "" : "s");
        
-       have = esignlen + zeros + elen;
        need = (have > width ? have : width);
        gap = need - have;
 
@@ -9677,7 +9715,7 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
     New(0, ret->offsets, 2*len+1, U32);
     Copy(r->offsets, ret->offsets, 2*len+1, U32);
 
-    ret->precomp        = SAVEPV(r->precomp);
+    ret->precomp        = SAVEPVN(r->precomp, r->prelen);
     ret->refcnt         = r->refcnt;
     ret->minlen         = r->minlen;
     ret->prelen         = r->prelen;
@@ -9689,7 +9727,7 @@ Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
     ret->sublen         = r->sublen;
 
     if (RX_MATCH_COPIED(ret))
-       ret->subbeg  = SAVEPV(r->subbeg);
+       ret->subbeg  = SAVEPVN(r->subbeg, r->sublen);
     else
        ret->subbeg = Nullch;
 #ifdef PERL_COPY_ON_WRITE
@@ -11264,7 +11302,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_egid            = proto_perl->Iegid;
     PL_nomemok         = proto_perl->Inomemok;
     PL_an              = proto_perl->Ian;
-    PL_op_seqmax       = proto_perl->Iop_seqmax;
     PL_evalseq         = proto_perl->Ievalseq;
     PL_origenviron     = proto_perl->Iorigenviron;     /* XXX not quite right */
     PL_origalen                = proto_perl->Iorigalen;
@@ -11443,14 +11480,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_last_swash_tmps = (U8*)NULL;
     PL_last_swash_slen = 0;
 
-    /* perly.c globals */
-    PL_yydebug         = proto_perl->Iyydebug;
-    PL_yynerrs         = proto_perl->Iyynerrs;
-    PL_yyerrflag       = proto_perl->Iyyerrflag;
-    PL_yychar          = proto_perl->Iyychar;
-    PL_yyval           = proto_perl->Iyyval;
-    PL_yylval          = proto_perl->Iyylval;
-
     PL_glob_index      = proto_perl->Iglob_index;
     PL_srand_called    = proto_perl->Isrand_called;
     PL_hash_seed       = proto_perl->Ihash_seed;