Skip to content

P
Postgres FD Implementation
Commit 961bed02 authored by Tom Lane's avatar Tom Lane
Browse files
Options

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
parent 534b6f3e
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 654 additions and 89 deletions
src/pl/tcl/expected/pltcl_queries.out
View file @ 961bed02
This diff is collapsed.
src/pl/tcl/expected/pltcl_setup.out
View file @ 961bed02
......@@ -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$;
src/pl/tcl/sql/pltcl_queries.sql
View file @ 961bed02
......@@ -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$$);
src/pl/tcl/sql/pltcl_setup.sql
View file @ 961bed02
......@@ -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$;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment