[perl #33928] chomp() fails after alarm(), `sleep`

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index 82b844a..343c5f0 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, 2004, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 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.
@@ -5341,10 +5341,10 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
     mg->mg_moremagic = SvMAGIC(sv);
     SvMAGIC(sv) = mg;
 
-    /* Some magic sontains a reference loop, where the sv and object refer to
-       each other.  To prevent a reference loop that would prevent such
-       objects being freed, we look for such loops and if we find one we
-       avoid incrementing the object refcount.
+    /* Sometimes a magic contains a reference loop, where the sv and
+       object refer to each other.  To prevent a reference loop that
+       would prevent such objects being freed, we look for such loops
+       and if we find one we avoid incrementing the object refcount.
 
        Note we cannot do this to avoid self-tie loops as intervening RV must
        have its REFCNT incremented to keep it in existence.
@@ -5406,6 +5406,9 @@ then adds a new magic item of type C<how> to the head of the magic list.
 See C<sv_magicext> (which C<sv_magic> now calls) for a description of the
 handling of the C<name> and C<namlen> arguments.
 
+You need to use C<sv_magicext> to add magic to SvREADONLY SVs and also
+to add more than one instance of the same 'how'.
+
 =cut
 */
 
@@ -7855,13 +7858,10 @@ Perl_newSVsv(pTHX_ register SV *old)
        return Nullsv;
     }
     new_SV(sv);
-    if (SvTEMP(old)) {
-       SvTEMP_off(old);
-       sv_setsv(sv,old);
-       SvTEMP_on(old);
-    }
-    else
-       sv_setsv(sv,old);
+    /* SV_GMAGIC is the default for sv_setv()
+       SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
+       with SvTEMP_off and SvTEMP_on round a call to sv_setsv.  */
+    sv_setsv_flags(sv, old, SV_GMAGIC | SV_NOSTEAL);
     return sv;
 }
 
@@ -7969,7 +7969,6 @@ Perl_sv_2io(pTHX_ SV *sv)
 {
     IO* io;
     GV* gv;
-    STRLEN n_a;
 
     switch (SvTYPE(sv)) {
     case SVt_PVIO:
@@ -7986,7 +7985,7 @@ Perl_sv_2io(pTHX_ SV *sv)
            Perl_croak(aTHX_ PL_no_usym, "filehandle");
        if (SvROK(sv))
            return sv_2io(SvRV(sv));
-       gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVIO);
+       gv = gv_fetchsv(sv, FALSE, SVt_PVIO);
        if (gv)
            io = GvIO(gv);
        else
@@ -8012,7 +8011,6 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
 {
     GV *gv = Nullgv;
     CV *cv = Nullcv;
-    STRLEN n_a;
 
     if (!sv)
        return *gvp = Nullgv, Nullcv;
@@ -8053,7 +8051,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
        else if (isGV(sv))
            gv = (GV*)sv;
        else
-           gv = gv_fetchpv(SvPV(sv, n_a), lref, SVt_PVCV);
+           gv = gv_fetchsv(sv, lref, SVt_PVCV);
        *gvp = gv;
        if (!gv)
            return Nullcv;
@@ -8404,10 +8402,8 @@ char *
 Perl_sv_reftype(pTHX_ SV *sv, int ob)
 {
     if (ob && SvOBJECT(sv)) {
-       if (HvNAME(SvSTASH(sv)))
-           return HvNAME(SvSTASH(sv));
-       else
-           return "__ANON__";
+       char *name = HvNAME(SvSTASH(sv));
+       return name ? name : "__ANON__";
     }
     else {
        switch (SvTYPE(sv)) {
@@ -9012,7 +9008,8 @@ 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.  See
-C<sv_catpvf_mg>.
+C<sv_catpvf_mg>. If the original SV was UTF-8, the pattern should be
+valid UTF-8; if the original SV was bytes, the pattern should be too.
 
 =cut */
 
@@ -9274,7 +9271,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #endif
 
        char esignbuf[4];
-       U8 utf8buf[UTF8_MAXLEN+1];
+       U8 utf8buf[UTF8_MAXBYTES+1];
        STRLEN esignlen = 0;
 
        char *eptr = Nullch;
@@ -9584,6 +9581,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            goto string;
 
        case '_':
+#ifdef CHECK_FORMAT
+       format_sv:
+#endif
            /*
             * The "%_" hack might have to be changed someday,
             * if ISO or ANSI decide to use '_' for something.
@@ -9605,6 +9605,17 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            /* INTEGERS */
 
        case 'p':
+#ifdef CHECK_FORMAT
+           if (left) {
+               left = FALSE;
+               if (!width)
+                   goto format_sv;     /* %-p  -> %_   */
+               precis = width;
+               has_precis = TRUE;
+               width = 0;
+               goto format_sv;         /* %-Np -> %.N_ */      
+           }
+#endif
            if (alt || vectorize)
                goto unknown;
            uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
@@ -12155,9 +12166,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_dirty           = proto_perl->Tdirty;
     PL_localizing      = proto_perl->Tlocalizing;
 
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
-    PL_protect         = proto_perl->Tprotect;
-#endif
     PL_errors          = sv_dup_inc(proto_perl->Terrors, param);
     PL_hv_fetch_ent_mh = Nullhe;
     PL_modcount                = proto_perl->Tmodcount;
@@ -12381,3 +12389,12 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding,
     return ret;
 }
 
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * vim: shiftwidth=4:
+*/