This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
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
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;
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,
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);
}
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)
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++;
}
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* 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;
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);
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;
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);
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 (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) {
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);
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();
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;
(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 (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;
POPSTACK;
FREETMPS;
LEAVE;