Retract #8875, cannot let go of the old semantics of unpack U

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

diff --git a/mg.c b/mg.c
index ca06b89..aa07283 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -415,7 +415,7 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
                    i = Perl_utf8_length(aTHX_ (U8*)s, (U8*)send);
                }
                if (i < 0)
-                   Perl_croak(aTHX_ "panic: magic_len: %d", i);
+                   Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i);
                return i;
            }
        }
@@ -796,7 +796,7 @@ Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg)
     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
 
     if (uf && uf->uf_val)
-       (*uf->uf_val)(uf->uf_index, sv);
+       (*uf->uf_val)(aTHX_ uf->uf_index, sv);
     return 0;
 }
 
@@ -996,6 +996,40 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
     return 0;
 }
 
+void
+Perl_raise_signal(pTHX_ int sig)
+{
+    /* Set a flag to say this signal is pending */
+    PL_psig_pend[sig]++;
+    /* And one to say _a_ signal is pending */
+    PL_sig_pending = 1;
+}
+
+Signal_t
+Perl_csighandler(int sig)
+{
+#ifdef PERL_OLD_SIGNALS
+    /* Call the perl level handler now with risk we may be in malloc() etc. */
+    (*PL_sighandlerp)(sig);
+#else
+    dTHX;
+    Perl_raise_signal(aTHX_ sig);
+#endif
+}
+
+void
+Perl_despatch_signals(pTHX)
+{
+    int sig;
+    PL_sig_pending = 0;
+    for (sig = 1; sig < SIG_SIZE; sig++) {
+       if (PL_psig_pend[sig]) {
+           PL_psig_pend[sig] = 0;
+           (*PL_sighandlerp)(sig);
+       }
+    }
+}
+
 int
 Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 {
@@ -1034,7 +1068,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     }
     if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
        if (i)
-           (void)rsignal(i, PL_sighandlerp);
+           (void)rsignal(i, &Perl_csighandler);
        else
            *svp = SvREFCNT_inc(sv);
        return 0;
@@ -1061,7 +1095,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
        if (!strchr(s,':') && !strchr(s,'\''))
            sv_insert(sv, 0, 0, "main::", 6);
        if (i)
-           (void)rsignal(i, PL_sighandlerp);
+           (void)rsignal(i, &Perl_csighandler);
        else
            *svp = SvREFCNT_inc(sv);
     }
@@ -1404,12 +1438,14 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
     I32 offs = LvTARGOFF(sv);
     I32 rem = LvTARGLEN(sv);
 
+    if (SvUTF8(lsv))
+       sv_pos_u2b(lsv, &offs, &rem);
     if (offs > len)
        offs = len;
     if (rem + offs > len)
        rem = len - offs;
     sv_setpvn(sv, tmps + offs, (STRLEN)rem);
-    if (DO_UTF8(lsv))
+    if (SvUTF8(lsv))
         SvUTF8_on(sv);
     return 0;
 }
@@ -1417,25 +1453,26 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
-    STRLEN littlelen;
-    char *tmps = SvPV(sv, littlelen);
+    STRLEN len;
+    char *tmps = SvPV(sv, len);
+    SV *lsv = LvTARG(sv);
+    I32 lvoff = LvTARGOFF(sv);
+    I32 lvlen = LvTARGLEN(sv);
 
     if (DO_UTF8(sv)) {
-       I32 bigoff = LvTARGOFF(sv);
-       I32 biglen = LvTARGLEN(sv);
-       U8 *s, *a, *b;
-
-       sv_utf8_upgrade(LvTARG(sv));
-       /* sv_utf8_upgrade() might have moved and/or resized
-        * the string to be replaced, we must rediscover it. --jhi */
-       s = (U8*)SvPVX(LvTARG(sv));
-       a = utf8_hop(s, bigoff);
-       b = utf8_hop(a, biglen);
-       sv_insert(LvTARG(sv), a - s, b - a, tmps, littlelen);
-       SvUTF8_on(LvTARG(sv));
+       sv_utf8_upgrade(lsv);
+       sv_pos_u2b(lsv, &lvoff, &lvlen);
+       sv_insert(lsv, lvoff, lvlen, tmps, len);
+       SvUTF8_on(lsv);
+    }
+    else if (SvUTF8(lsv)) {
+       sv_pos_u2b(lsv, &lvoff, &lvlen);
+       tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
+       sv_insert(lsv, lvoff, lvlen, tmps, len);
+       Safefree(tmps);
     }
     else
-        sv_insert(LvTARG(sv), LvTARGOFF(sv), LvTARGLEN(sv), tmps, littlelen);
+        sv_insert(lsv, lvoff, lvlen, tmps, len);
 
     return 0;
 }
@@ -1630,7 +1667,7 @@ Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
 
     if (uf && uf->uf_set)
-       (*uf->uf_set)(uf->uf_index, sv);
+       (*uf->uf_set)(aTHX_ uf->uf_index, sv);
     return 0;
 }
 
@@ -2223,9 +2260,28 @@ Perl_sighandler(int sig)
     PUSHs(sv);
     PUTBACK;
 
-    call_sv((SV*)cv, G_DISCARD);
+    call_sv((SV*)cv, G_DISCARD|G_EVAL);
 
     POPSTACK;
+    if (SvTRUE(ERRSV)) {
+#ifndef PERL_MICRO
+#ifdef HAS_SIGPROCMASK
+       /* Handler "died", for example to get out of a restart-able read().
+        * Before we re-do that on its behalf re-enable the signal which was
+        * blocked by the system when we entered.
+        */
+       sigset_t set;
+       sigemptyset(&set);
+       sigaddset(&set,sig);
+       sigprocmask(SIG_UNBLOCK, &set, NULL);
+#else
+       /* Not clear if this will work */
+       (void)rsignal(sig, SIG_IGN);
+       (void)rsignal(sig, &Perl_csighandler);
+#endif
+#endif /* !PERL_MICRO */
+       Perl_die(aTHX_ Nullch);
+    }
 cleanup:
     if (flags & 1)
        PL_savestack_ix -= 8; /* Unprotect save in progress. */