diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs index 0447c50..7651b62 100644 *** a/src/pl/plperl/SPI.xs --- b/src/pl/plperl/SPI.xs *************** *** 15,52 **** #undef _ /* perl stuff */ #include "plperl.h" #include "plperl_helpers.h" - /* - * Interface routine to catch ereports and punt them to Perl - */ - static void - do_plperl_return_next(SV *sv) - { - MemoryContext oldcontext = CurrentMemoryContext; - - PG_TRY(); - { - plperl_return_next(sv); - } - PG_CATCH(); - { - ErrorData *edata; - - /* Must reset elog.c's state */ - MemoryContextSwitchTo(oldcontext); - edata = CopyErrorData(); - FlushErrorState(); - - /* Punt the error to Perl */ - croak_cstr(edata->message); - } - PG_END_TRY(); - } - - MODULE = PostgreSQL::InServer::SPI PREFIX = spi_ PROTOTYPES: ENABLE --- 15,25 ---- #undef _ /* perl stuff */ + #define PG_NEED_PERL_XSUB_H #include "plperl.h" #include "plperl_helpers.h" MODULE = PostgreSQL::InServer::SPI PREFIX = spi_ PROTOTYPES: ENABLE *************** void *** 76,82 **** spi_return_next(rv) SV *rv; CODE: ! do_plperl_return_next(rv); SV * spi_spi_query(sv) --- 49,55 ---- spi_return_next(rv) SV *rv; CODE: ! plperl_return_next(rv); SV * spi_spi_query(sv) diff --git a/src/pl/plperl/Util.xs b/src/pl/plperl/Util.xs index dbba0d7..862fec4 100644 *** a/src/pl/plperl/Util.xs --- b/src/pl/plperl/Util.xs *************** *** 20,67 **** #undef _ /* perl stuff */ #include "plperl.h" #include "plperl_helpers.h" - /* - * Implementation of plperl's elog() function - * - * If the error level is less than ERROR, we'll just emit the message and - * return. When it is ERROR, elog() will longjmp, which we catch and - * turn into a Perl croak(). Note we are assuming that elog() can't have - * any internal failures that are so bad as to require a transaction abort. - * - * This is out-of-line to suppress "might be clobbered by longjmp" warnings. - */ - static void - do_util_elog(int level, SV *msg) - { - MemoryContext oldcontext = CurrentMemoryContext; - char * volatile cmsg = NULL; - - PG_TRY(); - { - cmsg = sv2cstr(msg); - elog(level, "%s", cmsg); - pfree(cmsg); - } - PG_CATCH(); - { - ErrorData *edata; - - /* Must reset elog.c's state */ - MemoryContextSwitchTo(oldcontext); - edata = CopyErrorData(); - FlushErrorState(); - - if (cmsg) - pfree(cmsg); - - /* Punt the error to Perl */ - croak_cstr(edata->message); - } - PG_END_TRY(); - } static text * sv2text(SV *sv) --- 20,29 ---- #undef _ /* perl stuff */ + #define PG_NEED_PERL_XSUB_H #include "plperl.h" #include "plperl_helpers.h" static text * sv2text(SV *sv) *************** util_elog(level, msg) *** 105,111 **** level = ERROR; if (level < DEBUG5) level = DEBUG5; ! do_util_elog(level, msg); SV * util_quote_literal(sv) --- 67,73 ---- level = ERROR; if (level < DEBUG5) level = DEBUG5; ! plperl_util_elog(level, msg); SV * util_quote_literal(sv) diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 5a45e3e..9a26470 100644 *** a/src/pl/plperl/plperl.c --- b/src/pl/plperl/plperl.c *************** static void plperl_init_shared_libs(pTHX *** 285,290 **** --- 285,291 ---- static void plperl_trusted_init(void); static void plperl_untrusted_init(void); static HV *plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int); + static void plperl_return_next_internal(SV *sv); static char *hek2cstr(HE *he); static SV **hv_store_string(HV *hv, const char *key, SV *val); static SV **hv_fetch_string(HV *hv, const char *key); *************** static char *setlocale_perl(int category *** 303,313 **** --- 304,326 ---- #endif /* + * Decrement the refcount of the given SV within the active Perl interpreter + */ + static inline void + SvREFCNT_dec_current(SV *sv) + { + dTHX; + + SvREFCNT_dec(sv); + } + + /* * convert a HE (hash entry) key to a cstr in the current database encoding */ static char * hek2cstr(HE *he) { + dTHX; char *ret; SV *sv; *************** select_perl_context(bool trusted) *** 641,655 **** * to the database AFTER on_*_init code has run. See * http://archives.postgresql.org/pgsql-hackers/2010-01/msg02669.php */ ! newXS("PostgreSQL::InServer::SPI::bootstrap", ! boot_PostgreSQL__InServer__SPI, __FILE__); ! eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE); ! if (SvTRUE(ERRSV)) ! ereport(ERROR, ! (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), ! errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), ! errcontext("while executing PostgreSQL::InServer::SPI::bootstrap"))); /* Fully initialized, so mark the hashtable entry valid */ interp_desc->interp = interp; --- 654,672 ---- * to the database AFTER on_*_init code has run. See * http://archives.postgresql.org/pgsql-hackers/2010-01/msg02669.php */ ! { ! dTHX; ! newXS("PostgreSQL::InServer::SPI::bootstrap", ! boot_PostgreSQL__InServer__SPI, __FILE__); ! ! eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE); ! if (SvTRUE(ERRSV)) ! ereport(ERROR, ! (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), ! errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), ! errcontext("while executing PostgreSQL::InServer::SPI::bootstrap"))); ! } /* Fully initialized, so mark the hashtable entry valid */ interp_desc->interp = interp; *************** plperl_init_interp(void) *** 792,844 **** PERL_SET_CONTEXT(plperl); perl_construct(plperl); - /* run END blocks in perl_destruct instead of perl_run */ - PL_exit_flags |= PERL_EXIT_DESTRUCT_END; - /* ! * Record the original function for the 'require' and 'dofile' opcodes. ! * (They share the same implementation.) Ensure it's used for new ! * interpreters. */ - if (!pp_require_orig) - pp_require_orig = PL_ppaddr[OP_REQUIRE]; - else { ! PL_ppaddr[OP_REQUIRE] = pp_require_orig; ! PL_ppaddr[OP_DOFILE] = pp_require_orig; ! } #ifdef PLPERL_ENABLE_OPMASK_EARLY ! /* ! * For regression testing to prove that the PLC_PERLBOOT and PLC_TRUSTED ! * code doesn't even compile any unsafe ops. In future there may be a ! * valid need for them to do so, in which case this could be softened ! * (perhaps moved to plperl_trusted_init()) or removed. ! */ ! PL_op_mask = plperl_opmask; #endif ! if (perl_parse(plperl, plperl_init_shared_libs, ! nargs, embedding, NULL) != 0) ! ereport(ERROR, ! (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), ! errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), ! errcontext("while parsing Perl initialization"))); ! if (perl_run(plperl) != 0) ! ereport(ERROR, ! (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), ! errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), ! errcontext("while running Perl initialization"))); #ifdef PLPERL_RESTORE_LOCALE ! PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate); ! PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype); ! PLPERL_RESTORE_LOCALE(LC_MONETARY, save_monetary); ! PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric); ! PLPERL_RESTORE_LOCALE(LC_TIME, save_time); #endif return plperl; } --- 809,870 ---- PERL_SET_CONTEXT(plperl); perl_construct(plperl); /* ! * Run END blocks in perl_destruct instead of perl_run. Note that dTHX ! * loads up a pointer to the current interpreter, so we have to postpone ! * it to here rather than put it at the function head. */ { ! dTHX; ! ! PL_exit_flags |= PERL_EXIT_DESTRUCT_END; ! ! /* ! * Record the original function for the 'require' and 'dofile' ! * opcodes. (They share the same implementation.) Ensure it's used ! * for new interpreters. ! */ ! if (!pp_require_orig) ! pp_require_orig = PL_ppaddr[OP_REQUIRE]; ! else ! { ! PL_ppaddr[OP_REQUIRE] = pp_require_orig; ! PL_ppaddr[OP_DOFILE] = pp_require_orig; ! } #ifdef PLPERL_ENABLE_OPMASK_EARLY ! /* ! * For regression testing to prove that the PLC_PERLBOOT and ! * PLC_TRUSTED code doesn't even compile any unsafe ops. In future ! * there may be a valid need for them to do so, in which case this ! * could be softened (perhaps moved to plperl_trusted_init()) or ! * removed. ! */ ! PL_op_mask = plperl_opmask; #endif ! if (perl_parse(plperl, plperl_init_shared_libs, ! nargs, embedding, NULL) != 0) ! ereport(ERROR, ! (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), ! errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), ! errcontext("while parsing Perl initialization"))); ! if (perl_run(plperl) != 0) ! ereport(ERROR, ! (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), ! errmsg("%s", strip_trailing_ws(sv2cstr(ERRSV))), ! errcontext("while running Perl initialization"))); #ifdef PLPERL_RESTORE_LOCALE ! PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate); ! PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype); ! PLPERL_RESTORE_LOCALE(LC_MONETARY, save_monetary); ! PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric); ! PLPERL_RESTORE_LOCALE(LC_TIME, save_time); #endif + } return plperl; } *************** plperl_destroy_interp(PerlInterpreter ** *** 904,909 **** --- 930,936 ---- * public API so isn't portably available.) Meanwhile END blocks can * be used to perform manual cleanup. */ + dTHX; /* Run END blocks - based on perl's perl_destruct() */ if (PL_exit_flags & PERL_EXIT_DESTRUCT_END) *************** plperl_destroy_interp(PerlInterpreter ** *** 930,935 **** --- 957,963 ---- static void plperl_trusted_init(void) { + dTHX; HV *stash; SV *sv; char *key; *************** plperl_trusted_init(void) *** 1010,1015 **** --- 1038,1045 ---- static void plperl_untrusted_init(void) { + dTHX; + /* * Nothing to do except execute plperl.on_plperlu_init */ *************** strip_trailing_ws(const char *msg) *** 1045,1050 **** --- 1075,1081 ---- static HeapTuple plperl_build_tuple_result(HV *perlhash, TupleDesc td) { + dTHX; Datum *values; bool *nulls; HE *he; *************** plperl_hash_to_datum(SV *src, TupleDesc *** 1106,1111 **** --- 1137,1144 ---- static SV * get_perl_array_ref(SV *sv) { + dTHX; + if (SvOK(sv) && SvROK(sv)) { if (SvTYPE(SvRV(sv)) == SVt_PVAV) *************** array_to_datum_internal(AV *av, ArrayBui *** 1134,1139 **** --- 1167,1173 ---- Oid arraytypid, Oid elemtypid, int32 typmod, FmgrInfo *finfo, Oid typioparam) { + dTHX; int i; int len = av_len(av) + 1; *************** array_to_datum_internal(AV *av, ArrayBui *** 1205,1210 **** --- 1239,1245 ---- static Datum plperl_array_to_datum(SV *src, Oid typid, int32 typmod) { + dTHX; ArrayBuildState *astate; Oid elemtypid; FmgrInfo finfo; *************** plperl_sv_to_literal(SV *sv, char *fqtyp *** 1407,1412 **** --- 1442,1448 ---- static SV * plperl_ref_from_pg_array(Datum arg, Oid typid) { + dTHX; ArrayType *ar = DatumGetArrayTypeP(arg); Oid elementtype = ARR_ELEMTYPE(ar); int16 typlen; *************** plperl_ref_from_pg_array(Datum arg, Oid *** 1485,1490 **** --- 1521,1527 ---- static SV * split_array(plperl_array_info *info, int first, int last, int nest) { + dTHX; int i; AV *result; *************** split_array(plperl_array_info *info, int *** 1518,1523 **** --- 1555,1561 ---- static SV * make_array_ref(plperl_array_info *info, int first, int last) { + dTHX; int i; AV *result = newAV(); *************** make_array_ref(plperl_array_info *info, *** 1555,1560 **** --- 1593,1599 ---- static SV * plperl_trigger_build_args(FunctionCallInfo fcinfo) { + dTHX; TriggerData *tdata; TupleDesc tupdesc; int i; *************** plperl_trigger_build_args(FunctionCallIn *** 1661,1666 **** --- 1700,1706 ---- static SV * plperl_event_trigger_build_args(FunctionCallInfo fcinfo) { + dTHX; EventTriggerData *tdata; HV *hv; *************** plperl_event_trigger_build_args(Function *** 1678,1683 **** --- 1718,1724 ---- static HeapTuple plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) { + dTHX; SV **svp; HV *hvNew; HE *he; *************** plperl_inline_handler(PG_FUNCTION_ARGS) *** 1874,1880 **** perlret = plperl_call_perl_func(&desc, &fake_fcinfo); ! SvREFCNT_dec(perlret); if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); --- 1915,1921 ---- perlret = plperl_call_perl_func(&desc, &fake_fcinfo); ! SvREFCNT_dec_current(perlret); if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); *************** plperl_inline_handler(PG_FUNCTION_ARGS) *** 1882,1888 **** PG_CATCH(); { if (desc.reference) ! SvREFCNT_dec(desc.reference); current_call_data = save_call_data; activate_interpreter(oldinterp); PG_RE_THROW(); --- 1923,1929 ---- PG_CATCH(); { if (desc.reference) ! SvREFCNT_dec_current(desc.reference); current_call_data = save_call_data; activate_interpreter(oldinterp); PG_RE_THROW(); *************** plperl_inline_handler(PG_FUNCTION_ARGS) *** 1890,1896 **** PG_END_TRY(); if (desc.reference) ! SvREFCNT_dec(desc.reference); current_call_data = save_call_data; activate_interpreter(oldinterp); --- 1931,1937 ---- PG_END_TRY(); if (desc.reference) ! SvREFCNT_dec_current(desc.reference); current_call_data = save_call_data; activate_interpreter(oldinterp); *************** plperlu_validator(PG_FUNCTION_ARGS) *** 2018,2023 **** --- 2059,2065 ---- static void plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid) { + dTHX; dSP; char subname[NAMEDATALEN + 40]; HV *pragma_hv = newHV(); *************** plperl_init_shared_libs(pTHX) *** 2104,2109 **** --- 2146,2152 ---- static SV * plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo) { + dTHX; dSP; SV *retval; int i; *************** static SV * *** 2197,2202 **** --- 2240,2246 ---- plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo, SV *td) { + dTHX; dSP; SV *retval, *TDsv; *************** plperl_call_perl_event_trigger_func(plpe *** 2265,2270 **** --- 2309,2315 ---- FunctionCallInfo fcinfo, SV *td) { + dTHX; dSP; SV *retval, *TDsv; *************** plperl_func_handler(PG_FUNCTION_ARGS) *** 2384,2396 **** sav = get_perl_array_ref(perlret); if (sav) { int i = 0; SV **svp = 0; AV *rav = (AV *) SvRV(sav); while ((svp = av_fetch(rav, i, FALSE)) != NULL) { ! plperl_return_next(*svp); i++; } } --- 2429,2442 ---- sav = get_perl_array_ref(perlret); if (sav) { + dTHX; int i = 0; SV **svp = 0; AV *rav = (AV *) SvRV(sav); while ((svp = av_fetch(rav, i, FALSE)) != NULL) { ! plperl_return_next_internal(*svp); i++; } } *************** plperl_func_handler(PG_FUNCTION_ARGS) *** 2427,2433 **** /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; ! SvREFCNT_dec(perlret); return retval; } --- 2473,2479 ---- /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; ! SvREFCNT_dec_current(perlret); return retval; } *************** plperl_trigger_handler(PG_FUNCTION_ARGS) *** 2538,2546 **** /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; ! SvREFCNT_dec(svTD); if (perlret) ! SvREFCNT_dec(perlret); return retval; } --- 2584,2592 ---- /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; ! SvREFCNT_dec_current(svTD); if (perlret) ! SvREFCNT_dec_current(perlret); return retval; } *************** plperl_event_trigger_handler(PG_FUNCTION *** 2579,2587 **** /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; ! SvREFCNT_dec(svTD); ! ! return; } --- 2625,2631 ---- /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; ! SvREFCNT_dec_current(svTD); } *************** free_plperl_function(plperl_proc_desc *p *** 2624,2630 **** plperl_interp_desc *oldinterp = plperl_active_interp; activate_interpreter(prodesc->interp); ! SvREFCNT_dec(prodesc->reference); activate_interpreter(oldinterp); } /* Release all PG-owned data for this proc */ --- 2668,2674 ---- plperl_interp_desc *oldinterp = plperl_active_interp; activate_interpreter(prodesc->interp); ! SvREFCNT_dec_current(prodesc->reference); activate_interpreter(oldinterp); } /* Release all PG-owned data for this proc */ *************** plperl_hash_from_datum(Datum attr) *** 2949,2954 **** --- 2993,2999 ---- static SV * plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc) { + dTHX; HV *hv; int i; *************** static HV * *** 3094,3099 **** --- 3139,3145 ---- plperl_spi_execute_fetch_result(SPITupleTable *tuptable, uint64 processed, int status) { + dTHX; HV *result; check_spi_usage_allowed(); *************** plperl_spi_execute_fetch_result(SPITuple *** 3137,3152 **** /* ! * Note: plperl_return_next is called both in Postgres and Perl contexts. ! * We report any errors in Postgres fashion (via ereport). If called in ! * Perl context, it is SPI.xs's responsibility to catch the error and ! * convert to a Perl error. We assume (perhaps without adequate justification) ! * that we need not abort the current transaction if the Perl code traps the ! * error. */ void plperl_return_next(SV *sv) { plperl_proc_desc *prodesc; FunctionCallInfo fcinfo; ReturnSetInfo *rsi; --- 3183,3223 ---- /* ! * plperl_return_next catches any error and converts it to a Perl error. ! * We assume (perhaps without adequate justification) that we need not abort ! * the current transaction if the Perl code traps the error. */ void plperl_return_next(SV *sv) { + MemoryContext oldcontext = CurrentMemoryContext; + + PG_TRY(); + { + plperl_return_next_internal(sv); + } + PG_CATCH(); + { + ErrorData *edata; + + /* Must reset elog.c's state */ + MemoryContextSwitchTo(oldcontext); + edata = CopyErrorData(); + FlushErrorState(); + + /* Punt the error to Perl */ + croak_cstr(edata->message); + } + PG_END_TRY(); + } + + /* + * plperl_return_next_internal reports any errors in Postgres fashion + * (via ereport). + */ + static void + plperl_return_next_internal(SV *sv) + { plperl_proc_desc *prodesc; FunctionCallInfo fcinfo; ReturnSetInfo *rsi; *************** plperl_spi_fetchrow(char *cursor) *** 3336,3341 **** --- 3407,3413 ---- PG_TRY(); { + dTHX; Portal p = SPI_cursor_find(cursor); if (!p) *************** plperl_spi_exec_prepared(char *query, HV *** 3577,3582 **** --- 3649,3656 ---- PG_TRY(); { + dTHX; + /************************************************************ * Fetch the saved plan descriptor, see if it's o.k. ************************************************************/ *************** plperl_spi_freeplan(char *query) *** 3822,3833 **** --- 3896,3949 ---- } /* + * Implementation of plperl's elog() function + * + * If the error level is less than ERROR, we'll just emit the message and + * return. When it is ERROR, elog() will longjmp, which we catch and + * turn into a Perl croak(). Note we are assuming that elog() can't have + * any internal failures that are so bad as to require a transaction abort. + * + * The main reason this is out-of-line is to avoid conflicts between XSUB.h + * and the PG_TRY macros. + */ + void + plperl_util_elog(int level, SV *msg) + { + MemoryContext oldcontext = CurrentMemoryContext; + char *volatile cmsg = NULL; + + PG_TRY(); + { + cmsg = sv2cstr(msg); + elog(level, "%s", cmsg); + pfree(cmsg); + } + PG_CATCH(); + { + ErrorData *edata; + + /* Must reset elog.c's state */ + MemoryContextSwitchTo(oldcontext); + edata = CopyErrorData(); + FlushErrorState(); + + if (cmsg) + pfree(cmsg); + + /* Punt the error to Perl */ + croak_cstr(edata->message); + } + PG_END_TRY(); + } + + /* * Store an SV into a hash table under a key that is a string assumed to be * in the current database's encoding. */ static SV ** hv_store_string(HV *hv, const char *key, SV *val) { + dTHX; int32 hlen; char *hkey; SV **ret; *************** hv_store_string(HV *hv, const char *key, *** 3854,3859 **** --- 3970,3976 ---- static SV ** hv_fetch_string(HV *hv, const char *key) { + dTHX; int32 hlen; char *hkey; SV **ret; diff --git a/src/pl/plperl/plperl.h b/src/pl/plperl/plperl.h index eecd192..3f3cce9 100644 *** a/src/pl/plperl/plperl.h --- b/src/pl/plperl/plperl.h *************** *** 44,52 **** --- 44,60 ---- /* required for perl API */ + #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" + + /* + * We want to include this only within .xs files, but it must come before + * ppport.h, so use a #define flag to control inclusion. + */ + #ifdef PG_NEED_PERL_XSUB_H #include "XSUB.h" + #endif /* put back our snprintf and vsnprintf */ #ifdef USE_REPL_SNPRINTF *************** SV *plperl_spi_query_prepared(char * *** 106,110 **** --- 114,119 ---- void plperl_spi_freeplan(char *); void plperl_spi_cursor_close(char *); char *plperl_sv_to_literal(SV *, char *); + void plperl_util_elog(int level, SV *msg); #endif /* PL_PERL_H */ diff --git a/src/pl/plperl/plperl_helpers.h b/src/pl/plperl/plperl_helpers.h index 76124ed..5acac60 100644 *** a/src/pl/plperl/plperl_helpers.h --- b/src/pl/plperl/plperl_helpers.h *************** sv2cstr(SV *sv) *** 54,59 **** --- 54,61 ---- *res; STRLEN len; + dTHX; + /* * get a utf8 encoded char * out of perl. *note* it may not be valid utf8! */ *************** cstr2sv(const char *str) *** 110,115 **** --- 112,119 ---- SV *sv; char *utf8_str; + dTHX; + /* no conversion when SQL_ASCII */ if (GetDatabaseEncoding() == PG_SQL_ASCII) return newSVpv(str, 0); *************** cstr2sv(const char *str) *** 134,139 **** --- 138,145 ---- static inline void croak_cstr(const char *str) { + dTHX; + #ifdef croak_sv /* Use sv_2mortal() to be sure the transient SV gets freed */ croak_sv(sv_2mortal(cstr2sv(str)));