database/postgres
1
0
Fork 0
mirror of https://github.com/postgres/postgres.git synced 2025-06-22 02:52:08 +03:00
Code Activity

Expand the regression tests for PL/Tcl.

Browse Source 
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
This commit is contained in:
Tom Lane
2017-01-09 10:10:08 -05:00
parent 534b6f3ef2
commit 961bed0208
4 changed files with 650 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files

336
src/pl/tcl/expected/pltcl_queries.out
View File

@ -185,12 +185,23 @@ select * from T_pkey2 order by key1 using @<, key2 collate "C";
-- show dump of trigger data -- show dump of trigger data
insert into trigger_test values(1,'insert'); 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: OLD: {}
NOTICE: TG_level: ROW NOTICE: TG_level: ROW
NOTICE: TG_name: show_trigger_data_trig NOTICE: TG_name: show_trigger_data_trig
NOTICE: TG_op: INSERT 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_relid: bogus:12345
NOTICE: TG_table_name: trigger_test NOTICE: TG_table_name: trigger_test
NOTICE: TG_table_schema: public NOTICE: TG_table_schema: public
@ -232,13 +243,37 @@ NOTICE: TG_table_name: trigger_test_view
NOTICE: TG_table_schema: public NOTICE: TG_table_schema: public
NOTICE: TG_when: {INSTEAD OF} NOTICE: TG_when: {INSTEAD OF}
NOTICE: args: {24 {skidoo view}} 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; update trigger_test set v = 'update' where i = 1;
NOTICE: NEW: {i: 1, v: update} NOTICE: NEW: {}
NOTICE: OLD: {i: 1, v: insert} 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_level: ROW
NOTICE: TG_name: show_trigger_data_trig NOTICE: TG_name: show_trigger_data_trig
NOTICE: TG_op: UPDATE 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_relid: bogus:12345
NOTICE: TG_table_name: trigger_test NOTICE: TG_table_name: trigger_test
NOTICE: TG_table_schema: public NOTICE: TG_table_schema: public
@ -246,16 +281,39 @@ NOTICE: TG_when: BEFORE
NOTICE: args: {23 skidoo} NOTICE: args: {23 skidoo}
delete from trigger_test; delete from trigger_test;
NOTICE: NEW: {} 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_level: ROW
NOTICE: TG_name: show_trigger_data_trig NOTICE: TG_name: show_trigger_data_trig
NOTICE: TG_op: DELETE 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_relid: bogus:12345
NOTICE: TG_table_name: trigger_test NOTICE: TG_table_name: trigger_test
NOTICE: TG_table_schema: public NOTICE: TG_table_schema: public
NOTICE: TG_when: BEFORE NOTICE: TG_when: BEFORE
NOTICE: args: {23 skidoo} 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 -- Test composite-type arguments
select tcl_composite_arg_ref1(row('tkey', 42, 'ref2')); select tcl_composite_arg_ref1(row('tkey', 42, 'ref2'));
tcl_composite_arg_ref1 tcl_composite_arg_ref1
@ -288,6 +346,22 @@ select tcl_argisnull(null);
t t
(1 row) (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 -- Test spi_lastoid primitive
create temp table t1 (f1 int); create temp table t1 (f1 int);
select tcl_lastoid('t1'); select tcl_lastoid('t1');
@ -304,14 +378,14 @@ select tcl_lastoid('t2') > 0;
(1 row) (1 row)
-- test some error cases -- test some error cases
CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl; create function tcl_error(out a int, out b int) as $$return {$$ language pltcl;
SELECT tcl_error(); select tcl_error();
ERROR: missing close-brace ERROR: missing close-brace
CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ LANGUAGE pltcl; create function bad_record(out a text, out b text) as $$return [list a]$$ language pltcl;
SELECT bad_record(); select bad_record();
ERROR: column name/value list must have even number of elements 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; create function bad_field(out a text, out b text) as $$return [list a 1 b 2 cow 3]$$ language pltcl;
SELECT bad_field(); select bad_field();
ERROR: column name/value list contains nonexistent column name "cow" ERROR: column name/value list contains nonexistent column name "cow"
-- test compound return -- test compound return
select * from tcl_test_cube_squared(5); select * from tcl_test_cube_squared(5);
@ -351,16 +425,238 @@ select 1, tcl_test_sequence(0,5);
1 | 4 1 | 4
(5 rows) (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(); select non_srf();
ERROR: return_next cannot be used in non-set-returning functions 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] return_next [list a]
$$ LANGUAGE pltcl; $$ language pltcl;
SELECT bad_record_srf(); select bad_record_srf();
ERROR: column name/value list must have even number of elements 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] return_next [list a 1 b 2 cow 3]
$$ LANGUAGE pltcl; $$ language pltcl;
SELECT bad_field_srf(); select bad_field_srf();
ERROR: column name/value list contains nonexistent column name "cow" 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)

