open-dsi
/
postgres
mirror of https://github.com/postgres/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

From: Jan Wieck <jwieck@debis.com>

Browse Source 
A few minutes ago I sent down the PL/Tcl  directory  to  this
    list.  Look at it and reuse anything that might help to build
    PL/perl.  I really hope that PL/perl and PL/Tcl appear in the
    6.3 distribution. I'll do whatever I can to make this happen.
pull/50/head
Marc G. Fournier 28 years ago
parent 957a6149e5
commit 2784f7c81a
6 changed files with 721 additions and 0 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. 8
      src/pl/tcl/test/README
  2. 27
      src/pl/tcl/test/runtest
  3. 178
      src/pl/tcl/test/test.expected
  4. 9
      src/pl/tcl/test/test_mklang.sql
  5. 73
      src/pl/tcl/test/test_queries.sql
  6. 426
      src/pl/tcl/test/test_setup.sql

8
src/pl/tcl/test/README
Unescape View File

@ -0,0 +1,8 @@
This is a small test suite for PL/Tcl.
Just run the script runtest and compare the files
test.expected against test.out after.
Jan

27
src/pl/tcl/test/runtest
Unescape View File

@ -0,0 +1,27 @@
#!/bin/sh
DBNAME=pltcl_test
export DBNAME
echo "**** Destroy old database $DBNAME ****"
destroydb $DBNAME
echo "**** Create test database $DBNAME ****"
createdb $DBNAME
echo "**** Create procedural language pltcl ****"
psql -q -n $DBNAME <test_mklang.sql
echo "**** Create tables, functions and triggers ****"
psql -q -n $DBNAME <test_setup.sql
echo "**** Running test queries ****"
psql -q -n -e $DBNAME <test_queries.sql > test.out 2>&1
if diff test.expected test.out >/dev/null 2>&1 ; then
echo " Tests passed O.K."
else
echo " Tests faild - look at diffs between"
echo " test.expected and test.out"
fi

178
src/pl/tcl/test/test.expected
Unescape View File

