Per discussion in [1], this patch improves error reporting in pltcl.
pltcl_error_objects.patch applies on top of the pltcl_objects_2.patch
referenced in [2].
pltcl_error_master.patch applies against current master.
[1]
http://www.postgresql.org/message-id/20160223150401.2173d...@wagner.wagner.home
[2] http://www.postgresql.org/message-id/56cce7d2.9090...@bluetreble.com
--
Jim Nasby, Data Architect, Blue Treble Consulting, Austin TX
Experts in Analytics, Data Architecture and PostgreSQL
Data in Trouble? Get it in Treble! http://BlueTreble.com
diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index d2175d5..d5c576d 100644
--- a/doc/src/sgml/pltcl.sgml
+++ b/doc/src/sgml/pltcl.sgml
@@ -775,6 +775,127 @@ CREATE EVENT TRIGGER tcl_a_snitch ON ddl_command_start
EXECUTE PROCEDURE tclsnit
</para>
</sect1>
+ <sect1 id="pltcl-error-handling">
+ <title>Error Handling in PL/Tcl</title>
+
+ <indexterm>
+ <primary>error handling</primary>
+ <secondary>in PL/Tcl</secondary>
+ </indexterm>
+
+ <para>
+ All Tcl errors that are allowed to propagate back to the top level of the
+ interpreter, that is, errors not caught within the stored procedure
+ using the Tcl <function>catch</function> command will raise a database
+ error.
+ </para>
+ <para>
+ Tcl code within or called from the stored procedure can choose to
+ raise a database error by invoking the <function>elog</function>
+ command provided by PL/Tcl or by generating an error using the Tcl
+ <function>error</function> command and not catching it with Tcl's
+ <function>catch</function> command.
+ </para>
+ <para>
+ Database errors that occur from the PL/Tcl stored procedure's
+ use of <function>spi_exec</function>, <function>spi_prepare</function>,
+ and <function>spi_execp</function> are also catchable by Tcl's
+ <function>catch</function> command.
+ </para>
+ <para>
+ Tcl provides an <varname>errorCode</varname> variable that can
+ represent additional information about the error in a form that
+ is easy for programs to interpret. The contents are in Tcl list
+ format and the first word identifies the subsystem or
+ library responsible for the error and beyond that the contents are left
+ to the individual code or library. For example if Tcl's
+ <function>open</function> command is asked to open a file that doesn't
+ exist, <varname>errorCode</varname>
+ might contain <literal>POSIX ENOENT {no such file or directory}</literal>
+ where the third element may vary by locale but the first and second
+ will not.
+ </para>
+ <para>
+ When <function>spi_exec</function>, <function>spi_prepare</function>
+ or <function>spi_execp</function> cause a database error to be raised,
+ that database eror propagates back to Tcl as a Tcl error.
+ In this case <varname>errorCode</varname> is set to a list
+ where the first element is <literal>POSTGRES</literal> followed by a
+ copious decoding of the Postgres error structure. Since fields in the
+ structure may or may not be present depending on the nature of the
+ error, how the function was invoked, etc, PL/Tcl has adopted the
+ convention that subsequent elements of the <varname>errorCode</varname>
+ list are key-value pairs where the first value is the name of the
+ field and the second is its value.
+ </para>
+ <para>
+ Fields that may be present include <varname>message</varname>,
+ <varname>detail</varname>, <varname>detail_log</varname>,
+ <varname>hint</varname>, <varname>domain</varname>,
+ <varname>context_domain</varname>, <varname>context</varname>,
+ <varname>schema</varname>, <varname>table</varname>,
+ <varname>column</varname>, <varname>datatype</varname>,
+ <varname>constraint</varname>, <varname>cursor_position</varname>,
+ <varname>internalquery</varname>, <varname>internal_position</varname>,
+ <varname>filename</varname>, <varname>lineno</varname> and
+ <varname>funcname</varname>.
+ </para>
+ <para>
+ You might find it useful to load the results into an array. Code
+ for doing that might look like
+<programlisting>
+ if {[lindex $errorCode 0] == "POSTGRES"} {
+ array set errorRow [lrange $errorCode 1 end]
+ }
+</programlisting>
+ </para>
+ <para>
+ In the example below we cause an error by attempting to
+ <command>SELECT</> from a table that doesn't exist.
+<screen>
+select tcl_eval('spi_exec "select * from foo;"');
+</screen>
+<screen>
+<computeroutput>
+ERROR: relation "foo" does not exist
+</computeroutput>
+</screen>
+ </para>
+ <para>
+ Now we examine the error code. (The double-colons explicitly
+ reference <varname>errorCode</varname> as a global variable.)
+<screen>
+select tcl_eval('join $::errorCode "\n"');
+</screen>
+<screen>
+<computeroutput>
+ tcl_eval
+-------------------------------
+ POSTGRES +
+ message +
+ relation "foo" does not exist+
+ domain +
+ postgres-9.6 +
+ context_domain +
+ postgres-9.6 +
+ cursorpos +
+ 0 +
+ internalquery +
+ select * from foo; +
+ internalpos +
+ 15 +
+ filename +
+ parse_relation.c +
+ lineno +
+ 1159 +
+ funcname +
+ parserOpenTable
+(1 row)
+</computeroutput>
+</screen>
+ </para>
+ </sect1>
+
<sect1 id="pltcl-unknown">
<title>Modules and the <function>unknown</> Command</title>
<para>
diff --git a/src/pl/tcl/expected/pltcl_setup.out
b/src/pl/tcl/expected/pltcl_setup.out
index 4183c14..0a9f9f4 100644
--- a/src/pl/tcl/expected/pltcl_setup.out
+++ b/src/pl/tcl/expected/pltcl_setup.out
@@ -542,3 +542,44 @@ 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 error handling
+CREATE OR REPLACE FUNCTION pg_temp.tcl_eval (varchar) RETURNS varchar AS $$
+eval $1
+$$ LANGUAGE pltcl;
+select pg_temp.tcl_eval('spi_exec "select * from foo;"');
+ERROR: relation "foo" does not exist
+CONTEXT: relation "foo" does not exist
+ while executing
+"spi_exec "select * from foo;""
+ ("eval" body line 1)
+ invoked from within
+"eval $1"
+ (procedure "__PLTcl_proc_16457" line 3)
+ invoked from within
+"__PLTcl_proc_16457 {spi_exec "select * from foo;"}"
+in PL/Tcl function "tcl_eval"
+select pg_temp.tcl_eval($$
+set list [lindex $::errorCode 0];
+foreach "key value" [lrange $::errorCode 1 end] {
+ if {$key == "domain" || $key == "context_domain" || $key == "lineno"}
continue;
+ lappend list $key $value
+};
+return [join $list "\n"]
+$$);
+ tcl_eval
+-------------------------------
+ POSTGRES +
+ message +
+ relation "foo" does not exist+
+ cursor_position +
+ 0 +
+ internalquery +
+ select * from foo; +
+ internal_position +
+ 15 +
+ filename +
+ parse_relation.c +
+ funcname +
+ parserOpenTable
+(1 row)
+
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index dce5d04..0f052fd 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -239,6 +239,7 @@ static void pltcl_set_tuple_values(Tcl_Interp *interp,
CONST84 char *arrayname,
int tupno, HeapTuple tuple,
TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
Tcl_DString *retval);
+static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata);
/*
@@ -1581,6 +1582,96 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
return prodesc;
}
+/**********************************************************************
+ * 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("message", -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(edata->message,
-1));
+
+ if (edata->detail)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("detail", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->detail, -1));
+ }
+ if (edata->detail_log)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("detail_log", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->detail_log, -1));
+ }
+ if (edata->hint)
+ {
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj("hint",
-1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->hint, -1));
+ }
+ if (edata->domain)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("domain", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->domain, -1));
+ }
+ if (edata->context_domain)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("context_domain", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->context_domain, -1));
+ }
+ if (edata->context)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("context", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->context, -1));
+ }
+ if (edata->schema_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("schema", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->schema_name, -1));
+ }
+ if (edata->table_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj("table",
-1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->table_name, -1));
+ }
+ if (edata->column_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("column", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->column_name, -1));
+ }
+ if (edata->datatype_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("datatype", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->datatype_name, -1));
+ }
+ if (edata->constraint_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("constraint", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->constraint_name, -1));
+ }
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("cursor_position", -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewIntObj(edata->cursorpos));
+ if (edata->internalquery)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("internalquery", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->internalquery, -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("internal_position", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewIntObj(edata->internalpos));
+ }
+ if (edata->filename)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("filename", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->filename, -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("lineno", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewIntObj(edata->lineno));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("funcname", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->funcname, -1));
+ }
+
+ Tcl_SetObjErrorCode(interp, obj);
+}
+
/**********************************************************************
* pltcl_elog() - elog() support for PLTcl
@@ -1661,6 +1752,7 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
UTF_BEGIN;
Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
UTF_END;
+ pltcl_construct_errorCode(interp, edata);
FreeErrorData(edata);
return TCL_ERROR;
@@ -1896,6 +1988,7 @@ pltcl_subtrans_abort(Tcl_Interp *interp,
UTF_BEGIN;
Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
UTF_END;
+ pltcl_construct_errorCode(interp, edata);
FreeErrorData(edata);
}
diff --git a/src/pl/tcl/sql/pltcl_setup.sql b/src/pl/tcl/sql/pltcl_setup.sql
index 8462996..f9858e2 100644
--- a/src/pl/tcl/sql/pltcl_setup.sql
+++ b/src/pl/tcl/sql/pltcl_setup.sql
@@ -577,3 +577,19 @@ drop table foo;
drop event trigger tcl_a_snitch;
drop event trigger tcl_b_snitch;
+
+
+-- test error handling
+CREATE OR REPLACE FUNCTION pg_temp.tcl_eval (varchar) RETURNS varchar AS $$
+eval $1
+$$ LANGUAGE pltcl;
+
+select pg_temp.tcl_eval('spi_exec "select * from foo;"');
+select pg_temp.tcl_eval($$
+set list [lindex $::errorCode 0];
+foreach "key value" [lrange $::errorCode 1 end] {
+ if {$key == "domain" || $key == "context_domain" || $key == "lineno"}
continue;
+ lappend list $key $value
+};
+return [join $list "\n"]
+$$);
diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index d2175d5..d5c576d 100644
--- a/doc/src/sgml/pltcl.sgml
+++ b/doc/src/sgml/pltcl.sgml
@@ -775,6 +775,127 @@ CREATE EVENT TRIGGER tcl_a_snitch ON ddl_command_start
EXECUTE PROCEDURE tclsnit
</para>
</sect1>
+ <sect1 id="pltcl-error-handling">
+ <title>Error Handling in PL/Tcl</title>
+
+ <indexterm>
+ <primary>error handling</primary>
+ <secondary>in PL/Tcl</secondary>
+ </indexterm>
+
+ <para>
+ All Tcl errors that are allowed to propagate back to the top level of the
+ interpreter, that is, errors not caught within the stored procedure
+ using the Tcl <function>catch</function> command will raise a database
+ error.
+ </para>
+ <para>
+ Tcl code within or called from the stored procedure can choose to
+ raise a database error by invoking the <function>elog</function>
+ command provided by PL/Tcl or by generating an error using the Tcl
+ <function>error</function> command and not catching it with Tcl's
+ <function>catch</function> command.
+ </para>
+ <para>
+ Database errors that occur from the PL/Tcl stored procedure's
+ use of <function>spi_exec</function>, <function>spi_prepare</function>,
+ and <function>spi_execp</function> are also catchable by Tcl's
+ <function>catch</function> command.
+ </para>
+ <para>
+ Tcl provides an <varname>errorCode</varname> variable that can
+ represent additional information about the error in a form that
+ is easy for programs to interpret. The contents are in Tcl list
+ format and the first word identifies the subsystem or
+ library responsible for the error and beyond that the contents are left
+ to the individual code or library. For example if Tcl's
+ <function>open</function> command is asked to open a file that doesn't
+ exist, <varname>errorCode</varname>
+ might contain <literal>POSIX ENOENT {no such file or directory}</literal>
+ where the third element may vary by locale but the first and second
+ will not.
+ </para>
+ <para>
+ When <function>spi_exec</function>, <function>spi_prepare</function>
+ or <function>spi_execp</function> cause a database error to be raised,
+ that database eror propagates back to Tcl as a Tcl error.
+ In this case <varname>errorCode</varname> is set to a list
+ where the first element is <literal>POSTGRES</literal> followed by a
+ copious decoding of the Postgres error structure. Since fields in the
+ structure may or may not be present depending on the nature of the
+ error, how the function was invoked, etc, PL/Tcl has adopted the
+ convention that subsequent elements of the <varname>errorCode</varname>
+ list are key-value pairs where the first value is the name of the
+ field and the second is its value.
+ </para>
+ <para>
+ Fields that may be present include <varname>message</varname>,
+ <varname>detail</varname>, <varname>detail_log</varname>,
+ <varname>hint</varname>, <varname>domain</varname>,
+ <varname>context_domain</varname>, <varname>context</varname>,
+ <varname>schema</varname>, <varname>table</varname>,
+ <varname>column</varname>, <varname>datatype</varname>,
+ <varname>constraint</varname>, <varname>cursor_position</varname>,
+ <varname>internalquery</varname>, <varname>internal_position</varname>,
+ <varname>filename</varname>, <varname>lineno</varname> and
+ <varname>funcname</varname>.
+ </para>
+ <para>
+ You might find it useful to load the results into an array. Code
+ for doing that might look like
+<programlisting>
+ if {[lindex $errorCode 0] == "POSTGRES"} {
+ array set errorRow [lrange $errorCode 1 end]
+ }
+</programlisting>
+ </para>
+ <para>
+ In the example below we cause an error by attempting to
+ <command>SELECT</> from a table that doesn't exist.
+<screen>
+select tcl_eval('spi_exec "select * from foo;"');
+</screen>
+<screen>
+<computeroutput>
+ERROR: relation "foo" does not exist
+</computeroutput>
+</screen>
+ </para>
+ <para>
+ Now we examine the error code. (The double-colons explicitly
+ reference <varname>errorCode</varname> as a global variable.)
+<screen>
+select tcl_eval('join $::errorCode "\n"');
+</screen>
+<screen>
+<computeroutput>
+ tcl_eval
+-------------------------------
+ POSTGRES +
+ message +
+ relation "foo" does not exist+
+ domain +
+ postgres-9.6 +
+ context_domain +
+ postgres-9.6 +
+ cursorpos +
+ 0 +
+ internalquery +
+ select * from foo; +
+ internalpos +
+ 15 +
+ filename +
+ parse_relation.c +
+ lineno +
+ 1159 +
+ funcname +
+ parserOpenTable
+(1 row)
+</computeroutput>
+</screen>
+ </para>
+ </sect1>
+
<sect1 id="pltcl-unknown">
<title>Modules and the <function>unknown</> Command</title>
<para>
diff --git a/src/pl/tcl/expected/pltcl_setup.out
b/src/pl/tcl/expected/pltcl_setup.out
index 4183c14..0a9f9f4 100644
--- a/src/pl/tcl/expected/pltcl_setup.out
+++ b/src/pl/tcl/expected/pltcl_setup.out
@@ -542,3 +542,44 @@ 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 error handling
+CREATE OR REPLACE FUNCTION pg_temp.tcl_eval (varchar) RETURNS varchar AS $$
+eval $1
+$$ LANGUAGE pltcl;
+select pg_temp.tcl_eval('spi_exec "select * from foo;"');
+ERROR: relation "foo" does not exist
+CONTEXT: relation "foo" does not exist
+ while executing
+"spi_exec "select * from foo;""
+ ("eval" body line 1)
+ invoked from within
+"eval $1"
+ (procedure "__PLTcl_proc_16457" line 3)
+ invoked from within
+"__PLTcl_proc_16457 {spi_exec "select * from foo;"}"
+in PL/Tcl function "tcl_eval"
+select pg_temp.tcl_eval($$
+set list [lindex $::errorCode 0];
+foreach "key value" [lrange $::errorCode 1 end] {
+ if {$key == "domain" || $key == "context_domain" || $key == "lineno"}
continue;
+ lappend list $key $value
+};
+return [join $list "\n"]
+$$);
+ tcl_eval
+-------------------------------
+ POSTGRES +
+ message +
+ relation "foo" does not exist+
+ cursor_position +
+ 0 +
+ internalquery +
+ select * from foo; +
+ internal_position +
+ 15 +
+ filename +
+ parse_relation.c +
+ funcname +
+ parserOpenTable
+(1 row)
+
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index aceb498..98af5ef 100644
--- a/src/pl/tcl/pltcl.c
+++ b/src/pl/tcl/pltcl.c
@@ -234,6 +234,7 @@ static void pltcl_set_tuple_values(Tcl_Interp *interp,
CONST84 char *arrayname,
int tupno, HeapTuple tuple,
TupleDesc tupdesc);
static void pltcl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc,
Tcl_Obj * retobj);
+static void pltcl_construct_errorCode(Tcl_Interp *interp, ErrorData *edata);
/*
@@ -1606,6 +1607,96 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid,
return prodesc;
}
+/**********************************************************************
+ * 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("message", -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(edata->message,
-1));
+
+ if (edata->detail)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("detail", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->detail, -1));
+ }
+ if (edata->detail_log)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("detail_log", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->detail_log, -1));
+ }
+ if (edata->hint)
+ {
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj("hint",
-1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->hint, -1));
+ }
+ if (edata->domain)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("domain", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->domain, -1));
+ }
+ if (edata->context_domain)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("context_domain", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->context_domain, -1));
+ }
+ if (edata->context)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("context", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->context, -1));
+ }
+ if (edata->schema_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("schema", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->schema_name, -1));
+ }
+ if (edata->table_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj("table",
-1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->table_name, -1));
+ }
+ if (edata->column_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("column", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->column_name, -1));
+ }
+ if (edata->datatype_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("datatype", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->datatype_name, -1));
+ }
+ if (edata->constraint_name)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("constraint", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->constraint_name, -1));
+ }
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("cursor_position", -1));
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewIntObj(edata->cursorpos));
+ if (edata->internalquery)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("internalquery", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->internalquery, -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("internal_position", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewIntObj(edata->internalpos));
+ }
+ if (edata->filename)
+ {
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("filename", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->filename, -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("lineno", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewIntObj(edata->lineno));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj("funcname", -1));
+ Tcl_ListObjAppendElement(interp, obj,
Tcl_NewStringObj(edata->funcname, -1));
+ }
+
+ Tcl_SetObjErrorCode(interp, obj);
+}
+
/**********************************************************************
* pltcl_elog() - elog() support for PLTcl
@@ -1684,6 +1775,7 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
UTF_BEGIN;
Tcl_SetObjResult(interp,
Tcl_NewStringObj(UTF_E2U(edata->message), -1));
UTF_END;
+ pltcl_construct_errorCode(interp, edata);
FreeErrorData(edata);
return TCL_ERROR;
@@ -1916,6 +2008,7 @@ pltcl_subtrans_abort(Tcl_Interp *interp,
UTF_BEGIN;
Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
UTF_END;
+ pltcl_construct_errorCode(interp, edata);
FreeErrorData(edata);
}
diff --git a/src/pl/tcl/sql/pltcl_setup.sql b/src/pl/tcl/sql/pltcl_setup.sql
index 8462996..f9858e2 100644
--- a/src/pl/tcl/sql/pltcl_setup.sql
+++ b/src/pl/tcl/sql/pltcl_setup.sql
@@ -577,3 +577,19 @@ drop table foo;
drop event trigger tcl_a_snitch;
drop event trigger tcl_b_snitch;
+
+
+-- test error handling
+CREATE OR REPLACE FUNCTION pg_temp.tcl_eval (varchar) RETURNS varchar AS $$
+eval $1
+$$ LANGUAGE pltcl;
+
+select pg_temp.tcl_eval('spi_exec "select * from foo;"');
+select pg_temp.tcl_eval($$
+set list [lindex $::errorCode 0];
+foreach "key value" [lrange $::errorCode 1 end] {
+ if {$key == "domain" || $key == "context_domain" || $key == "lineno"}
continue;
+ lappend list $key $value
+};
+return [join $list "\n"]
+$$);
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
