From 11a0c3741f3c41a5dadaa6788e02ba58a6f7b0a2 Mon Sep 17 00:00:00 2001 From: Neil Conway Date: Tue, 24 May 2005 08:05:36 +0000 Subject: [PATCH] Add regression tests for previously-untested PL/Perl features. From Andrew Dunstan. --- src/pl/plperl/GNUmakefile | 4 +- src/pl/plperl/expected/plperl_shared.out | 26 +++++++++ src/pl/plperl/expected/plperl_trigger.out | 67 +++++++++++++++++++++++ src/pl/plperl/sql/plperl_shared.sql | 22 ++++++++ src/pl/plperl/sql/plperl_trigger.sql | 61 +++++++++++++++++++++ 5 files changed, 178 insertions(+), 2 deletions(-) create mode 100644 src/pl/plperl/expected/plperl_shared.out create mode 100644 src/pl/plperl/expected/plperl_trigger.out create mode 100644 src/pl/plperl/sql/plperl_shared.sql create mode 100644 src/pl/plperl/sql/plperl_trigger.sql diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile index 509c4634b3..2afaa80775 100644 --- a/src/pl/plperl/GNUmakefile +++ b/src/pl/plperl/GNUmakefile @@ -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 diff --git a/src/pl/plperl/expected/plperl_shared.out b/src/pl/plperl/expected/plperl_shared.out new file mode 100644 index 0000000000..72ae1ba7be --- /dev/null +++ b/src/pl/plperl/expected/plperl_shared.out @@ -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) + diff --git a/src/pl/plperl/expected/plperl_trigger.out b/src/pl/plperl/expected/plperl_trigger.out new file mode 100644 index 0000000000..9c0bae9d36 --- /dev/null +++ b/src/pl/plperl/expected/plperl_trigger.out @@ -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) + diff --git a/src/pl/plperl/sql/plperl_shared.sql b/src/pl/plperl/sql/plperl_shared.sql new file mode 100644 index 0000000000..3e99e59049 --- /dev/null +++ b/src/pl/plperl/sql/plperl_shared.sql @@ -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'); + + diff --git a/src/pl/plperl/sql/plperl_trigger.sql b/src/pl/plperl/sql/plperl_trigger.sql new file mode 100644 index 0000000000..34ce9c484a --- /dev/null +++ b/src/pl/plperl/sql/plperl_trigger.sql @@ -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; + -- 2.40.0