mirrors/postgres
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add regression tests for previously-untested PL/Perl features. From

Browse Source 
Andrew Dunstan.
This commit is contained in:
Neil Conway 2005-05-24 08:05:36 +00:00
parent 443f21737d
commit 11a0c3741f
5 changed files with 178 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/pl/plperl/GNUmakefile
View File

@ -1,5 +1,5 @@
# Makefile for PL/Perl
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.20 2005/05/17 18:26:22 tgl Exp $
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.21 2005/05/24 08:05:36 neilc Exp $
subdir = src/pl/plperl
top_builddir = ../../..
@ -37,7 +37,7 @@ OBJS = plperl.o spi_internal.o SPI.o
SHLIB_LINK = $(perl_embed_ldflags) $(BE_DLLLIBS)
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl
REGRESS = plperl
REGRESS = plperl plperl_trigger plperl_shared
include $(top_srcdir)/src/Makefile.shlib

26
src/pl/plperl/expected/plperl_shared.out Normal file
View File

@ -0,0 +1,26 @@
-- test the shared hash
create function setme(key text, val text) returns void language plperl as $$
my $key = shift;
my $val = shift;
$_SHARED{$key}= $val;
$$;
create function getme(key text) returns text language plperl as $$
my $key = shift;
return $_SHARED{$key};
$$;
select setme('ourkey','ourval');
setme
-------
(1 row)
select getme('ourkey');
getme
--------
ourval
(1 row)

67
src/pl/plperl/expected/plperl_trigger.out Normal file
View File

@ -0,0 +1,67 @@
-- test plperl triggers
CREATE TABLE trigger_test (
i int,
v varchar
);
CREATE OR REPLACE FUNCTION valid_id() RETURNS trigger AS $$
if (($_TD->{new}{i}>=100) || ($_TD->{new}{i}<=0))
{
return "SKIP"; # Skip INSERT/UPDATE command
}
elsif ($_TD->{new}{v} ne "immortal")
{
$_TD->{new}{v} .= "(modified by trigger)";
return "MODIFY"; # Modify tuple and proceed INSERT/UPDATE command
}
else
{
return; # Proceed INSERT/UPDATE command
}
$$ LANGUAGE plperl;
CREATE TRIGGER "test_valid_id_trig" BEFORE INSERT OR UPDATE ON trigger_test
FOR EACH ROW EXECUTE PROCEDURE "valid_id"();
INSERT INTO trigger_test (i, v) VALUES (1,'first line');
INSERT INTO trigger_test (i, v) VALUES (2,'second line');
INSERT INTO trigger_test (i, v) VALUES (3,'third line');
INSERT INTO trigger_test (i, v) VALUES (4,'immortal');
INSERT INTO trigger_test (i, v) VALUES (101,'bad id');
SELECT * FROM trigger_test;
i | v
---+----------------------------------
1 | first line(modified by trigger)
2 | second line(modified by trigger)
3 | third line(modified by trigger)
4 | immortal
(4 rows)
UPDATE trigger_test SET i = 5 where i=3;
UPDATE trigger_test SET i = 100 where i=1;
SELECT * FROM trigger_test;
i | v
---+------------------------------------------------------
1 | first line(modified by trigger)
2 | second line(modified by trigger)
4 | immortal
5 | third line(modified by trigger)(modified by trigger)
(4 rows)
CREATE OR REPLACE FUNCTION immortal() RETURNS trigger AS $$
if ($_TD->{old}{v} eq $_TD->{args}[0])
{
return "SKIP"; # Skip DELETE command
}
else
{
return; # Proceed DELETE command
};
$$ LANGUAGE plperl;
CREATE TRIGGER "immortal_trig" BEFORE DELETE ON trigger_test
FOR EACH ROW EXECUTE PROCEDURE immortal('immortal');
DELETE FROM trigger_test;
SELECT * FROM trigger_test;
i | v
---+----------
4 | immortal
(1 row)

22
src/pl/plperl/sql/plperl_shared.sql Normal file
View File

@ -0,0 +1,22 @@
-- test the shared hash
create function setme(key text, val text) returns void language plperl as $$
my $key = shift;
my $val = shift;
$_SHARED{$key}= $val;
$$;
create function getme(key text) returns text language plperl as $$
my $key = shift;
return $_SHARED{$key};
$$;
select setme('ourkey','ourval');
select getme('ourkey');

61
src/pl/plperl/sql/plperl_trigger.sql Normal file
View File

@ -0,0 +1,61 @@
-- test plperl triggers
CREATE TABLE trigger_test (
i int,
v varchar
);
CREATE OR REPLACE FUNCTION valid_id() RETURNS trigger AS $$
if (($_TD->{new}{i}>=100) || ($_TD->{new}{i}<=0))
{
return "SKIP"; # Skip INSERT/UPDATE command
}
elsif ($_TD->{new}{v} ne "immortal")
{
$_TD->{new}{v} .= "(modified by trigger)";
return "MODIFY"; # Modify tuple and proceed INSERT/UPDATE command
}
else
{
return; # Proceed INSERT/UPDATE command
}
$$ LANGUAGE plperl;
CREATE TRIGGER "test_valid_id_trig" BEFORE INSERT OR UPDATE ON trigger_test
FOR EACH ROW EXECUTE PROCEDURE "valid_id"();
INSERT INTO trigger_test (i, v) VALUES (1,'first line');
INSERT INTO trigger_test (i, v) VALUES (2,'second line');
INSERT INTO trigger_test (i, v) VALUES (3,'third line');
INSERT INTO trigger_test (i, v) VALUES (4,'immortal');
INSERT INTO trigger_test (i, v) VALUES (101,'bad id');
SELECT * FROM trigger_test;
UPDATE trigger_test SET i = 5 where i=3;
UPDATE trigger_test SET i = 100 where i=1;
SELECT * FROM trigger_test;
CREATE OR REPLACE FUNCTION immortal() RETURNS trigger AS $$
if ($_TD->{old}{v} eq $_TD->{args}[0])
{
return "SKIP"; # Skip DELETE command
}
else
{
return; # Proceed DELETE command
};
$$ LANGUAGE plperl;
CREATE TRIGGER "immortal_trig" BEFORE DELETE ON trigger_test
FOR EACH ROW EXECUTE PROCEDURE immortal('immortal');
DELETE FROM trigger_test;
SELECT * FROM trigger_test;