diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs index 6b8dcf62990..0447c50df19 100644 --- a/src/pl/plperl/SPI.xs +++ b/src/pl/plperl/SPI.xs @@ -41,7 +41,7 @@ do_plperl_return_next(SV *sv) FlushErrorState(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); } PG_END_TRY(); } diff --git a/src/pl/plperl/Util.xs b/src/pl/plperl/Util.xs index b2e0dfcf75d..8c3c47fec9f 100644 --- a/src/pl/plperl/Util.xs +++ b/src/pl/plperl/Util.xs @@ -58,7 +58,7 @@ do_util_elog(int level, SV *msg) pfree(cmsg); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); } PG_END_TRY(); } diff --git a/src/pl/plperl/expected/plperl_elog.out b/src/pl/plperl/expected/plperl_elog.out index c447fa22cbc..d2ac1eb71d4 100644 --- a/src/pl/plperl/expected/plperl_elog.out +++ b/src/pl/plperl/expected/plperl_elog.out @@ -104,3 +104,16 @@ PL/Perl function "indirect_die_caller" 2 (1 row) +-- Test non-ASCII error messages +-- +-- Note: this test case is known to fail if the database encoding is +-- EUC_CN, EUC_JP, EUC_KR, or EUC_TW, for lack of any equivalent to +-- U+00A0 (no-break space) in those encodings. However, testing with +-- plain ASCII data would be rather useless, so we must live with that. +SET client_encoding TO UTF8; +create or replace function error_with_nbsp() returns void language plperl as $$ + elog(ERROR, "this message contains a no-break space"); +$$; +select error_with_nbsp(); +ERROR: this message contains a no-break space at line 2. +CONTEXT: PL/Perl function "error_with_nbsp" diff --git a/src/pl/plperl/expected/plperl_elog_1.out b/src/pl/plperl/expected/plperl_elog_1.out index 0932fde2668..136e8210991 100644 --- a/src/pl/plperl/expected/plperl_elog_1.out +++ b/src/pl/plperl/expected/plperl_elog_1.out @@ -104,3 +104,16 @@ PL/Perl function "indirect_die_caller" 2 (1 row) +-- Test non-ASCII error messages +-- +-- Note: this test case is known to fail if the database encoding is +-- EUC_CN, EUC_JP, EUC_KR, or EUC_TW, for lack of any equivalent to +-- U+00A0 (no-break space) in those encodings. However, testing with +-- plain ASCII data would be rather useless, so we must live with that. +SET client_encoding TO UTF8; +create or replace function error_with_nbsp() returns void language plperl as $$ + elog(ERROR, "this message contains a no-break space"); +$$; +select error_with_nbsp(); +ERROR: this message contains a no-break space at line 2. +CONTEXT: PL/Perl function "error_with_nbsp" diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index d6ec1c4baf4..27e7022b11e 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -2876,7 +2876,7 @@ plperl_spi_exec(char *query, int limit) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3109,7 +3109,7 @@ plperl_spi_query(char *query) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3195,7 +3195,7 @@ plperl_spi_fetchrow(char *cursor) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3370,7 +3370,7 @@ plperl_spi_prepare(char *query, int argc, SV **argv) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3511,7 +3511,7 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; @@ -3640,7 +3640,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv) SPI_restore_connection(); /* Punt the error to Perl */ - croak("%s", edata->message); + croak_cstr(edata->message); /* Can't get here, but keep compiler quiet */ return NULL; diff --git a/src/pl/plperl/plperl_helpers.h b/src/pl/plperl/plperl_helpers.h index ed99194ed1e..eb08cd51518 100644 --- a/src/pl/plperl/plperl_helpers.h +++ b/src/pl/plperl/plperl_helpers.h @@ -132,4 +132,42 @@ cstr2sv(const char *str) return sv; } +/* + * croak() with specified message, which is given in the database encoding. + * + * Ideally we'd just write croak("%s", str), but plain croak() does not play + * nice with non-ASCII data. In modern Perl versions we can call cstr2sv() + * and pass the result to croak_sv(); in versions that don't have croak_sv(), + * we have to work harder. + */ +static inline void +croak_cstr(const char *str) +{ +#ifdef croak_sv + /* Use sv_2mortal() to be sure the transient SV gets freed */ + croak_sv(sv_2mortal(cstr2sv(str))); +#else + + /* + * The older way to do this is to assign a UTF8-marked value to ERRSV and + * then call croak(NULL). But if we leave it to croak() to append the + * error location, it does so too late (only after popping the stack) in + * some Perl versions. Hence, use mess() to create an SV with the error + * location info already appended. + */ + SV *errsv = get_sv("@", GV_ADD); + char *utf8_str = utf_e2u(str); + SV *ssv; + + ssv = mess("%s", utf8_str); + SvUTF8_on(ssv); + + pfree(utf8_str); + + sv_setsv(errsv, ssv); + + croak(NULL); +#endif /* croak_sv */ +} + #endif /* PL_PERL_HELPERS_H */ diff --git a/src/pl/plperl/sql/plperl_elog.sql b/src/pl/plperl/sql/plperl_elog.sql index 032fd8b8ba7..9ea1350069b 100644 --- a/src/pl/plperl/sql/plperl_elog.sql +++ b/src/pl/plperl/sql/plperl_elog.sql @@ -76,3 +76,18 @@ return $a + $b; $$; select indirect_die_caller(); + +-- Test non-ASCII error messages +-- +-- Note: this test case is known to fail if the database encoding is +-- EUC_CN, EUC_JP, EUC_KR, or EUC_TW, for lack of any equivalent to +-- U+00A0 (no-break space) in those encodings. However, testing with +-- plain ASCII data would be rather useless, so we must live with that. + +SET client_encoding TO UTF8; + +create or replace function error_with_nbsp() returns void language plperl as $$ + elog(ERROR, "this message contains a no-break space"); +$$; + +select error_with_nbsp();