From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 29 May 2001 16:25:47 +0000 (+0000)
Subject: Fix Perl_swash_init & Perl_swash_fetch to save ERRSV (= $@)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8be5cf0389ae62d00662435c7a6a3adad70afa4;p=p5sagit%2Fp5-mst-13.2.git

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
---

diff --git a/utf8.c b/utf8.c
index b682cf6..e629087 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;