open-dsi
/
postgres
mirror of https://github.com/postgres/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki 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
pull/18/head
Tom Lane 9 years ago
parent 534b6f3ef2
commit 961bed0208
4 changed files with 654 additions and 89 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 336
      src/pl/tcl/expected/pltcl_queries.out
  2. 150
      src/pl/tcl/expected/pltcl_setup.out
  3. 112
      src/pl/tcl/sql/pltcl_queries.sql
  4. 145
      src/pl/tcl/sql/pltcl_setup.sql

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

@ -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)

150
src/pl/tcl/expected/pltcl_setup.out
Unescape View File

@ -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$;

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

@ -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$$);

145
src/pl/tcl/sql/pltcl_setup.sql
Unescape View File

@ -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$;

Write Preview
Loading…
Cancel
Save