aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/pl/plperl/SPI.xs2
-rw-r--r--src/pl/plperl/Util.xs2
-rw-r--r--src/pl/plperl/expected/plperl_elog.out13
-rw-r--r--src/pl/plperl/expected/plperl_elog_1.out13
-rw-r--r--src/pl/plperl/plperl.c12
-rw-r--r--src/pl/plperl/plperl_helpers.h38
-rw-r--r--src/pl/plperl/sql/plperl_elog.sql15
7 files changed, 87 insertions, 8 deletions
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 3f9449a9659..a6d35cb79c4 100644
--- a/src/pl/plperl/expected/plperl_elog.out
+++ b/src/pl/plperl/expected/plperl_elog.out
@@ -97,3 +97,16 @@ NOTICE: caught die
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 34d5d5836da..85aa460ec4c 100644
--- a/src/pl/plperl/expected/plperl_elog_1.out
+++ b/src/pl/plperl/expected/plperl_elog_1.out
@@ -97,3 +97,16 @@ NOTICE: caught die
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 296d17dbbb3..65f2d242a0f 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -3066,7 +3066,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;
@@ -3299,7 +3299,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;
@@ -3385,7 +3385,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;
@@ -3560,7 +3560,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;
@@ -3701,7 +3701,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;
@@ -3830,7 +3830,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 fab0a7ba081..f8aa06835ce 100644
--- a/src/pl/plperl/plperl_helpers.h
+++ b/src/pl/plperl/plperl_helpers.h
@@ -123,4 +123,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();
generated by cgit v1.2.3 (git 2.25.1) at 2025-06-01 12:47:48 +0000