diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index 1ff9b96fa5..805cc89dc9 100644
--- a/doc/src/sgml/pltcl.sgml
+++ b/doc/src/sgml/pltcl.sgml
@@ -813,14 +813,16 @@ CREATE EVENT TRIGGER tcl_a_snitch ON ddl_command_start EXECUTE PROCEDURE tclsnit
word is POSTGRES, the second word is the Postgres
version number, and additional words are field name/value pairs
providing detailed information about the error.
- Fields message> and SQLSTATE> (the error code
- shown in ) are always supplied.
+ Fields SQLSTATE>, condition>,
+ and message> are always supplied
+ (the first two represent the error code and condition name as shown
+ in ).
Fields that may be present include
detail>, hint>, context>,
schema>, table>, column>,
datatype>, constraint>,
statement>, cursor_position>,
- filename>, lineno> and
+ filename>, lineno>, and
funcname>.
@@ -832,7 +834,7 @@ CREATE EVENT TRIGGER tcl_a_snitch ON ddl_command_start EXECUTE PROCEDURE tclsnit
if {[catch { spi_exec $sql_command }]} {
if {[lindex $::errorCode 0] == "POSTGRES"} {
array set errorArray $::errorCode
- if {$errorArray(SQLSTATE) == "42P01"} { # UNDEFINED_TABLE
+ if {$errorArray(condition) == "undefined_table"} {
# deal with missing table
} else {
# deal with some other type of SQL error
diff --git a/src/backend/utils/errcodes.txt b/src/backend/utils/errcodes.txt
index 1a920e8bd2..49494f9cd3 100644
--- a/src/backend/utils/errcodes.txt
+++ b/src/backend/utils/errcodes.txt
@@ -15,6 +15,9 @@
# src/pl/plpgsql/src/plerrcodes.h
# a list of PL/pgSQL condition names and their SQLSTATE codes
#
+# src/pl/tcl/pltclerrcodes.h
+# the same, for PL/Tcl
+#
# doc/src/sgml/errcodes-list.sgml
# a SGML table of error codes for inclusion in the documentation
#
diff --git a/src/pl/tcl/.gitignore b/src/pl/tcl/.gitignore
index 5dcb3ff972..62b62eb459 100644
--- a/src/pl/tcl/.gitignore
+++ b/src/pl/tcl/.gitignore
@@ -1,3 +1,5 @@
+/pltclerrcodes.h
+
# Generated subdirectories
/log/
/results/
diff --git a/src/pl/tcl/Makefile b/src/pl/tcl/Makefile
index eb5c8a2de2..d77b7b95f2 100644
--- a/src/pl/tcl/Makefile
+++ b/src/pl/tcl/Makefile
@@ -13,7 +13,6 @@ include $(top_builddir)/src/Makefile.global
override CPPFLAGS := $(TCL_INCLUDE_SPEC) $(CPPFLAGS)
-
# On Windows, we don't link directly with the Tcl library; see below
ifneq ($(PORTNAME), win32)
SHLIB_LINK = $(TCL_LIB_SPEC) $(TCL_LIBS) -lc
@@ -56,6 +55,14 @@ include $(top_srcdir)/src/Makefile.shlib
all: all-lib
$(MAKE) -C modules $@
+# Force this dependency to be known even without dependency info built:
+pltcl.o: pltclerrcodes.h
+
+# generate pltclerrcodes.h from src/backend/utils/errcodes.txt
+pltclerrcodes.h: $(top_srcdir)/src/backend/utils/errcodes.txt generate-pltclerrcodes.pl
+ $(PERL) $(srcdir)/generate-pltclerrcodes.pl $< > $@
+
+distprep: pltclerrcodes.h
install: all install-lib install-data
$(MAKE) -C modules $@
@@ -86,10 +93,14 @@ installcheck: submake
submake:
$(MAKE) -C $(top_builddir)/src/test/regress pg_regress$(X)
-clean distclean maintainer-clean: clean-lib
+# pltclerrcodes.h is in the distribution tarball, so don't clean it here.
+clean distclean: clean-lib
rm -f $(OBJS)
rm -rf $(pg_regress_clean_files)
ifeq ($(PORTNAME), win32)
rm -f $(tclwithver).def
endif
$(MAKE) -C modules $@
+
+maintainer-clean: distclean
+ rm -f pltclerrcodes.h
diff --git a/src/pl/tcl/expected/pltcl_setup.out b/src/pl/tcl/expected/pltcl_setup.out
index 807a6a3a94..e65e9e3ff7 100644
--- a/src/pl/tcl/expected/pltcl_setup.out
+++ b/src/pl/tcl/expected/pltcl_setup.out
@@ -560,10 +560,10 @@ create function tcl_error_handling_test() returns text as $$
global errorCode
if {[catch { spi_exec "select no_such_column from foo;" }]} {
array set errArray $errorCode
- if {$errArray(SQLSTATE) == "42P01"} {
+ if {$errArray(condition) == "undefined_table"} {
return "expected error: $errArray(message)"
} else {
- return "unexpected error: $errArray(SQLSTATE) $errArray(message)"
+ return "unexpected error: $errArray(condition) $errArray(message)"
}
} else {
return "no error"
@@ -577,9 +577,9 @@ select tcl_error_handling_test();
create temp table foo(f1 int);
select tcl_error_handling_test();
- tcl_error_handling_test
-----------------------------------------------------------------
- unexpected error: 42703 column "no_such_column" does not exist
+ tcl_error_handling_test
+---------------------------------------------------------------------------
+ unexpected error: undefined_column column "no_such_column" does not exist
(1 row)
drop table foo;
diff --git a/src/pl/tcl/generate-pltclerrcodes.pl b/src/pl/tcl/generate-pltclerrcodes.pl
new file mode 100644
index 0000000000..144e159909
--- /dev/null
+++ b/src/pl/tcl/generate-pltclerrcodes.pl
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+#
+# Generate the pltclerrcodes.h header from errcodes.txt
+# Copyright (c) 2000-2016, PostgreSQL Global Development Group
+
+use warnings;
+use strict;
+
+print
+ "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
+print "/* there is deliberately not an #ifndef PLTCLERRCODES_H here */\n";
+
+open my $errcodes, $ARGV[0] or die;
+
+while (<$errcodes>)
+{
+ chomp;
+
+ # Skip comments
+ next if /^#/;
+ next if /^\s*$/;
+
+ # Skip section headers
+ next if /^Section:/;
+
+ die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
+
+ (my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
+ ($1, $2, $3, $4);
+
+ # Skip non-errors
+ next unless $type eq 'E';
+
+ # Skip lines without PL/pgSQL condition names
+ next unless defined($condition_name);
+
+ print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n";
+}
+
+close $errcodes;
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index b1d66e31a6..6ee4153ae6 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -188,6 +188,20 @@ static HTAB *pltcl_proc_htab = NULL;
static FunctionCallInfo pltcl_current_fcinfo = NULL;
static pltcl_proc_desc *pltcl_current_prodesc = NULL;
+/**********************************************************************
+ * Lookup table for SQLSTATE condition names
+ **********************************************************************/
+typedef struct
+{
+ const char *label;
+ int sqlerrstate;
+} TclExceptionNameMap;
+
+static const TclExceptionNameMap exception_name_map[] = {
+#include "pltclerrcodes.h" /* pgrminclude ignore */
+ {NULL, 0}
+};
+
/**********************************************************************
* Forward declarations
**********************************************************************/
@@ -213,6 +227,7 @@ static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid,
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata);
+static const char *pltcl_get_condition_name(int sqlstate);
static int pltcl_quote(ClientData cdata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
@@ -1681,6 +1696,10 @@ pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata)
Tcl_NewStringObj("SQLSTATE", -1));
Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(unpack_sql_state(edata->sqlerrcode), -1));
+ Tcl_ListObjAppendElement(interp, obj,
+ Tcl_NewStringObj("condition", -1));
+ Tcl_ListObjAppendElement(interp, obj,
+ Tcl_NewStringObj(pltcl_get_condition_name(edata->sqlerrcode), -1));
Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("message", -1));
UTF_BEGIN;
@@ -1806,6 +1825,23 @@ pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata)
}
+/**********************************************************************
+ * pltcl_get_condition_name() - find name for SQLSTATE
+ **********************************************************************/
+static const char *
+pltcl_get_condition_name(int sqlstate)
+{
+ int i;
+
+ for (i = 0; exception_name_map[i].label != NULL; i++)
+ {
+ if (exception_name_map[i].sqlerrstate == sqlstate)
+ return exception_name_map[i].label;
+ }
+ return "unrecognized_sqlstate";
+}
+
+
/**********************************************************************
* pltcl_quote() - quote literal strings that are to
* be used in SPI_execute query strings
diff --git a/src/pl/tcl/sql/pltcl_setup.sql b/src/pl/tcl/sql/pltcl_setup.sql
index 36d9ef8539..8df65a5816 100644
--- a/src/pl/tcl/sql/pltcl_setup.sql
+++ b/src/pl/tcl/sql/pltcl_setup.sql
@@ -602,10 +602,10 @@ create function tcl_error_handling_test() returns text as $$
global errorCode
if {[catch { spi_exec "select no_such_column from foo;" }]} {
array set errArray $errorCode
- if {$errArray(SQLSTATE) == "42P01"} {
+ if {$errArray(condition) == "undefined_table"} {
return "expected error: $errArray(message)"
} else {
- return "unexpected error: $errArray(SQLSTATE) $errArray(message)"
+ return "unexpected error: $errArray(condition) $errArray(message)"
}
} else {
return "no error"
diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm
index 60bcd7e7e6..ac1ba0a9f7 100644
--- a/src/tools/msvc/Solution.pm
+++ b/src/tools/msvc/Solution.pm
@@ -350,6 +350,17 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
);
}
+ if ($self->{options}->{tcl}
+ && IsNewer(
+ 'src/pl/tcl/pltclerrcodes.h',
+ 'src/backend/utils/errcodes.txt'))
+ {
+ print "Generating pltclerrcodes.h...\n";
+ system(
+'perl src/pl/tcl/generate-pltclerrcodes.pl src/backend/utils/errcodes.txt > src/pl/tcl/pltclerrcodes.h'
+ );
+ }
+
if (IsNewer(
'src/backend/utils/sort/qsort_tuple.c',
'src/backend/utils/sort/gen_qsort_tuple.pl'))