This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump up version numbers.
[perl5.git] / utf8.c
diff --git a/utf8.c b/utf8.c
index b682cf6..5a5f56c 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -243,7 +243,7 @@ Most code should use utf8_to_uvchr() rather than call this directly.
 UV
 Perl_utf8n_to_uvuni(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
 {
-    UV uv = *s, ouv;
+    UV uv = *s, ouv = 0;
     STRLEN len = 1;
     bool dowarn = ckWARN_d(WARN_UTF8);
     STRLEN expectlen = 0;
@@ -428,7 +428,7 @@ malformed:
 
            if (PL_op)
                Perl_warner(aTHX_ WARN_UTF8,
-                           "%s in %s", s,  PL_op_desc[PL_op->op_type]);
+                           "%s in %s", s,  OP_DESC(PL_op));
            else
                Perl_warner(aTHX_ WARN_UTF8, "%s", s);
        }
@@ -507,7 +507,7 @@ Perl_utf8_length(pTHX_ U8 *s, U8 *e)
        U8 t = UTF8SKIP(s);
 
        if (e - s < t)
-           Perl_croak(aTHX_ "panic: utf8_length: s=%p (%02X) e=%p l=%d - unaligned end",s,*s,e,t);
+           Perl_croak(aTHX_ "panic: utf8_length: unaligned end");
        s += t;
        len++;
     }
@@ -1240,10 +1240,15 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
     SV* tokenbufsv = sv_2mortal(NEWSV(0,0));
     dSP;
     HV *stash = gv_stashpvn(pkg, strlen(pkg), FALSE);
+    SV* errsv_save;
 
     if (!gv_fetchmeth(stash, "SWASHNEW", 8, -1)) {     /* demand load utf8 */
        ENTER;
+       errsv_save = newSVsv(ERRSV);
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpv(pkg,0), Nullsv);
+       if (!SvTRUE(ERRSV))
+           sv_setsv(ERRSV, errsv_save);
+       SvREFCNT_dec(errsv_save);
        LEAVE;
     }
     SPAGAIN;
@@ -1263,10 +1268,14 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
     if (PL_curcop == &PL_compiling)
        /* XXX ought to be handled by lex_start */
        sv_setpv(tokenbufsv, PL_tokenbuf);
+    errsv_save = newSVsv(ERRSV);
     if (call_method("SWASHNEW", G_SCALAR))
        retval = newSVsv(*PL_stack_sp--);
     else
        retval = &PL_sv_undef;
+    if (!SvTRUE(ERRSV))
+       sv_setsv(ERRSV, errsv_save);
+    SvREFCNT_dec(errsv_save);
     LEAVE;
     POPSTACK;
     if (PL_curcop == &PL_compiling) {
@@ -1350,6 +1359,7 @@ Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr, bool do_utf8)
               Unicode tables, not a native character number.
             */
            UV code_point = utf8n_to_uvuni(ptr, UTF8_MAXLEN, NULL, 0);
+           SV *errsv_save;
            ENTER;
            SAVETMPS;
            save_re_context();
@@ -1362,10 +1372,14 @@ Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr, bool do_utf8)
                                     (code_point & ~(needents - 1)) : 0)));
            PUSHs(sv_2mortal(newSViv(needents)));
            PUTBACK;
+           errsv_save = newSVsv(ERRSV);
            if (call_method("SWASHGET", G_SCALAR))
                retval = newSVsv(*PL_stack_sp--);
            else
                retval = &PL_sv_undef;
+           if (!SvTRUE(ERRSV))
+               sv_setsv(ERRSV, errsv_save);
+           SvREFCNT_dec(errsv_save);
            POPSTACK;
            FREETMPS;
            LEAVE;