Make sure buildext.pl finds Errno.pm

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

diff --git a/sv.c b/sv.c
index d08c378..704718e 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -158,7 +158,7 @@ S_visit(pTHX_ SVFUNC_t f)
     for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
        svend = &sva[SvREFCNT(sva)];
        for (sv = sva + 1; sv < svend; ++sv) {
-           if (SvTYPE(sv) != SVTYPEMASK) {
+           if (SvTYPE(sv) != SVTYPEMASK && SvREFCNT(sv)) {
                (FCALL)(aTHXo_ sv);
                ++visited;
            }
@@ -2966,8 +2966,12 @@ Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
     if (!sv)
        return 0;
 
-    if (!SvPOK(sv))
-       (void) SvPV_nolen(sv);
+    if (!SvPOK(sv)) {
+       STRLEN len = 0;
+       (void) sv_2pv(sv,&len);
+       if (!SvPOK(sv))
+            return len;
+    }
 
     if (SvUTF8(sv))
        return SvCUR(sv);
@@ -2984,7 +2988,8 @@ Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
     e = (U8 *) SvEND(sv);
     t = s;
     while (t < e) {
-       if ((hibit = !UTF8_IS_INVARIANT(*t++)))
+       U8 ch = *t++;
+       if ((hibit = !NATIVE_IS_INVARIANT(ch)))
            break;
     }
     if (hibit) {
@@ -2997,12 +3002,6 @@ Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
            Safefree(s); /* No longer using what was there before. */
        SvLEN(sv) = len; /* No longer know the real size. */
     }
-#ifdef EBCDIC
-    else {
-       for (t = s; t < e; t++)
-           *t = NATIVE_TO_ASCII(*t);
-    }
-#endif
     /* Mark as UTF-8 even if no hibit - saves scanning loop */
     SvUTF8_on(sv);
     return SvCUR(sv);
@@ -3118,7 +3117,8 @@ Perl_sv_utf8_decode(pTHX_ register SV *sv)
            return FALSE;
         e = (U8 *) SvEND(sv);
         while (c < e) {
-            if (!UTF8_IS_INVARIANT(*c++)) {
+           U8 ch = *c++;
+            if (!UTF8_IS_INVARIANT(ch)) {
                SvUTF8_on(sv);
                break;
            }
@@ -3821,8 +3821,9 @@ Perl_sv_chop(pTHX_ register SV *sv, register char *ptr)   /* like set but assuming
 =for apidoc sv_catpvn
 
 Concatenates the string onto the end of the string which is in the SV.  The
-C<len> indicates number of bytes to copy.  Handles 'get' magic, but not
-'set' magic.  See C<sv_catpvn_mg>.
+C<len> indicates number of bytes to copy.  If the SV has the UTF8
+status set, then the bytes appended should be valid UTF8.
+Handles 'get' magic, but not 'set' magic.  See C<sv_catpvn_mg>.
 
 =cut
 */
@@ -3920,10 +3921,10 @@ Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
 =for apidoc sv_catpv
 
 Concatenates the string onto the end of the string which is in the SV.
-Handles 'get' magic, but not 'set' magic.  See C<sv_catpv_mg>.
+If the SV has the UTF8 status set, then the bytes appended should be
+valid UTF8.  Handles 'get' magic, but not 'set' magic.  See C<sv_catpv_mg>.
 
-=cut
-*/
+=cut */
 
 void
 Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr)
@@ -4737,8 +4738,9 @@ Perl_sv_pos_b2u(pTHX_ register SV *sv, I32* offsetp)
     len = 0;
     while (s < send) {
        STRLEN n;
-        /* We can use low level directly here as we are not looking at the values */
-       if (utf8n_to_uvuni(s, UTF8SKIP(s), &n, 0)) {
+       /* Call utf8n_to_uvchr() to validate the sequence */
+       utf8n_to_uvchr(s, UTF8SKIP(s), &n, 0);
+       if (n > 0) {
            s += n;
            len++;
        }
@@ -6763,12 +6765,15 @@ Perl_sv_catpvf_mg_nocontext(SV *sv, const char* pat, ...)
 /*
 =for apidoc sv_catpvf
 
-Processes its arguments like C<sprintf> and appends the formatted output
-to an SV.  Handles 'get' magic, but not 'set' magic.  C<SvSETMAGIC()> must
-typically be called after calling this function to handle 'set' magic.
+Processes its arguments like C<sprintf> and appends the formatted
+output to an SV.  If the appended data contains "wide" characters
+(including, but not limited to, SVs with a UTF-8 PV formatted with %s,
+and characters >255 formatted with %c), the original SV might get
+upgraded to UTF-8.  Handles 'get' magic, but not 'set' magic.
+C<SvSETMAGIC()> must typically be called after calling this function
+to handle 'set' magic.
 
-=cut
-*/
+=cut */
 
 void
 Perl_sv_catpvf(pTHX_ SV *sv, const char* pat, ...)
@@ -7133,7 +7138,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
        case 'c':
            uv = args ? va_arg(*args, int) : SvIVx(argsv);
-           if ((uv > 255 || (!UTF8_IS_INVARIANT(uv) && SvUTF8(sv))) && !IN_BYTE) {
+           if ((uv > 255 ||
+                (!UNI_IS_INVARIANT(uv) && SvUTF8(sv)))
+               && !IN_BYTE) {
                eptr = (char*)utf8buf;
                elen = uvchr_to_utf8((U8*)eptr, uv) - utf8buf;
                is_utf = TRUE;
@@ -8202,7 +8209,7 @@ dup_pvcv:
        CvROOT(dstr)    = OpREFCNT_inc(CvROOT(sstr));
        CvXSUB(dstr)    = CvXSUB(sstr);
        CvXSUBANY(dstr) = CvXSUBANY(sstr);
-       CvGV(dstr)      = gv_dup_inc(CvGV(sstr));
+       CvGV(dstr)      = gv_dup(CvGV(sstr));
        CvDEPTH(dstr)   = CvDEPTH(sstr);
        if (CvPADLIST(sstr) && !AvREAL(CvPADLIST(sstr))) {
            /* XXX padlists are real, but pretend to be not */
@@ -8270,7 +8277,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max)
                ncx->blk_sub.argarray   = (cx->blk_sub.hasargs
                                           ? av_dup_inc(cx->blk_sub.argarray)
                                           : Nullav);
-               ncx->blk_sub.savearray  = av_dup(cx->blk_sub.savearray);
+               ncx->blk_sub.savearray  = av_dup_inc(cx->blk_sub.savearray);
                ncx->blk_sub.olddepth   = cx->blk_sub.olddepth;
                ncx->blk_sub.hasargs    = cx->blk_sub.hasargs;
                ncx->blk_sub.lval       = cx->blk_sub.lval;
@@ -8857,7 +8864,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_defgv           = gv_dup(proto_perl->Idefgv);
     PL_argvgv          = gv_dup(proto_perl->Iargvgv);
     PL_argvoutgv       = gv_dup(proto_perl->Iargvoutgv);
-    PL_argvout_stack   = av_dup(proto_perl->Iargvout_stack);
+    PL_argvout_stack   = av_dup_inc(proto_perl->Iargvout_stack);
 
     /* shortcuts to regexp stuff */
     PL_replgv          = gv_dup(proto_perl->Ireplgv);