From: Gurusamy Sarathy Date: Sun, 28 May 2000 05:14:55 +0000 (+0000) Subject: enable propagating exception objects via Perl_croak() in XS code X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9983fa3c886b6f0a857997142e62341929a9b601;p=p5sagit%2Fp5-mst-13.2.git enable propagating exception objects via Perl_croak() in XS code (from Gisle Aas) p4raw-id: //depot/perl@6125 --- diff --git a/util.c b/util.c index 8d6ecad..74b374c 100644 --- a/util.c +++ b/util.c @@ -1580,14 +1580,20 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) SV *msv; STRLEN msglen; - msv = vmess(pat, args); - if (PL_errors && SvCUR(PL_errors)) { - sv_catsv(PL_errors, msv); - message = SvPV(PL_errors, msglen); - SvCUR_set(PL_errors, 0); + if (pat) { + msv = vmess(pat, args); + if (PL_errors && SvCUR(PL_errors)) { + sv_catsv(PL_errors, msv); + message = SvPV(PL_errors, msglen); + SvCUR_set(PL_errors, 0); + } + else + message = SvPV(msv,msglen); + } + else { + message = Nullch; + msglen = 0; } - else - message = SvPV(msv,msglen); DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", PTR2UV(thr), message)); @@ -1606,9 +1612,14 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) ENTER; save_re_context(); - msg = newSVpvn(message, msglen); - SvREADONLY_on(msg); - SAVEFREESV(msg); + if (message) { + msg = newSVpvn(message, msglen); + SvREADONLY_on(msg); + SAVEFREESV(msg); + } + else { + msg = ERRSV; + } PUSHSTACKi(PERLSI_DIEHOOK); PUSHMARK(SP); @@ -1655,9 +1666,16 @@ Perl_croak_nocontext(const char *pat, ...) /* =for apidoc croak -This is the XSUB-writer's interface to Perl's C function. Use this -function the same way you use the C C function. See -C. +This is the XSUB-writer's interface to Perl's C function. +Normally use this function the same way you use the C C +function. See C. + +If you want to throw an exception object, assign the object to +C<$@> and then pass C to croak(): + + errsv = get_sv("@", TRUE); + sv_setsv(errsv, exception_object); + croak(Nullch); =cut */