@ -0,0 +1,178 @@
QUERY: insert into T_pkey1 values (1, 'key1-1', 'test key');
QUERY: insert into T_pkey1 values (1, 'key1-2', 'test key');
QUERY: insert into T_pkey1 values (1, 'key1-3', 'test key');
QUERY: insert into T_pkey1 values (2, 'key2-1', 'test key');
QUERY: insert into T_pkey1 values (2, 'key2-2', 'test key');
QUERY: insert into T_pkey1 values (2, 'key2-3', 'test key');
QUERY: insert into T_pkey2 values (1, 'key1-1', 'test key');
QUERY: insert into T_pkey2 values (1, 'key1-2', 'test key');
QUERY: insert into T_pkey2 values (1, 'key1-3', 'test key');
QUERY: insert into T_pkey2 values (2, 'key2-1', 'test key');
QUERY: insert into T_pkey2 values (2, 'key2-2', 'test key');
QUERY: insert into T_pkey2 values (2, 'key2-3', 'test key');
QUERY: select * from T_pkey1;
key1|key2 |txt
----+--------------------+----------------------------------------
1|key1-1 |test key
1|key1-2 |test key
1|key1-3 |test key
2|key2-1 |test key
2|key2-2 |test key
2|key2-3 |test key
(6 rows)
QUERY: select * from T_pkey2;
key1|key2 |txt
----+--------------------+----------------------------------------
1|KEY1-1 |test key
1|KEY1-2 |test key
1|KEY1-3 |test key
2|KEY2-1 |test key
2|KEY2-2 |test key
2|KEY2-3 |test key
(6 rows)
QUERY: insert into T_pkey1 values (1, 'KEY1-3', 'should work');
QUERY: insert into T_pkey2 values (1, 'KEY1-3', 'should fail');
ERROR: duplicate key '1', 'KEY1-3' for T_pkey2
QUERY: insert into T_dta1 values ('trec 1', 1, 'key1-1');
QUERY: insert into T_dta1 values ('trec 2', 1, 'key1-2');
QUERY: insert into T_dta1 values ('trec 3', 1, 'key1-3');
QUERY: insert into T_dta1 values ('trec 4', 1, 'key1-4');
ERROR: key for t_dta1 not in t_pkey1
QUERY: insert into T_dta2 values ('trec 1', 1, 'KEY1-1');
QUERY: insert into T_dta2 values ('trec 2', 1, 'KEY1-2');
QUERY: insert into T_dta2 values ('trec 3', 1, 'KEY1-3');
QUERY: insert into T_dta2 values ('trec 4', 1, 'KEY1-4');
ERROR: key for t_dta2 not in t_pkey2
QUERY: select * from T_dta1;
tkey |ref1|ref2
----------+----+--------------------
trec 1 | 1|key1-1
trec 2 | 1|key1-2
trec 3 | 1|key1-3
(3 rows)
QUERY: select * from T_dta2;
tkey |ref1|ref2
----------+----+--------------------
trec 1 | 1|KEY1-1
trec 2 | 1|KEY1-2
trec 3 | 1|KEY1-3
(3 rows)
QUERY: update T_pkey1 set key2 = 'key2-9' where key1 = 2 and key2 = 'key2-1';
QUERY: update T_pkey1 set key2 = 'key1-9' where key1 = 1 and key2 = 'key1-1';
ERROR: key '1', 'key1-1 ' referenced by T_dta1
QUERY: delete from T_pkey1 where key1 = 2 and key2 = 'key2-2';
QUERY: delete from T_pkey1 where key1 = 1 and key2 = 'key1-2';
ERROR: key '1', 'key1-2 ' referenced by T_dta1
QUERY: update T_pkey2 set key2 = 'KEY2-9' where key1 = 2 and key2 = 'KEY2-1';
QUERY: update T_pkey2 set key2 = 'KEY1-9' where key1 = 1 and key2 = 'KEY1-1';
NOTICE: updated 1 entries in T_dta2 for new key in T_pkey2
QUERY: delete from T_pkey2 where key1 = 2 and key2 = 'KEY2-2';
QUERY: delete from T_pkey2 where key1 = 1 and key2 = 'KEY1-2';
NOTICE: deleted 1 entries from T_dta2
QUERY: select * from T_pkey1;
key1|key2 |txt
----+--------------------+----------------------------------------
1|key1-1 |test key
1|key1-2 |test key
1|key1-3 |test key
2|key2-3 |test key
1|KEY1-3 |should work
2|key2-9 |test key
(6 rows)
QUERY: select * from T_pkey2;
key1|key2 |txt
----+--------------------+----------------------------------------
1|KEY1-3 |test key
2|KEY2-3 |test key
2|KEY2-9 |test key
1|KEY1-9 |test key
(4 rows)
QUERY: select * from T_dta1;
tkey |ref1|ref2
----------+----+--------------------
trec 1 | 1|key1-1
trec 2 | 1|key1-2
trec 3 | 1|key1-3
(3 rows)
QUERY: select * from T_dta2;
tkey |ref1|ref2
----------+----+--------------------
trec 3 | 1|KEY1-3
trec 1 | 1|KEY1-9
(2 rows)
QUERY: select tcl_avg(key1) from T_pkey1;
tcl_avg
-------
1
(1 row)
QUERY: select tcl_sum(key1) from T_pkey1;
tcl_sum
-------
8
(1 row)
QUERY: select tcl_avg(key1) from T_pkey2;
tcl_avg
-------
1
(1 row)
QUERY: select tcl_sum(key1) from T_pkey2;
tcl_sum
-------
6
(1 row)
QUERY: select tcl_avg(key1) from T_pkey1 where key1 = 99;
tcl_avg
-------
(1 row)
QUERY: select tcl_sum(key1) from T_pkey1 where key1 = 99;
tcl_sum
-------
0
(1 row)
QUERY: select 1 @< 2;
?column?
--------
t
(1 row)
QUERY: select 100 @< 4;
?column?
--------
f
(1 row)
QUERY: select * from T_pkey1 order by key1 using @<;
key1|key2 |txt
----+--------------------+----------------------------------------
1|key1-1 |test key
1|key1-2 |test key
1|key1-3 |test key
1|KEY1-3 |should work
2|key2-3 |test key
2|key2-9 |test key
(6 rows)
QUERY: select * from T_pkey2 order by key1 using @<;
key1|key2 |txt
----+--------------------+----------------------------------------
1|KEY1-3 |test key
1|KEY1-9 |test key
2|KEY2-3 |test key
2|KEY2-9 |test key
(4 rows)

9
src/pl/tcl/test/test_mklang.sql
Unescape View File

@ -0,0 +1,9 @@
create function pltcl_call_handler() returns opaque
as '/usr/local/pgsql/lib/pltcl.so'
language 'C';
create trusted procedural language 'pltcl'
handler pltcl_call_handler
lancompiler 'PL/Tcl';

73
src/pl/tcl/test/test_queries.sql
Unescape View File

