Improve PL/Tcl errorCode facility by providing decoded name for SQLSTATE.

We don't really want to encourage people to write numeric SQLSTATEs in
programs; that's unreadable and error-prone.  Copy plpgsql's infrastructure
for converting between SQLSTATEs and exception names shown in Appendix A,
and modify examples in tests and documentation to do it that way.

doc/src/sgml/pltcl.sgml

@@ -813,14 +813,16 @@ CREATE EVENT TRIGGER tcl_a_snitch ON ddl_command_start EXECUTE PROCEDURE tclsnit
      word is <literal>POSTGRES</literal>, the second word is the Postgres
      version number, and additional words are field name/value pairs
      providing detailed information about the error.
-     Fields <varname>message</> and <varname>SQLSTATE</> (the error code
-     shown in <xref linkend="errcodes-appendix">) are always supplied.
+     Fields <varname>SQLSTATE</>, <varname>condition</>,
+     and <varname>message</> are always supplied
+     (the first two represent the error code and condition name as shown
+     in <xref linkend="errcodes-appendix">).
      Fields that may be present include
      <varname>detail</>, <varname>hint</>, <varname>context</>,
      <varname>schema</>, <varname>table</>, <varname>column</>,
      <varname>datatype</>, <varname>constraint</>,
      <varname>statement</>, <varname>cursor_position</>,
-     <varname>filename</>, <varname>lineno</> and
+     <varname>filename</>, <varname>lineno</>, and
      <varname>funcname</>.
     </para>
 
@@ -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

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
 #

src/pl/tcl/.gitignore

@@ -1,3 +1,5 @@
+/pltclerrcodes.h
+
 # Generated subdirectories
 /log/
 /results/

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

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;

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;

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

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"

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'))