146
src/pl/tcl/expected/pltcl_setup.out
View File

@ -49,10 +49,31 @@ create function check_pkey1_exists(int4, bpchar) returns bool as E'
return "f" return "f"
' language pltcl; ' language pltcl;
-- dump trigger data -- dump trigger data
CREATE TABLE trigger_test CREATE TABLE trigger_test (
(i int, v text ); i int,
CREATE VIEW trigger_test_view AS SELECT * FROM trigger_test; 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 $_$ 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] } { if { [info exists TG_relid] } {
set TG_relid "bogus:12345" set TG_relid "bogus:12345"
@ -86,6 +107,9 @@ $_$;
CREATE TRIGGER show_trigger_data_trig CREATE TRIGGER show_trigger_data_trig
BEFORE INSERT OR UPDATE OR DELETE ON trigger_test BEFORE INSERT OR UPDATE OR DELETE ON trigger_test
FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo'); 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 CREATE TRIGGER show_trigger_data_view_trig
INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view
FOR EACH ROW EXECUTE PROCEDURE trigger_data(24,'skidoo view'); FOR EACH ROW EXECUTE PROCEDURE trigger_data(24,'skidoo view');
@ -533,12 +557,12 @@ select tcl_date_week(2001,10,24);
(1 row) (1 row)
-- test pltcl event triggers -- 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" elog NOTICE "tclsnitch: $TG_event $TG_tag"
$$; $$;
create event trigger tcl_a_snitch on ddl_command_start execute procedure tclsnitch(); 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 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_start CREATE FUNCTION
NOTICE: tclsnitch: ddl_command_end CREATE FUNCTION NOTICE: tclsnitch: ddl_command_end CREATE FUNCTION
alter function foobar() cost 77; alter function foobar() cost 77;
@ -555,44 +579,108 @@ NOTICE: tclsnitch: ddl_command_start DROP TABLE
NOTICE: tclsnitch: ddl_command_end DROP TABLE NOTICE: tclsnitch: ddl_command_end DROP TABLE
drop event trigger tcl_a_snitch; drop event trigger tcl_a_snitch;
drop event trigger tcl_b_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}]] return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
$$ language pltcl; $$ 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} { for {set i $1} {$i < $2} {incr i} {
return_next [list y [expr {$i * $i}] x $i] return_next [list y [expr {$i * $i}] x $i]
} }
$$ language pltcl; $$ 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} { for {set i $1} {$i < $2} {incr i} {
return_next $i return_next $i
} }
$$ language pltcl; $$ language pltcl;
create function tcl_eval(string text) returns text as $$
eval $1
$$ language pltcl;
-- test use of errorCode in error handling -- test use of errorCode in error handling
create function tcl_error_handling_test() returns text as $$ create function tcl_error_handling_test(text) returns text
global errorCode language pltcl
if {[catch { spi_exec "select no_such_column from foo;" }]} { as $function$
array set errArray $errorCode if {[catch $1 err]} {
if {$errArray(condition) == "undefined_table"} { # If not a Postgres error, just return the basic error message
return "expected error: $errArray(message)" if {[lindex $::errorCode 0] != "POSTGRES"} {
} else { return $err
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 { } else {
return "no error" return "no error"
} }
$$ language pltcl; $function$;
select tcl_error_handling_test(); -- test spi_exec and spi_execp with -array
tcl_error_handling_test create function tcl_spi_exec(
----------------------------------------------- prepare boolean,
expected error: relation "foo" does not exist action text
(1 row) )
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)"
create temp table foo(f1 int); switch $A(col1) {
select tcl_error_handling_test(); 2 {
tcl_error_handling_test elog NOTICE "action: $2"
--------------------------------------------------------------------------- switch $2 {
unexpected error: undefined_column column "no_such_column" does not exist break {
(1 row) 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)"
drop table foo; 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$;

112
src/pl/tcl/sql/pltcl_queries.sql
View File

@ -80,8 +80,10 @@ insert into trigger_test_view values(2,'insert');
update trigger_test_view set v = 'update' where i=1; update trigger_test_view set v = 'update' where i=1;
delete from trigger_test_view; 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; update trigger_test set v = 'update' where i = 1;
delete from trigger_test; delete from trigger_test;
truncate trigger_test;
-- Test composite-type arguments -- Test composite-type arguments
select tcl_composite_arg_ref1(row('tkey', 42, 'ref2')); 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('foo');
select tcl_argisnull(''); select tcl_argisnull('');
select tcl_argisnull(null); select tcl_argisnull(null);
-- should error
insert into trigger_test(test_argisnull) values(true);
select trigger_data();
-- Test spi_lastoid primitive -- Test spi_lastoid primitive
create temp table t1 (f1 int); create temp table t1 (f1 int);
@ -99,14 +104,14 @@ create temp table t2 (f1 int) with oids;
select tcl_lastoid('t2') > 0; select tcl_lastoid('t2') > 0;
-- test some error cases -- test some error cases
CREATE FUNCTION tcl_error(OUT a int, OUT b int) AS $$return {$$ LANGUAGE pltcl; create function tcl_error(out a int, out b int) as $$return {$$ language pltcl;
SELECT tcl_error(); select tcl_error();
CREATE FUNCTION bad_record(OUT a text, OUT b text) AS $$return [list a]$$ LANGUAGE pltcl; create function bad_record(out a text, out b text) as $$return [list a]$$ language pltcl;
SELECT bad_record(); select bad_record();
CREATE FUNCTION bad_field(OUT a text, OUT b text) AS $$return [list a 1 b 2 cow 3]$$ LANGUAGE pltcl; create function bad_field(out a text, out b text) as $$return [list a 1 b 2 cow 3]$$ language pltcl;
SELECT bad_field(); select bad_field();
-- test compound return -- test compound return
select * from tcl_test_cube_squared(5); 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); 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(); 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] return_next [list a]
$$ LANGUAGE pltcl; $$ language pltcl;
SELECT bad_record_srf(); 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] return_next [list a 1 b 2 cow 3]
$$ LANGUAGE pltcl; $$ language pltcl;
SELECT bad_field_srf(); 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$$);

141
src/pl/tcl/sql/pltcl_setup.sql
View File

@ -57,12 +57,33 @@ create function check_pkey1_exists(int4, bpchar) returns bool as E'
-- dump trigger data -- dump trigger data
CREATE TABLE trigger_test CREATE TABLE trigger_test (
(i int, v text ); 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 $_$ 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] } { if { [info exists TG_relid] } {
set TG_relid "bogus:12345" set TG_relid "bogus:12345"
@ -97,6 +118,9 @@ $_$;
CREATE TRIGGER show_trigger_data_trig CREATE TRIGGER show_trigger_data_trig
BEFORE INSERT OR UPDATE OR DELETE ON trigger_test BEFORE INSERT OR UPDATE OR DELETE ON trigger_test
FOR EACH ROW EXECUTE PROCEDURE trigger_data(23,'skidoo'); 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 CREATE TRIGGER show_trigger_data_view_trig
INSTEAD OF INSERT OR UPDATE OR DELETE ON trigger_test_view 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); select tcl_date_week(2001,10,24);
-- test pltcl event triggers -- 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" elog NOTICE "tclsnitch: $TG_event $TG_tag"
$$; $$;
create event trigger tcl_a_snitch on ddl_command_start execute procedure tclsnitch(); 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 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; alter function foobar() cost 77;
drop function foobar(); drop function foobar();
@ -596,42 +620,113 @@ drop table foo;
drop event trigger tcl_a_snitch; drop event trigger tcl_a_snitch;
drop event trigger tcl_b_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}]] return [list squared [expr {$1 * $1}] cubed [expr {$1 * $1 * $1}]]
$$ language pltcl; $$ 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} { for {set i $1} {$i < $2} {incr i} {
return_next [list y [expr {$i * $i}] x $i] return_next [list y [expr {$i * $i}] x $i]
} }
$$ language pltcl; $$ 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} { for {set i $1} {$i < $2} {incr i} {
return_next $i return_next $i
} }
$$ language pltcl; $$ language pltcl;
-- test use of errorCode in error handling create function tcl_eval(string text) returns text as $$
eval $1
$$ language pltcl;
create function tcl_error_handling_test() returns text as $$ -- test use of errorCode in error handling
global errorCode create function tcl_error_handling_test(text) returns text
if {[catch { spi_exec "select no_such_column from foo;" }]} { language pltcl
array set errArray $errorCode as $function$
if {$errArray(condition) == "undefined_table"} { if {[catch $1 err]} {
return "expected error: $errArray(message)" # If not a Postgres error, just return the basic error message
} else { if {[lindex $::errorCode 0] != "POSTGRES"} {
return "unexpected error: $errArray(condition) $errArray(message)" 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 { } else {
return "no error" return "no error"
} }
$$ language pltcl; $function$;
select tcl_error_handling_test(); -- 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)"
create temp table foo(f1 int); 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)"
select tcl_error_handling_test(); switch $A(col1) {
2 {
drop table foo; 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$;