d_getservbyname_r undef up to at least OpenBSD 3.5

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

diff --git a/sv.c b/sv.c
index e49ac5e..36fbc21 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.
@@ -321,10 +321,11 @@ S_more_sv(pTHX)
     return sv;
 }
 
-/* visit(): call the named function for each non-free SV in the arenas. */
+/* visit(): call the named function for each non-free SV in the arenas
+ * whose flags field matches the flags/mask args. */
 
 STATIC I32
-S_visit(pTHX_ SVFUNC_t f)
+S_visit(pTHX_ SVFUNC_t f, U32 flags, U32 mask)
 {
     SV* sva;
     SV* sv;
@@ -334,7 +335,10 @@ 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 && SvREFCNT(sv)) {
+           if (SvTYPE(sv) != SVTYPEMASK
+                   && (sv->sv_flags & mask) == flags
+                   && SvREFCNT(sv))
+           {
                (FCALL)(aTHX_ sv);
                ++visited;
            }
@@ -369,7 +373,7 @@ void
 Perl_sv_report_used(pTHX)
 {
 #ifdef DEBUGGING
-    visit(do_report_used);
+    visit(do_report_used, 0, 0);
 #endif
 }
 
@@ -410,6 +414,7 @@ do_clean_named_objs(pTHX_ SV *sv)
             (GvCV(sv) && SvOBJECT(GvCV(sv))) )
        {
            DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
+           SvFLAGS(sv) |= SVf_BREAK;
            SvREFCNT_dec(sv);
        }
     }
@@ -428,10 +433,10 @@ void
 Perl_sv_clean_objs(pTHX)
 {
     PL_in_clean_objs = TRUE;
-    visit(do_clean_objs);
+    visit(do_clean_objs, SVf_ROK, SVf_ROK);
 #ifndef DISABLE_DESTRUCTOR_KLUDGE
     /* some barnacles may yet remain, clinging to typeglobs */
-    visit(do_clean_named_objs);
+    visit(do_clean_named_objs, SVt_PVGV, SVTYPEMASK);
 #endif
     PL_in_clean_objs = FALSE;
 }
@@ -443,6 +448,10 @@ do_clean_all(pTHX_ SV *sv)
 {
     DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) ));
     SvFLAGS(sv) |= SVf_BREAK;
+    if (PL_comppad == (AV*)sv) {
+       PL_comppad = Nullav;
+       PL_curpad = Null(SV**);
+    }
     SvREFCNT_dec(sv);
 }
 
@@ -461,7 +470,7 @@ Perl_sv_clean_all(pTHX)
 {
     I32 cleaned;
     PL_in_clean_all = TRUE;
-    cleaned = visit(do_clean_all);
+    cleaned = visit(do_clean_all, 0,0);
     PL_in_clean_all = FALSE;
     return cleaned;
 }
@@ -1909,7 +1918,7 @@ Perl_looks_like_number(pTHX_ SV *sv)
     else if (SvPOKp(sv))
        sbegin = SvPV(sv, len);
     else
-       return 1; /* Historic.  Wrong?  */
+       return SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK);
     return grok_number(sbegin, len, NULL);
 }
 
@@ -3477,10 +3486,6 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
         sv_force_normal_flags(sv, 0);
     }
 
-    if (SvREADONLY(sv)) {
-       Perl_croak(aTHX_ PL_no_modify);
-    }
-
     if (PL_encoding && !(flags & SV_UTF8_NO_ENCODING))
         sv_recode_to_utf8(sv, PL_encoding);
     else { /* Assume Latin-1/EBCDIC */
@@ -3498,7 +3503,8 @@ Perl_sv_utf8_upgrade_flags(pTHX_ register SV *sv, I32 flags)
         }
         if (hibit) {
              STRLEN len;
-       
+             (void)SvOOK_off(sv);
+             s = (U8*)SvPVX(sv);
              len = SvCUR(sv) + 1; /* Plus the \0 */
              SvPVX(sv) = (char*)bytes_to_utf8((U8*)s, &len);
              SvCUR(sv) = len - 1;
@@ -3570,6 +3576,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);
 }
 
@@ -7831,8 +7843,10 @@ instead.
 char *
 Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp)
 {
+    sv_pvn_force(sv,lp);
     sv_utf8_downgrade(sv,0);
-    return sv_pvn_force(sv,lp);
+    *lp = SvCUR(sv);
+    return SvPVX(sv);
 }
 
 /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
@@ -7880,8 +7894,10 @@ instead.
 char *
 Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp)
 {
+    sv_pvn_force(sv,lp);
     sv_utf8_upgrade(sv);
-    return sv_pvn_force(sv,lp);
+    *lp = SvCUR(sv);
+    return SvPVX(sv);
 }
 
 /*
@@ -9713,7 +9729,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;
@@ -9725,7 +9741,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