From fb8d2a7f57d87102f0a95025fbf1cad9c341739b Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Fri, 25 Mar 2016 15:52:53 -0400 Subject: [PATCH] In PL/Tcl, make database errors return additional info in the errorCode. Tcl has a convention for returning additional info about an error in a global variable named errorCode. Up to now PL/Tcl has ignored that, but this patch causes database errors caught by PL/Tcl to fill in errorCode with useful information from the ErrorData struct. Jim Nasby, reviewed by Pavel Stehule and myself --- doc/src/sgml/pltcl.sgml | 74 +++++++++++++- src/pl/tcl/expected/pltcl_setup.out | 28 ++++++ src/pl/tcl/pltcl.c | 151 +++++++++++++++++++++++++++- src/pl/tcl/sql/pltcl_setup.sql | 24 +++++ 4 files changed, 272 insertions(+), 5 deletions(-) diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml index d2175d552e..1ff9b96fa5 100644 --- a/doc/src/sgml/pltcl.sgml +++ b/doc/src/sgml/pltcl.sgml @@ -507,8 +507,9 @@ SELECT 'doesn''t' AS ret written to the server log, or both is controlled by the and configuration - variables. See for more - information. + variables. See + and + for more information. @@ -775,6 +776,75 @@ CREATE EVENT TRIGGER tcl_a_snitch ON ddl_command_start EXECUTE PROCEDURE tclsnit + + Error Handling in PL/Tcl + + + exceptions + in PL/Tcl + + + + Tcl code within or called from a PL/Tcl function can raise an error, + either by executing some invalid operation or by generating an error + using the Tcl error command or + PL/Tcl's elog command. Such errors can be caught + within Tcl using the Tcl catch command. If they + are not caught but are allowed to propagate out to the top level of + execution of the PL/Tcl function, they turn into database errors. + + + + Conversely, database errors that occur within PL/Tcl's + spi_exec, spi_prepare, + and spi_execp commands are reported as Tcl errors, + so they are catchable by Tcl's catch command. + Again, if they propagate out to the top level without being caught, + they turn back into database errors. + + + + Tcl provides an errorCode variable that can represent + additional information about an error in a form that is easy for Tcl + programs to interpret. The contents are in Tcl list format, and the + first word identifies the subsystem or library reporting the error; + beyond that the contents are left to the individual subsystem or + library. For database errors reported by PL/Tcl commands, the first + 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 that may be present include + detail, hint, context, + schema, table, column, + datatype, constraint, + statement, cursor_position, + filename, lineno and + funcname. + + + + A convenient way to work with PL/Tcl's errorCode + information is to load it into an array, so that the field names become + array subscripts. Code for doing that might look like + +if {[catch { spi_exec $sql_command }]} { + if {[lindex $::errorCode 0] == "POSTGRES"} { + array set errorArray $::errorCode + if {$errorArray(SQLSTATE) == "42P01"} { # UNDEFINED_TABLE + # deal with missing table + } else { + # deal with some other type of SQL error + } + } +} + + (The double colons explicitly specify that errorCode + is a global variable.) + + + Modules and the <function>unknown</> Command diff --git a/src/pl/tcl/expected/pltcl_setup.out b/src/pl/tcl/expected/pltcl_setup.out index e11718c64b..807a6a3a94 100644 --- a/src/pl/tcl/expected/pltcl_setup.out +++ b/src/pl/tcl/expected/pltcl_setup.out @@ -555,3 +555,31 @@ NOTICE: tclsnitch: ddl_command_start DROP TABLE NOTICE: tclsnitch: ddl_command_end DROP TABLE drop event trigger tcl_a_snitch; drop event trigger tcl_b_snitch; +-- test use of errorCode in error handling +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"} { + return "expected error: $errArray(message)" + } else { + return "unexpected error: $errArray(SQLSTATE) $errArray(message)" + } + } else { + return "no error" + } +$$ language pltcl; +select tcl_error_handling_test(); + tcl_error_handling_test +----------------------------------------------- + expected error: relation "foo" does not exist +(1 row) + +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 +(1 row) + +drop table foo; diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 5b27c731b6..b1d66e31a6 100644 --- a/src/pl/tcl/pltcl.c +++ b/src/pl/tcl/pltcl.c @@ -212,6 +212,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 int pltcl_quote(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, @@ -1648,7 +1649,8 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp, edata = CopyErrorData(); FlushErrorState(); - /* Pass the error message to Tcl */ + /* Pass the error data to Tcl */ + pltcl_construct_errorCode(interp, edata); UTF_BEGIN; Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); UTF_END; @@ -1662,6 +1664,148 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp, } +/********************************************************************** + * pltcl_construct_errorCode() - construct a Tcl errorCode + * list with detailed information from the PostgreSQL server + **********************************************************************/ +static void +pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata) +{ + Tcl_Obj *obj = Tcl_NewObj(); + + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("POSTGRES", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(PG_VERSION, -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("SQLSTATE", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(unpack_sql_state(edata->sqlerrcode), -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("message", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->message), -1)); + UTF_END; + if (edata->detail) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("detail", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->detail), -1)); + UTF_END; + } + if (edata->hint) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("hint", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->hint), -1)); + UTF_END; + } + if (edata->context) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("context", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->context), -1)); + UTF_END; + } + if (edata->schema_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("schema", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->schema_name), -1)); + UTF_END; + } + if (edata->table_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("table", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->table_name), -1)); + UTF_END; + } + if (edata->column_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("column", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->column_name), -1)); + UTF_END; + } + if (edata->datatype_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("datatype", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->datatype_name), -1)); + UTF_END; + } + if (edata->constraint_name) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("constraint", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->constraint_name), -1)); + UTF_END; + } + /* cursorpos is never interesting here; report internal query/pos */ + if (edata->internalquery) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("statement", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->internalquery), -1)); + UTF_END; + } + if (edata->internalpos > 0) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("cursor_position", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewIntObj(edata->internalpos)); + } + if (edata->filename) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("filename", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->filename), -1)); + UTF_END; + } + if (edata->lineno > 0) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("lineno", -1)); + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewIntObj(edata->lineno)); + } + if (edata->funcname) + { + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj("funcname", -1)); + UTF_BEGIN; + Tcl_ListObjAppendElement(interp, obj, + Tcl_NewStringObj(UTF_E2U(edata->funcname), -1)); + UTF_END; + } + + Tcl_SetObjErrorCode(interp, obj); +} + + /********************************************************************** * pltcl_quote() - quote literal strings that are to * be used in SPI_execute query strings @@ -1880,9 +2024,10 @@ pltcl_subtrans_abort(Tcl_Interp *interp, */ SPI_restore_connection(); - /* Pass the error message to Tcl */ + /* Pass the error data to Tcl */ + pltcl_construct_errorCode(interp, edata); UTF_BEGIN; - Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE); + Tcl_SetObjResult(interp, Tcl_NewStringObj(UTF_E2U(edata->message), -1)); UTF_END; FreeErrorData(edata); } diff --git a/src/pl/tcl/sql/pltcl_setup.sql b/src/pl/tcl/sql/pltcl_setup.sql index 53358ea361..36d9ef8539 100644 --- a/src/pl/tcl/sql/pltcl_setup.sql +++ b/src/pl/tcl/sql/pltcl_setup.sql @@ -595,3 +595,27 @@ drop table foo; drop event trigger tcl_a_snitch; drop event trigger tcl_b_snitch; + +-- test use of errorCode in error handling + +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"} { + return "expected error: $errArray(message)" + } else { + return "unexpected error: $errArray(SQLSTATE) $errArray(message)" + } + } else { + return "no error" + } +$$ language pltcl; + +select tcl_error_handling_test(); + +create temp table foo(f1 int); + +select tcl_error_handling_test(); + +drop table foo;