@ -0,0 +1,73 @@
insert into T_pkey1 values (1, 'key1-1', 'test key');
insert into T_pkey1 values (1, 'key1-2', 'test key');
insert into T_pkey1 values (1, 'key1-3', 'test key');
insert into T_pkey1 values (2, 'key2-1', 'test key');
insert into T_pkey1 values (2, 'key2-2', 'test key');
insert into T_pkey1 values (2, 'key2-3', 'test key');
insert into T_pkey2 values (1, 'key1-1', 'test key');
insert into T_pkey2 values (1, 'key1-2', 'test key');
insert into T_pkey2 values (1, 'key1-3', 'test key');
insert into T_pkey2 values (2, 'key2-1', 'test key');
insert into T_pkey2 values (2, 'key2-2', 'test key');
insert into T_pkey2 values (2, 'key2-3', 'test key');
select * from T_pkey1;
-- key2 in T_pkey2 should have upper case only
select * from T_pkey2;
insert into T_pkey1 values (1, 'KEY1-3', 'should work');
-- Due to the upper case translation in trigger this must fail
insert into T_pkey2 values (1, 'KEY1-3', 'should fail');
insert into T_dta1 values ('trec 1', 1, 'key1-1');
insert into T_dta1 values ('trec 2', 1, 'key1-2');
insert into T_dta1 values ('trec 3', 1, 'key1-3');
-- Must fail due to unknown key in T_pkey1
insert into T_dta1 values ('trec 4', 1, 'key1-4');
insert into T_dta2 values ('trec 1', 1, 'KEY1-1');
insert into T_dta2 values ('trec 2', 1, 'KEY1-2');
insert into T_dta2 values ('trec 3', 1, 'KEY1-3');
-- Must fail due to unknown key in T_pkey2
insert into T_dta2 values ('trec 4', 1, 'KEY1-4');
select * from T_dta1;
select * from T_dta2;
update T_pkey1 set key2 = 'key2-9' where key1 = 2 and key2 = 'key2-1';
update T_pkey1 set key2 = 'key1-9' where key1 = 1 and key2 = 'key1-1';
delete from T_pkey1 where key1 = 2 and key2 = 'key2-2';
delete from T_pkey1 where key1 = 1 and key2 = 'key1-2';
update T_pkey2 set key2 = 'KEY2-9' where key1 = 2 and key2 = 'KEY2-1';
update T_pkey2 set key2 = 'KEY1-9' where key1 = 1 and key2 = 'KEY1-1';
delete from T_pkey2 where key1 = 2 and key2 = 'KEY2-2';
delete from T_pkey2 where key1 = 1 and key2 = 'KEY1-2';
select * from T_pkey1;
select * from T_pkey2;
select * from T_dta1;
select * from T_dta2;
select tcl_avg(key1) from T_pkey1;
select tcl_sum(key1) from T_pkey1;
select tcl_avg(key1) from T_pkey2;
select tcl_sum(key1) from T_pkey2;
-- The following should return NULL instead of 0
select tcl_avg(key1) from T_pkey1 where key1 = 99;
select tcl_sum(key1) from T_pkey1 where key1 = 99;
select 1 @< 2;
select 100 @< 4;
select * from T_pkey1 order by key1 using @<;
select * from T_pkey2 order by key1 using @<;

426
src/pl/tcl/test/test_setup.sql
Unescape View File

