*time_r again

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index f3fc035..ea9650c 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -93,34 +93,48 @@ Do magic after a value is retrieved from the SV.  See C<sv_magic>.
 int
 Perl_mg_get(pTHX_ SV *sv)
 {
-    I32 mgs_ix;
-    MAGIC* mg;
-    MAGIC** mgp;
-    int mgp_valid = 0;
+    int new = 0;
+    MAGIC *newmg, *head, *cur, *mg;
+    I32 mgs_ix = SSNEW(sizeof(MGS));
 
-    mgs_ix = SSNEW(sizeof(MGS));
     save_magic(mgs_ix, sv);
 
-    mgp = &SvMAGIC(sv);
-    while ((mg = *mgp) != 0) {
-       MGVTBL* vtbl = mg->mg_virtual;
+    /* We must call svt_get(sv, mg) for each valid entry in the linked
+       list of magic. svt_get() may delete the current entry, add new
+       magic to the head of the list, or upgrade the SV. AMS 20010810 */
+
+    newmg = cur = head = mg = SvMAGIC(sv);
+    while (mg) {
+       MGVTBL *vtbl = mg->mg_virtual;
+
        if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
            CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg);
-           /* Ignore this magic if it's been deleted */
-           if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
-                 (mg->mg_flags & MGf_GSKIP))
-               (SSPTR(mgs_ix, MGS*))->mgs_flags = 0;
+           /* Don't restore the flags for this entry if it was deleted. */
+           if (mg->mg_flags & MGf_GSKIP)
+               (SSPTR(mgs_ix, MGS *))->mgs_flags = 0;
+       }
+
+       mg = mg->mg_moremagic;
+
+       if (new) {
+           /* Have we finished with the new entries we saw? Start again
+              where we left off (unless there are more new entries). */
+           if (mg == head) {
+               new  = 0;
+               mg   = cur;
+               head = newmg;
+           }
        }
-       /* Advance to next magic (complicated by possible deletion) */
-       if (mg == (mgp_valid ? *mgp : SvMAGIC(sv))) {
-           mgp = &mg->mg_moremagic;
-           mgp_valid = 1;
+
+       /* Were any new entries added? */
+       if (!new && (newmg = SvMAGIC(sv)) != head) {
+           new = 1;
+           cur = mg;
+           mg  = newmg;
        }
-       else
-           mgp = &SvMAGIC(sv); /* Re-establish pointer after sv_upgrade */
     }
 
-    restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+    restore_magic(aTHXo_ INT2PTR(void *, (IV)mgs_ix));
     return 0;
 }
 
@@ -185,7 +199,13 @@ Perl_mg_length(pTHX_ SV *sv)
        }
     }
 
-    (void)SvPV(sv, len);
+    if (DO_UTF8(sv)) 
+    {
+        U8 *s = (U8*)SvPV(sv, len);
+        len = Perl_utf8_length(aTHX_ s, s + len);
+    }
+    else
+        (void)SvPV(sv, len);
     return len;
 }
 
@@ -2084,12 +2104,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
         * the setproctitle() routine to manipulate that. */
        {
            s = SvPV(sv, len);
-#   if __FreeBSD_version >= 410001
+#   if __FreeBSD_version > 410001
            /* The leading "-" removes the "perl: " prefix,
             * but not the "(perl) suffix from the ps(1)
             * output, because that's what ps(1) shows if the
             * argv[] is modified. */
-           setproctitle("-%s", s, len + 1);
+           setproctitle("-%s", s);
 #   else       /* old FreeBSDs, NetBSD, OpenBSD, anyBSD */
            /* This doesn't really work if you assume that
             * $0 = 'foobar'; will wipe out 'perl' from the $0