From 961bed0208912a929a47c5a30190ff76748f3a03 Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Mon, 9 Jan 2017 10:10:08 -0500 Subject: [PATCH] Expand the regression tests for PL/Tcl. This raises the test coverage (by line count) in pltcl.c from about 70% to 86%. Karl Lehenbauer and Jim Nasby Discussion: https://postgr.es/m/92a1670d-21b6-8f03-9c13-e4fb2207ab7b@BlueTreble.com --- src/pl/tcl/expected/pltcl_queries.out | 336 ++++++++++++++++++++++++-- src/pl/tcl/expected/pltcl_setup.out | 150 +++++++++--- src/pl/tcl/sql/pltcl_queries.sql | 112 ++++++++- src/pl/tcl/sql/pltcl_setup.sql | 145 +++++++++-- 4 files changed, 654 insertions(+), 89 deletions(-) diff --git a/src/pl/tcl/expected/pltcl_queries.out b/src/pl/tcl/expected/pltcl_queries.out index 3a9fef3447..7300b315d6 100644 --- a/src/pl/tcl/expected/pltcl_queries.out +++ b/src/pl/tcl/expected/pltcl_queries.out @@ -185,12 +185,23 @@ select * from T_pkey2 order by key1 using @<, key2 collate "C"; -- show dump of trigger data insert into trigger_test values(1,'insert'); -NOTICE: NEW: {i: 1, v: insert} +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +NOTICE: NEW: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: insert} NOTICE: OLD: {} NOTICE: TG_level: ROW NOTICE: TG_name: show_trigger_data_trig NOTICE: TG_op: INSERT -NOTICE: TG_relatts: {{} i v} +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} NOTICE: TG_relid: bogus:12345 NOTICE: TG_table_name: trigger_test NOTICE: TG_table_schema: public @@ -232,13 +243,37 @@ NOTICE: TG_table_name: trigger_test_view NOTICE: TG_table_schema: public NOTICE: TG_when: {INSTEAD OF} NOTICE: args: {24 {skidoo view}} +update trigger_test set v = 'update', test_skip=true where i = 1; +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: UPDATE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +NOTICE: SKIPPING OPERATION UPDATE update trigger_test set v = 'update' where i = 1; -NOTICE: NEW: {i: 1, v: update} -NOTICE: OLD: {i: 1, v: insert} +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: UPDATE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +NOTICE: NEW: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: update} +NOTICE: OLD: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: insert} NOTICE: TG_level: ROW NOTICE: TG_name: show_trigger_data_trig NOTICE: TG_op: UPDATE -NOTICE: TG_relatts: {{} i v} +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} NOTICE: TG_relid: bogus:12345 NOTICE: TG_table_name: trigger_test NOTICE: TG_table_schema: public @@ -246,16 +281,39 @@ NOTICE: TG_when: BEFORE NOTICE: args: {23 skidoo} delete from trigger_test; NOTICE: NEW: {} -NOTICE: OLD: {i: 1, v: update} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: DELETE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +NOTICE: NEW: {} +NOTICE: OLD: {i: 1, test_argisnull: f, test_return_null: f, test_skip: f, v: update} NOTICE: TG_level: ROW NOTICE: TG_name: show_trigger_data_trig NOTICE: TG_op: DELETE -NOTICE: TG_relatts: {{} i v} +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} NOTICE: TG_relid: bogus:12345 NOTICE: TG_table_name: trigger_test NOTICE: TG_table_schema: public NOTICE: TG_when: BEFORE NOTICE: args: {23 skidoo} +truncate trigger_test; +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: TRUNCATE +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} -- Test composite-type arguments select tcl_composite_arg_ref1(row('tkey', 42, 'ref2')); tcl_composite_arg_ref1 @@ -288,6 +346,22 @@ select tcl_argisnull(null); t (1 row) +-- should error +insert into trigger_test(test_argisnull) values(true); +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +ERROR: argisnull cannot be used in triggers +select trigger_data(); +ERROR: trigger functions can only be called as triggers -- Test spi_lastoid primitive create temp table t1 (f1 int); select tcl_lastoid('t1'); @@ -304,14 +378,14 @@ select tcl_lastoid('t2') > 0; (1 row) -- test some error cases -CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl; -SELECT tcl_error(); +create function tcl_error(out a int, out b int) as $$return {$$ language pltcl; +select tcl_error(); ERROR: missing close-brace -CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ LANGUAGE pltcl; -SELECT bad_record(); +create function bad_record(out a text, out b text) as $$return [list a]$$ language pltcl; +select bad_record(); ERROR: column name/value list must have even number of elements -CREATE FUNCTION bad_field(OUT a text, OUT b text) AS $$return [list a 1 b 2 cow 3]$$ LANGUAGE pltcl; -SELECT bad_field(); +create function bad_field(out a text, out b text) as $$return [list a 1 b 2 cow 3]$$ language pltcl; +select bad_field(); ERROR: column name/value list contains nonexistent column name "cow" -- test compound return select * from tcl_test_cube_squared(5); @@ -351,16 +425,238 @@ select 1, tcl_test_sequence(0,5); 1 | 4 (5 rows) -CREATE FUNCTION non_srf() RETURNS int AS $$return_next 1$$ LANGUAGE pltcl; +create function non_srf() returns int as $$return_next 1$$ language pltcl; select non_srf(); ERROR: return_next cannot be used in non-set-returning functions -CREATE FUNCTION bad_record_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$ +create function bad_record_srf(out a text, out b text) returns setof record as $$ return_next [list a] -$$ LANGUAGE pltcl; -SELECT bad_record_srf(); +$$ language pltcl; +select bad_record_srf(); ERROR: column name/value list must have even number of elements -CREATE FUNCTION bad_field_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$ +create function bad_field_srf(out a text, out b text) returns setof record as $$ return_next [list a 1 b 2 cow 3] -$$ LANGUAGE pltcl; -SELECT bad_field_srf(); +$$ language pltcl; +select bad_field_srf(); ERROR: column name/value list contains nonexistent column name "cow" +-- test quote +select tcl_eval('quote foo bar'); +ERROR: wrong # args: should be "quote string" +select tcl_eval('quote [format %c 39]'); + tcl_eval +---------- + '' +(1 row) + +select tcl_eval('quote [format %c 92]'); + tcl_eval +---------- + \\ +(1 row) + +-- Test argisnull +select tcl_eval('argisnull'); +ERROR: wrong # args: should be "argisnull argno" +select tcl_eval('argisnull 14'); +ERROR: argno out of range +select tcl_eval('argisnull abc'); +ERROR: expected integer but got "abc" +-- Test return_null +select tcl_eval('return_null 14'); +ERROR: wrong # args: should be "return_null " +-- should error +insert into trigger_test(test_return_null) values(true); +NOTICE: NEW: {} +NOTICE: OLD: {} +NOTICE: TG_level: STATEMENT +NOTICE: TG_name: statement_trigger +NOTICE: TG_op: INSERT +NOTICE: TG_relatts: {{} i v {} test_skip test_return_null test_argisnull} +NOTICE: TG_relid: bogus:12345 +NOTICE: TG_table_name: trigger_test +NOTICE: TG_table_schema: public +NOTICE: TG_when: BEFORE +NOTICE: args: {42 {statement trigger}} +ERROR: return_null cannot be used in triggers +-- Test spi_exec +select tcl_eval('spi_exec'); +ERROR: wrong # args: should be "spi_exec ?-count n? ?-array name? query ?loop body?" +select tcl_eval('spi_exec -count'); +ERROR: missing argument to -count or -array +select tcl_eval('spi_exec -array'); +ERROR: missing argument to -count or -array +select tcl_eval('spi_exec -count abc'); +ERROR: expected integer but got "abc" +select tcl_eval('spi_exec query loop body toomuch'); +ERROR: wrong # args: should be "query ?loop body?" +select tcl_eval('spi_exec "begin; rollback;"'); +ERROR: pltcl: SPI_execute failed: SPI_ERROR_TRANSACTION +-- Test spi_execp +select tcl_eval('spi_execp'); +ERROR: missing argument to -count or -array +select tcl_eval('spi_execp -count'); +ERROR: missing argument to -array, -count or -nulls +select tcl_eval('spi_execp -array'); +ERROR: missing argument to -array, -count or -nulls +select tcl_eval('spi_execp -count abc'); +ERROR: expected integer but got "abc" +select tcl_eval('spi_execp -nulls'); +ERROR: missing argument to -array, -count or -nulls +select tcl_eval('spi_execp ""'); +ERROR: invalid queryid '' +-- test spi_prepare +select tcl_eval('spi_prepare'); +ERROR: wrong # args: should be "spi_prepare query argtypes" +select tcl_eval('spi_prepare a b'); +ERROR: type "b" does not exist +select tcl_eval('spi_prepare a "b {"'); +ERROR: unmatched open brace in list +select tcl_error_handling_test($tcl$spi_prepare "select moo" []$tcl$); + tcl_error_handling_test +-------------------------------------- + SQLSTATE: 42703 + + condition: undefined_column + + cursor_position: 8 + + message: column "moo" does not exist+ + statement: select moo +(1 row) + +-- test full error text +select tcl_error_handling_test($tcl$ +spi_exec "DO $$ +BEGIN +RAISE 'my message' + USING HINT = 'my hint' + , DETAIL = 'my detail' + , SCHEMA = 'my schema' + , TABLE = 'my table' + , COLUMN = 'my column' + , CONSTRAINT = 'my constraint' + , DATATYPE = 'my datatype' +; +END$$;" +$tcl$); + tcl_error_handling_test +-------------------------------------------------------------- + SQLSTATE: P0001 + + column: my column + + condition: raise_exception + + constraint: my constraint + + context: PL/pgSQL function inline_code_block line 3 at RAISE+ + SQL statement "DO $$ + + BEGIN + + RAISE 'my message' + + USING HINT = 'my hint' + + , DETAIL = 'my detail' + + , SCHEMA = 'my schema' + + , TABLE = 'my table' + + , COLUMN = 'my column' + + , CONSTRAINT = 'my constraint' + + , DATATYPE = 'my datatype' + + ; + + END$$;" + + datatype: my datatype + + detail: my detail + + hint: my hint + + message: my message + + schema: my schema + + table: my table +(1 row) + +-- verify tcl_error_handling_test() properly reports non-postgres errors +select tcl_error_handling_test('moo'); + tcl_error_handling_test +---------------------------- + invalid command name "moo" +(1 row) + +-- test elog +select tcl_eval('elog'); +ERROR: wrong # args: should be "elog level msg" +select tcl_eval('elog foo bar'); +ERROR: bad priority "foo": must be DEBUG, LOG, INFO, NOTICE, WARNING, ERROR, or FATAL +-- test forced error +select tcl_eval('error "forced error"'); +ERROR: forced error +-- test loop control in spi_exec[p] +select tcl_spi_exec(true, 'break'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: break +NOTICE: end of function + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(true, 'continue'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: continue +NOTICE: col1 3, col2 baz +NOTICE: end of function + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(true, 'error'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: error +ERROR: error message +select tcl_spi_exec(true, 'return'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: return + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(false, 'break'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: break +NOTICE: end of function + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(false, 'continue'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: continue +NOTICE: col1 3, col2 baz +NOTICE: end of function + tcl_spi_exec +-------------- + +(1 row) + +select tcl_spi_exec(false, 'error'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: error +ERROR: error message +select tcl_spi_exec(false, 'return'); +NOTICE: col1 1, col2 foo +NOTICE: col1 2, col2 bar +NOTICE: action: return + tcl_spi_exec +-------------- + +(1 row) + +-- forcibly run the Tcl event loop for awhile, to check that we have not +-- messed things up too badly by disabling the Tcl notifier subsystem +select tcl_eval($$ + unset -nocomplain ::tcl_vwait + after 100 {set ::tcl_vwait 1} + vwait ::tcl_vwait + unset -nocomplain ::tcl_vwait$$); + tcl_eval +---------- + +(1 row) + diff --git a/src/pl/tcl/expected/pltcl_setup.out b/src/pl/tcl/expected/pltcl_setup.out index ed99d9b492..d0ef3b5f26 100644 --- a/src/pl/tcl/expected/pltcl_setup.out +++ b/src/pl/tcl/expected/pltcl_setup.out @@ -49,10 +49,31 @@ create function check_pkey1_exists(int4, bpchar) returns bool as E' return "f" ' language pltcl; -- dump trigger data -CREATE TABLE trigger_test - (i int, v text ); -CREATE VIEW trigger_test_view AS SELECT * FROM trigger_test; +CREATE TABLE trigger_test ( + i int, + v text, + dropme text, + test_skip boolean DEFAULT false, + test_return_null boolean DEFAULT false, + test_argisnull boolean DEFAULT false +); +-- Make certain dropped attributes are handled correctly +ALTER TABLE trigger_test DROP dropme; +CREATE VIEW trigger_test_view AS SELECT i, v FROM trigger_test; CREATE FUNCTION trigger_data() returns trigger language pltcl as $_$ + if {$TG_table_name eq "trigger_test" && $TG_level eq "ROW" && $TG_op ne "DELETE"} { + # Special case tests + if {$NEW(test_return_null) eq "t" } { + return_null + } + if {$NEW(test_argisnull) eq "t" } { + set should_error [argisnull 1] + } + if {$NEW(test_skip) eq "t" } { + elog NOTICE "SKIPPING OPERATION $TG_op" + return SKIP + } + } if { [info exists TG_relid] } { set TG_relid "bogus:12345" @@ -86,6 +107,9 @@ $_$; CREATE TRIGGER show_trigger_data_trig BEFORE INSERT OR UPDATE OR DELETE ON trigger_test FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo'); +CREATE TRIGGER statement_trigger +BEFORE INSERT OR UPDATE OR DELETE OR TRUNCATE ON trigger_test +FOR EACH STATEMENT EXECUTE PROCEDURE trigger_data(42,'statement trigger'); CREATE TRIGGER show_trigger_data_view_trig INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view FOR EACH ROW EXECUTE PROCEDURE trigger_data(24,'skidoo view'); @@ -533,12 +557,12 @@ select tcl_date_week(2001,10,24); (1 row) -- test pltcl event triggers -create or replace function tclsnitch() returns event_trigger language pltcl as $$ +create function tclsnitch() returns event_trigger language pltcl as $$ elog NOTICE "tclsnitch: $TG_event $TG_tag" $$; create event trigger tcl_a_snitch on ddl_command_start execute procedure tclsnitch(); create event trigger tcl_b_snitch on ddl_command_end execute procedure tclsnitch(); -create or replace function foobar() returns int language sql as $$select 1;$$; +create function foobar() returns int language sql as $$select 1;$$; NOTICE: tclsnitch: ddl_command_start CREATE FUNCTION NOTICE: tclsnitch: ddl_command_end CREATE FUNCTION alter function foobar() cost 77; @@ -555,44 +579,108 @@ 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; -CREATE FUNCTION tcl_test_cube_squared(in int, out squared int, out cubed int) AS $$ +create function tcl_test_cube_squared(in int, out squared int, out cubed int) as $$ return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]] $$ language pltcl; -CREATE FUNCTION tcl_test_squared_rows(int,int) RETURNS TABLE (x int, y int) AS $$ +create function tcl_test_squared_rows(int,int) returns table (x int, y int) as $$ for {set i $1} {$i < $2} {incr i} { return_next [list y [expr {$i * $i}] x $i] } $$ language pltcl; -CREATE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$ +create function tcl_test_sequence(int,int) returns setof int as $$ for {set i $1} {$i < $2} {incr i} { return_next $i } $$ language pltcl; +create function tcl_eval(string text) returns text as $$ + eval $1 +$$ language pltcl; -- 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(condition) == "undefined_table"} { - return "expected error: $errArray(message)" - } else { - return "unexpected error: $errArray(condition) $errArray(message)" +create function tcl_error_handling_test(text) returns text +language pltcl +as $function$ + if {[catch $1 err]} { + # If not a Postgres error, just return the basic error message + if {[lindex $::errorCode 0] != "POSTGRES"} { + return $err + } + + # Get rid of keys that can't be expected to remain constant + array set myArray $::errorCode + unset myArray(POSTGRES) + unset myArray(funcname) + unset myArray(filename) + unset myArray(lineno) + + # Format into something nicer + set vals [] + foreach {key} [lsort [array names myArray]] { + set value [string map {"\n" "\n\t"} $myArray($key)] + lappend vals "$key: $value" } + return [join $vals "\n"] } 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: undefined_column column "no_such_column" does not exist -(1 row) - -drop table foo; +$function$; +-- test spi_exec and spi_execp with -array +create function tcl_spi_exec( + prepare boolean, + action text +) +returns void language pltcl AS $function$ +set query "select * from (values (1,'foo'),(2,'bar'),(3,'baz')) v(col1,col2)" +if {$1 == "t"} { + set prep [spi_prepare $query {}] + spi_execp -array A $prep { + elog NOTICE "col1 $A(col1), col2 $A(col2)" + + switch $A(col1) { + 2 { + elog NOTICE "action: $2" + switch $2 { + break { + break + } + continue { + continue + } + return { + return + } + error { + error "error message" + } + } + error "should not get here" + } + } + } +} else { + spi_exec -array A $query { + elog NOTICE "col1 $A(col1), col2 $A(col2)" + + switch $A(col1) { + 2 { + elog NOTICE "action: $2" + switch $2 { + break { + break + } + continue { + continue + } + return { + return + } + error { + error "error message" + } + } + error "should not get here" + } + } + } +} +elog NOTICE "end of function" +$function$; diff --git a/src/pl/tcl/sql/pltcl_queries.sql b/src/pl/tcl/sql/pltcl_queries.sql index 0ebfe65340..29ed616cd0 100644 --- a/src/pl/tcl/sql/pltcl_queries.sql +++ b/src/pl/tcl/sql/pltcl_queries.sql @@ -80,8 +80,10 @@ insert into trigger_test_view values(2,'insert'); update trigger_test_view set v = 'update' where i=1; delete from trigger_test_view; +update trigger_test set v = 'update', test_skip=true where i = 1; update trigger_test set v = 'update' where i = 1; delete from trigger_test; +truncate trigger_test; -- Test composite-type arguments select tcl_composite_arg_ref1(row('tkey', 42, 'ref2')); @@ -91,6 +93,9 @@ select tcl_composite_arg_ref2(row('tkey', 42, 'ref2')); select tcl_argisnull('foo'); select tcl_argisnull(''); select tcl_argisnull(null); +-- should error +insert into trigger_test(test_argisnull) values(true); +select trigger_data(); -- Test spi_lastoid primitive create temp table t1 (f1 int); @@ -99,14 +104,14 @@ create temp table t2 (f1 int) with oids; select tcl_lastoid('t2') > 0; -- test some error cases -CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl; -SELECT tcl_error(); +create function tcl_error(out a int, out b int) as $$return {$$ language pltcl; +select tcl_error(); -CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ LANGUAGE pltcl; -SELECT bad_record(); +create function bad_record(out a text, out b text) as $$return [list a]$$ language pltcl; +select bad_record(); -CREATE FUNCTION bad_field(OUT a text, OUT b text) AS $$return [list a 1 b 2 cow 3]$$ LANGUAGE pltcl; -SELECT bad_field(); +create function bad_field(out a text, out b text) as $$return [list a 1 b 2 cow 3]$$ language pltcl; +select bad_field(); -- test compound return select * from tcl_test_cube_squared(5); @@ -118,15 +123,96 @@ select * from tcl_test_sequence(0,5) as a; select 1, tcl_test_sequence(0,5); -CREATE FUNCTION non_srf() RETURNS int AS $$return_next 1$$ LANGUAGE pltcl; +create function non_srf() returns int as $$return_next 1$$ language pltcl; select non_srf(); -CREATE FUNCTION bad_record_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$ +create function bad_record_srf(out a text, out b text) returns setof record as $$ return_next [list a] -$$ LANGUAGE pltcl; -SELECT bad_record_srf(); +$$ language pltcl; +select bad_record_srf(); -CREATE FUNCTION bad_field_srf(OUT a text, OUT b text) RETURNS SETOF record AS $$ +create function bad_field_srf(out a text, out b text) returns setof record as $$ return_next [list a 1 b 2 cow 3] -$$ LANGUAGE pltcl; -SELECT bad_field_srf(); +$$ language pltcl; +select bad_field_srf(); + +-- test quote +select tcl_eval('quote foo bar'); +select tcl_eval('quote [format %c 39]'); +select tcl_eval('quote [format %c 92]'); + +-- Test argisnull +select tcl_eval('argisnull'); +select tcl_eval('argisnull 14'); +select tcl_eval('argisnull abc'); + +-- Test return_null +select tcl_eval('return_null 14'); +-- should error +insert into trigger_test(test_return_null) values(true); + +-- Test spi_exec +select tcl_eval('spi_exec'); +select tcl_eval('spi_exec -count'); +select tcl_eval('spi_exec -array'); +select tcl_eval('spi_exec -count abc'); +select tcl_eval('spi_exec query loop body toomuch'); +select tcl_eval('spi_exec "begin; rollback;"'); + +-- Test spi_execp +select tcl_eval('spi_execp'); +select tcl_eval('spi_execp -count'); +select tcl_eval('spi_execp -array'); +select tcl_eval('spi_execp -count abc'); +select tcl_eval('spi_execp -nulls'); +select tcl_eval('spi_execp ""'); + +-- test spi_prepare +select tcl_eval('spi_prepare'); +select tcl_eval('spi_prepare a b'); +select tcl_eval('spi_prepare a "b {"'); +select tcl_error_handling_test($tcl$spi_prepare "select moo" []$tcl$); + +-- test full error text +select tcl_error_handling_test($tcl$ +spi_exec "DO $$ +BEGIN +RAISE 'my message' + USING HINT = 'my hint' + , DETAIL = 'my detail' + , SCHEMA = 'my schema' + , TABLE = 'my table' + , COLUMN = 'my column' + , CONSTRAINT = 'my constraint' + , DATATYPE = 'my datatype' +; +END$$;" +$tcl$); + +-- verify tcl_error_handling_test() properly reports non-postgres errors +select tcl_error_handling_test('moo'); + +-- test elog +select tcl_eval('elog'); +select tcl_eval('elog foo bar'); + +-- test forced error +select tcl_eval('error "forced error"'); + +-- test loop control in spi_exec[p] +select tcl_spi_exec(true, 'break'); +select tcl_spi_exec(true, 'continue'); +select tcl_spi_exec(true, 'error'); +select tcl_spi_exec(true, 'return'); +select tcl_spi_exec(false, 'break'); +select tcl_spi_exec(false, 'continue'); +select tcl_spi_exec(false, 'error'); +select tcl_spi_exec(false, 'return'); + +-- forcibly run the Tcl event loop for awhile, to check that we have not +-- messed things up too badly by disabling the Tcl notifier subsystem +select tcl_eval($$ + unset -nocomplain ::tcl_vwait + after 100 {set ::tcl_vwait 1} + vwait ::tcl_vwait + unset -nocomplain ::tcl_vwait$$); diff --git a/src/pl/tcl/sql/pltcl_setup.sql b/src/pl/tcl/sql/pltcl_setup.sql index 58f38d53aa..cda31a9c1c 100644 --- a/src/pl/tcl/sql/pltcl_setup.sql +++ b/src/pl/tcl/sql/pltcl_setup.sql @@ -57,12 +57,33 @@ create function check_pkey1_exists(int4, bpchar) returns bool as E' -- dump trigger data -CREATE TABLE trigger_test - (i int, v text ); +CREATE TABLE trigger_test ( + i int, + v text, + dropme text, + test_skip boolean DEFAULT false, + test_return_null boolean DEFAULT false, + test_argisnull boolean DEFAULT false +); +-- Make certain dropped attributes are handled correctly +ALTER TABLE trigger_test DROP dropme; -CREATE VIEW trigger_test_view AS SELECT * FROM trigger_test; +CREATE VIEW trigger_test_view AS SELECT i, v FROM trigger_test; CREATE FUNCTION trigger_data() returns trigger language pltcl as $_$ + if {$TG_table_name eq "trigger_test" && $TG_level eq "ROW" && $TG_op ne "DELETE"} { + # Special case tests + if {$NEW(test_return_null) eq "t" } { + return_null + } + if {$NEW(test_argisnull) eq "t" } { + set should_error [argisnull 1] + } + if {$NEW(test_skip) eq "t" } { + elog NOTICE "SKIPPING OPERATION $TG_op" + return SKIP + } + } if { [info exists TG_relid] } { set TG_relid "bogus:12345" @@ -97,6 +118,9 @@ $_$; CREATE TRIGGER show_trigger_data_trig BEFORE INSERT OR UPDATE OR DELETE ON trigger_test FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo'); +CREATE TRIGGER statement_trigger +BEFORE INSERT OR UPDATE OR DELETE OR TRUNCATE ON trigger_test +FOR EACH STATEMENT EXECUTE PROCEDURE trigger_data(42,'statement trigger'); CREATE TRIGGER show_trigger_data_view_trig INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view @@ -579,14 +603,14 @@ select tcl_date_week(2010,1,24); select tcl_date_week(2001,10,24); -- test pltcl event triggers -create or replace function tclsnitch() returns event_trigger language pltcl as $$ +create function tclsnitch() returns event_trigger language pltcl as $$ elog NOTICE "tclsnitch: $TG_event $TG_tag" $$; create event trigger tcl_a_snitch on ddl_command_start execute procedure tclsnitch(); create event trigger tcl_b_snitch on ddl_command_end execute procedure tclsnitch(); -create or replace function foobar() returns int language sql as $$select 1;$$; +create function foobar() returns int language sql as $$select 1;$$; alter function foobar() cost 77; drop function foobar(); @@ -596,42 +620,113 @@ drop table foo; drop event trigger tcl_a_snitch; drop event trigger tcl_b_snitch; -CREATE FUNCTION tcl_test_cube_squared(in int, out squared int, out cubed int) AS $$ +create function tcl_test_cube_squared(in int, out squared int, out cubed int) as $$ return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]] $$ language pltcl; -CREATE FUNCTION tcl_test_squared_rows(int,int) RETURNS TABLE (x int, y int) AS $$ +create function tcl_test_squared_rows(int,int) returns table (x int, y int) as $$ for {set i $1} {$i < $2} {incr i} { return_next [list y [expr {$i * $i}] x $i] } $$ language pltcl; -CREATE FUNCTION tcl_test_sequence(int,int) RETURNS SETOF int AS $$ +create function tcl_test_sequence(int,int) returns setof int as $$ for {set i $1} {$i < $2} {incr i} { return_next $i } $$ language pltcl; +create function tcl_eval(string text) returns text as $$ + eval $1 +$$ language pltcl; + -- test use of errorCode in error handling +create function tcl_error_handling_test(text) returns text +language pltcl +as $function$ + if {[catch $1 err]} { + # If not a Postgres error, just return the basic error message + if {[lindex $::errorCode 0] != "POSTGRES"} { + return $err + } -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(condition) == "undefined_table"} { - return "expected error: $errArray(message)" - } else { - return "unexpected error: $errArray(condition) $errArray(message)" + # Get rid of keys that can't be expected to remain constant + array set myArray $::errorCode + unset myArray(POSTGRES) + unset myArray(funcname) + unset myArray(filename) + unset myArray(lineno) + + # Format into something nicer + set vals [] + foreach {key} [lsort [array names myArray]] { + set value [string map {"\n" "\n\t"} $myArray($key)] + lappend vals "$key: $value" } + return [join $vals "\n"] } 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; +$function$; + +-- test spi_exec and spi_execp with -array +create function tcl_spi_exec( + prepare boolean, + action text +) +returns void language pltcl AS $function$ +set query "select * from (values (1,'foo'),(2,'bar'),(3,'baz')) v(col1,col2)" +if {$1 == "t"} { + set prep [spi_prepare $query {}] + spi_execp -array A $prep { + elog NOTICE "col1 $A(col1), col2 $A(col2)" + + switch $A(col1) { + 2 { + elog NOTICE "action: $2" + switch $2 { + break { + break + } + continue { + continue + } + return { + return + } + error { + error "error message" + } + } + error "should not get here" + } + } + } +} else { + spi_exec -array A $query { + elog NOTICE "col1 $A(col1), col2 $A(col2)" + + switch $A(col1) { + 2 { + elog NOTICE "action: $2" + switch $2 { + break { + break + } + continue { + continue + } + return { + return + } + error { + error "error message" + } + } + error "should not get here" + } + } + } +} +elog NOTICE "end of function" +$function$; -- 2.40.0