From cd37bb78599dcf24cd22a124ce9174b5e2a76880 Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Fri, 25 Mar 2016 16:54:52 -0400 Subject: [PATCH] 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 | 10 ++++--- src/backend/utils/errcodes.txt | 3 +++ src/pl/tcl/.gitignore | 2 ++ src/pl/tcl/Makefile | 15 +++++++++-- src/pl/tcl/expected/pltcl_setup.out | 10 +++---- src/pl/tcl/generate-pltclerrcodes.pl | 40 ++++++++++++++++++++++++++++ src/pl/tcl/pltcl.c | 36 +++++++++++++++++++++++++ src/pl/tcl/sql/pltcl_setup.sql | 4 +-- src/tools/msvc/Solution.pm | 11 ++++++++ 9 files changed, 118 insertions(+), 13 deletions(-) create mode 100644 src/pl/tcl/generate-pltclerrcodes.pl 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')) -- 2.40.0