@ -0,0 +1,426 @@
--
-- Create the tables used in the test queries
--
-- T_pkey1 is the primary key table for T_dta1. Entries from T_pkey1
-- Cannot be changed or deleted if they are referenced from T_dta1.
--
-- T_pkey2 is the primary key table for T_dta2. If the key values in
-- T_pkey2 are changed, the references in T_dta2 follow. If entries
-- are deleted, the referencing entries from T_dta2 are deleted too.
-- The values for field key2 in T_pkey2 are silently converted to
-- upper case on insert/update.
--
create table T_pkey1 (
key1 int4,
key2 char(20),
txt char(40)
);
create table T_pkey2 (
key1 int4,
key2 char(20),
txt char(40)
);
create table T_dta1 (
tkey char(10),
ref1 int4,
ref2 char(20)
);
create table T_dta2 (
tkey char(10),
ref1 int4,
ref2 char(20)
);
--
-- Function to check key existance in T_pkey1
--
create function check_pkey1_exists(int4, bpchar) returns bool as '
if {![info exists GD]} {
set GD(plan) [spi_prepare \\
"select 1 from T_pkey1 \\
where key1 = \\$1 and key2 = \\$2" \\
{int4 bpchar}]
}
set n [spi_execp -count 1 $GD(plan) [list $1 $2]]
if {$n > 0} {
return "t"
}
return "f"
' language 'pltcl';
--
-- Trigger function on every change to T_pkey1
--
create function trig_pkey1_before() returns opaque as '
#
# Create prepared plans on the first call
#
if {![info exists GD]} {
#
# Plan to check for duplicate key in T_pkey1
#
set GD(plan_pkey1) [spi_prepare \\
"select check_pkey1_exists(\\$1, \\$2) as ret" \\
{int4 bpchar}]
#
# Plan to check for references from T_dta1
#
set GD(plan_dta1) [spi_prepare \\
"select 1 from T_dta1 \\
where ref1 = \\$1 and ref2 = \\$2" \\
{int4 bpchar}]
}
#
# Initialize flags
#
set check_old_ref 0
set check_new_dup 0
switch $TG_op {
INSERT {
#
# Must check for duplicate key on INSERT
#
set check_new_dup 1
}
UPDATE {
#
# Must check for duplicate key on UPDATE only if
# the key changes. In that case we must check for
# references to OLD values too.
#
if {[string compare $NEW(key1) $OLD(key1)] != 0} {
set check_old_ref 1
set check_new_dup 1
}
if {[string compare $NEW(key2) $OLD(key2)] != 0} {
set check_old_ref 1
set check_new_dup 1
}
}
DELETE {
#
# Must only check for references to OLD on DELETE
#
set check_old_ref 1
}
}
if {$check_new_dup} {
#
# Check for duplicate key
#
spi_execp -count 1 $GD(plan_pkey1) [list $NEW(key1) $NEW(key2)]
if {$ret == "t"} {
elog WARN \\
"duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey1"
}
}
if {$check_old_ref} {
#
# Check for references to OLD
#
set n [spi_execp -count 1 $GD(plan_dta1) [list $OLD(key1) $OLD(key2)]]
if {$n > 0} {
elog WARN \\
"key ''$OLD(key1)'', ''$OLD(key2)'' referenced by T_dta1"
}
}
#
# Anything is fine - let operation pass through
#
return OK
' language 'pltcl';
create trigger pkey1_before before insert or update or delete on T_pkey1
for each row execute procedure
trig_pkey1_before();
--
-- Trigger function to check for duplicate keys in T_pkey2
-- and to force key2 to be upper case only without leading whitespaces
--
create function trig_pkey2_before() returns opaque as '
#
# Prepare plan on first call
#
if {![info exists GD]} {
set GD(plan_pkey2) [spi_prepare \\
"select 1 from T_pkey2 \\
where key1 = \\$1 and key2 = \\$2" \\
{int4 bpchar}]
}
#
# Convert key2 value
#
set NEW(key2) [string toupper [string trim $NEW(key2)]]
#
# Check for duplicate key
#
set n [spi_execp -count 1 $GD(plan_pkey2) [list $NEW(key1) $NEW(key2)]]
if {$n > 0} {
elog WARN \\
"duplicate key ''$NEW(key1)'', ''$NEW(key2)'' for T_pkey2"
}
#
# Return modified tuple in NEW
#
return [array get NEW]
' language 'pltcl';
create trigger pkey2_before before insert or update on T_pkey2
for each row execute procedure
trig_pkey2_before();
--
-- Trigger function to force references from T_dta2 follow changes
-- in T_pkey2 or be deleted too. This must be done AFTER the changes
-- in T_pkey2 are done so the trigger for primkey check on T_dta2
-- fired on our updates will see the new key values in T_pkey2.
--
create function trig_pkey2_after() returns opaque as '
#
# Prepare plans on first call
#
if {![info exists GD]} {
#
# Plan to update references from T_dta2
#
set GD(plan_dta2_upd) [spi_prepare \\
"update T_dta2 set ref1 = \\$3, ref2 = \\$4 \\
where ref1 = \\$1 and ref2 = \\$2" \\
{int4 bpchar int4 bpchar}]
#
# Plan to delete references from T_dta2
#
set GD(plan_dta2_del) [spi_prepare \\
"delete from T_dta2 \\
where ref1 = \\$1 and ref2 = \\$2" \\
{int4 bpchar}]
}
#
# Initialize flags
#
set old_ref_follow 0
set old_ref_delete 0
switch $TG_op {
UPDATE {
#
# On update we must let old references follow
#
set NEW(key2) [string toupper $NEW(key2)]
if {[string compare $NEW(key1) $OLD(key1)] != 0} {
set old_ref_follow 1
}
if {[string compare $NEW(key2) $OLD(key2)] != 0} {
set old_ref_follow 1
}
}
DELETE {
#
# On delete we must delete references too
#
set old_ref_delete 1
}
}
if {$old_ref_follow} {
#
# Let old references follow and fire NOTICE message if
# there where some
#
set n [spi_execp $GD(plan_dta2_upd) \\
[list $OLD(key1) $OLD(key2) $NEW(key1) $NEW(key2)]]
if {$n > 0} {
elog NOTICE \\
"updated $n entries in T_dta2 for new key in T_pkey2"
}
}
if {$old_ref_delete} {
#
# delete references and fire NOTICE message if
# there where some
#
set n [spi_execp $GD(plan_dta2_del) \\
[list $OLD(key1) $OLD(key2)]]
if {$n > 0} {
elog NOTICE \\
"deleted $n entries from T_dta2"
}
}
return OK
' language 'pltcl';
create trigger pkey2_after after update or delete on T_pkey2
for each row execute procedure
trig_pkey2_after();
--
-- Generic trigger function to check references in T_dta1 and T_dta2
--
create function check_primkey() returns opaque as '
#
# For every trigger/relation pair we create
# a saved plan and hold them in GD
#
set plankey [list "plan" $TG_name $TG_relid]
set planrel [list "relname" $TG_relid]
#
# Extract the pkey relation name
#
set keyidx [expr [llength $args] / 2]
set keyrel [string tolower [lindex $args $keyidx]]
if {![info exists GD($plankey)]} {
#
# We must prepare a new plan. Build up a query string
# for the primary key check.
#
set keylist [lrange $args [expr $keyidx + 1] end]
set query "select 1 from $keyrel"
set qual " where"
set typlist ""
set idx 1
foreach key $keylist {
set key [string tolower $key]
#
# Add the qual part to the query string
#
append query "$qual $key = \\$$idx"
set qual " and"
#
# Lookup the fields type in pg_attribute
#
set n [spi_exec "select T.typname \\
from pg_type T, pg_attribute A, pg_class C \\
where C.relname = ''[quote $keyrel]'' \\
and C.oid = A.attrelid \\
and A.attname = ''[quote $key]'' \\
and A.atttypid = T.oid"]
if {$n != 1} {
elog WARN "table $keyrel doesn''t have a field named $key"
}
#
# Append the fields type to the argument type list
#
lappend typlist $typname
incr idx
}
#
# Prepare the plan
#
set GD($plankey) [spi_prepare $query $typlist]
#
# Lookup and remember the table name for later error messages
#
spi_exec "select relname from pg_class \\
where oid = ''$TG_relid''::oid"
set GD($planrel) $relname
}
#
# Build the argument list from the NEW row
#
incr keyidx -1
set arglist ""
foreach arg [lrange $args 0 $keyidx] {
lappend arglist $NEW($arg)
}
#
# Check for the primary key
#
set n [spi_execp -count 1 $GD($plankey) $arglist]
if {$n <= 0} {
elog WARN "key for $GD($planrel) not in $keyrel"
}
#
# Anything is fine
#
return OK
' language 'pltcl';
create trigger dta1_before before insert or update on T_dta1
for each row execute procedure
check_primkey('ref1', 'ref2', 'T_pkey1', 'key1', 'key2');
create trigger dta2_before before insert or update on T_dta2
for each row execute procedure
check_primkey('ref1', 'ref2', 'T_pkey2', 'key1', 'key2');
create function tcl_int4add(int4,int4) returns int4 as '
return [expr $1 + $2]
' language 'pltcl';
create function tcl_int4div(int4,int4) returns int4 as '
return [expr $1 / $2]
' language 'pltcl';
create function tcl_int4inc(int4) returns int4 as '
return [expr $1 + 1]
' language 'pltcl';
create aggregate tcl_avg (
sfunc1 = tcl_int4add,
basetype = int4,
stype1 = int4,
sfunc2 = tcl_int4inc,
stype2 = int4,
finalfunc = tcl_int4div,
initcond2 = '0'
);
create aggregate tcl_sum (
sfunc1 = tcl_int4add,
basetype = int4,
stype1 = int4,
initcond1 = '0'
);
create function tcl_int4lt(int4,int4) returns bool as '
if {$1 < $2} {
return t
}
return f
' language 'pltcl';
create operator @< (
leftarg = int4,
rightarg = int4,
procedure = tcl_int4lt
);
Write Preview
Loading…
Cancel
Save