diff --cc src/pl/tcl/expected/pltcl_queries.out index 3a9fef3447,9e3a0dcd0b..0000000000 --- a/src/pl/tcl/expected/pltcl_queries.out +++ b/src/pl/tcl/expected/pltcl_queries.out @@@ -288,6 -350,20 +350,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'); @@@ -303,64 -379,216 +381,277 @@@ select tcl_lastoid('t2') > 0 t (1 row) --- Test quote +-- 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); + squared | cubed +---------+------- + 25 | 125 +(1 row) + - -- test SRF ++-- test srf +select * from tcl_test_squared_rows(0,5); + x | y +---+---- + 0 | 0 + 1 | 1 + 2 | 4 + 3 | 9 + 4 | 16 +(5 rows) + +select * from tcl_test_sequence(0,5) as a; + a +--- + 0 + 1 + 2 + 3 + 4 +(5 rows) + +select 1, tcl_test_sequence(0,5); + ?column? | tcl_test_sequence +----------+------------------- + 1 | 0 + 1 | 1 + 1 | 2 + 1 | 3 + 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: bad option "begin; rollback;": must be -array or -countpltcl: SPI_execute failed: SPI_ERROR_TRANSACTION ++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: bad option "": must be -array, -count, or -nullsinvalid queryid '' ++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 "moo" }$tcl$); + tcl_error_handling_test + ------------------------------ + COMMAND: spi_prepare "moo" + + POSTGRES: 'POSTGRES' + + TCL: LOOKUP + + funcname: 'funcname' + + lineno: 'lineno' + (1 row) + + -- test full error text + select tcl_error_handling_test($tcl$ + spi_exec "DO $$ + BEGIN + RAISE 'message' + USING HINT = 'hint' + , DETAIL = 'detail' + , SCHEMA = 'schema' + , TABLE = 'table' + , COLUMN = 'column' + , CONSTRAINT = 'constraint' + , DATATYPE = 'datatype' + ; + END$$;" + $tcl$); + tcl_error_handling_test + -------------------------------------------------------------- + POSTGRES: 'POSTGRES' + + SQLSTATE: P0001 + + column: column + + condition: raise_exception + + constraint: constraint + + context: PL/pgSQL function inline_code_block line 3 at RAISE+ + SQL statement "DO $$ + + BEGIN + + RAISE 'message' + + USING HINT = 'hint' + + , DETAIL = 'detail' + + , SCHEMA = 'schema' + + , TABLE = 'table' + + , COLUMN = 'column' + + , CONSTRAINT = 'constraint' + + , DATATYPE = 'datatype' + + ; + + END$$;" + + datatype: datatype + + detail: detail + + filename: pl_exec.c + + funcname: 'funcname' + + hint: hint + + lineno: 'lineno' + + message: message + + schema: schema + + table: table + (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 + select tcl_eval('unset -nocomplain ::tcl_vwait; after 100 {set ::tcl_vwait 1}; vwait ::tcl_vwait; unset -nocomplain ::tcl_vwait'); + tcl_eval + ---------- + + (1 row) + + -- test loop control + select tcl_spi_exec(true, 'break'); + NOTICE: attnum 1, attname relname + NOTICE: attnum 2, attname relnamespace + NOTICE: action: break + NOTICE: end of function + tcl_spi_exec + -------------- + + (1 row) + + select tcl_spi_exec(true, 'continue'); + NOTICE: attnum 1, attname relname + NOTICE: attnum 2, attname relnamespace + NOTICE: action: continue + NOTICE: attnum 3, attname reltype + NOTICE: end of function + tcl_spi_exec + -------------- + + (1 row) + + select tcl_spi_exec(true, 'error'); + NOTICE: attnum 1, attname relname + NOTICE: attnum 2, attname relnamespace + NOTICE: action: error + ERROR: error message + select tcl_spi_exec(true, 'return'); + NOTICE: attnum 1, attname relname + NOTICE: attnum 2, attname relnamespace + NOTICE: action: return + tcl_spi_exec + -------------- + + (1 row) + + select tcl_spi_exec(false, 'break'); + NOTICE: attnum 1, attname relname + NOTICE: attnum 2, attname relnamespace + NOTICE: action: break + NOTICE: end of function + tcl_spi_exec + -------------- + + (1 row) + + select tcl_spi_exec(false, 'continue'); + NOTICE: attnum 1, attname relname + NOTICE: attnum 2, attname relnamespace + NOTICE: action: continue + NOTICE: attnum 3, attname reltype + NOTICE: end of function + tcl_spi_exec + -------------- + + (1 row) + + select tcl_spi_exec(false, 'error'); + NOTICE: attnum 1, attname relname + NOTICE: attnum 2, attname relnamespace + NOTICE: action: error + ERROR: error message + select tcl_spi_exec(false, 'return'); + NOTICE: attnum 1, attname relname + NOTICE: attnum 2, attname relnamespace + NOTICE: action: return + tcl_spi_exec + -------------- + + (1 row) + diff --cc src/pl/tcl/expected/pltcl_setup.out index ed99d9b492,357155006a..0000000000 --- a/src/pl/tcl/expected/pltcl_setup.out +++ b/src/pl/tcl/expected/pltcl_setup.out @@@ -555,29 -579,28 +579,41 @@@ NOTICE: tclsnitch: ddl_command_start D 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 OR REPLACE FUNCTION tcl_eval(in string varchar) RETURNS text 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; - -- 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 or replace function tcl_eval(in string varchar) returns text as $$ + eval $1 -$$ LANGUAGE 'pltcl'; --- test use of errorCode in error handling -CREATE FUNCTION public.tcl_error_handling_test(text) - RETURNS text - LANGUAGE pltcl -AS $function$ ++$$ language 'pltcl'; ++-- test use of errorcode in error handling ++create function public.tcl_error_handling_test(text) ++ returns text ++ language pltcl ++as $function$ + if {[catch $1 err]} { + # Set keys that will change over time to fixed values + array set myArray $::errorCode + set myArray(funcname) "'funcname'" + set myArray(lineno) 'lineno' + set myArray(POSTGRES) 'POSTGRES' + + # 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" } diff --cc src/pl/tcl/sql/pltcl_queries.sql index 0ebfe65340,5c584d808a..0000000000 --- a/src/pl/tcl/sql/pltcl_queries.sql +++ b/src/pl/tcl/sql/pltcl_queries.sql @@@ -91,6 -98,8 +98,9 @@@ select tcl_composite_arg_ref2(row('tkey 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); @@@ -98,35 -107,75 +108,108 @@@ select tcl_lastoid('t1') create temp table t2 (f1 int) with oids; select tcl_lastoid('t2') > 0; --- Test quote +-- 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); + - -- test SRF ++-- test srf +select * from tcl_test_squared_rows(0,5); + +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 "moo" }$tcl$); + + -- test full error text + select tcl_error_handling_test($tcl$ + spi_exec "DO $$ + BEGIN + RAISE 'message' + USING HINT = 'hint' + , DETAIL = 'detail' + , SCHEMA = 'schema' + , TABLE = 'table' + , COLUMN = 'column' + , CONSTRAINT = 'constraint' + , DATATYPE = 'datatype' + ; + END$$;" + $tcl$); + + + -- test elog + select tcl_eval('elog'); + select tcl_eval('elog foo bar'); + + -- test forced error + select tcl_eval('error "forced error"'); + + select tcl_eval('unset -nocomplain ::tcl_vwait; after 100 {set ::tcl_vwait 1}; vwait ::tcl_vwait; unset -nocomplain ::tcl_vwait'); + + -- test loop control + 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'); diff --cc src/pl/tcl/sql/pltcl_setup.sql index 58f38d53aa,664f3dbe8a..0000000000 --- a/src/pl/tcl/sql/pltcl_setup.sql +++ b/src/pl/tcl/sql/pltcl_setup.sql @@@ -596,33 -620,31 +620,47 @@@ 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 OR REPLACE FUNCTION tcl_eval(in string varchar) RETURNS text 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; + - -- 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 or replace function tcl_eval(in string varchar) returns text as $$ + eval $1 -$$ LANGUAGE 'pltcl'; ++$$ language 'pltcl'; + + --- test use of errorCode in error handling ++-- test use of errorcode in error handling + -CREATE FUNCTION public.tcl_error_handling_test(text) - RETURNS text - LANGUAGE pltcl -AS $function$ ++create function public.tcl_error_handling_test(text) ++ returns text ++ language pltcl ++as $function$ + if {[catch $1 err]} { + # Set keys that will change over time to fixed values + array set myArray $::errorCode + set myArray(funcname) "'funcname'" + set myArray(lineno) 'lineno' + set myArray(POSTGRES) 'POSTGRES' + + # 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" }