summaryrefslogtreecommitdiff
path: root/utf8.c
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-05-29 16:25:47 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-05-29 16:25:47 +0000
commitf8be5cf0389ae62d00662435c7a6a3adad70afa4 (patch)
treeca1fb06cb910a55e0835dd719449b59337b0dfa0 /utf8.c
parentffc4a5af7ac7c7f46decfea748606a2d9298dd7e (diff)
downloadperl-f8be5cf0389ae62d00662435c7a6a3adad70afa4.tar.gz
Fix Perl_swash_init & Perl_swash_fetch to save ERRSV (= $@)
before Perl_load_module/Perl_call_method and restore the value after if !SvTRUE(ERRSV). (from Inaba Hiroto) p4raw-id: //depot/perl@10297
Diffstat (limited to 'utf8.c')
-rw-r--r--utf8.c14
1 files changed, 14 insertions, 0 deletions
diff --git a/utf8.c b/utf8.c
index b682cf65ca..e62908759e 100644
--- a/utf8.c
+++ b/utf8.c
@@ -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;