Skip to content

Commit 11a0c37

Browse files
author
Neil Conway
committed
Add regression tests for previously-untested PL/Perl features. From
Andrew Dunstan.
1 parent 443f217 commit 11a0c37

File tree

5 files changed

+178
-2
lines changed

5 files changed

+178
-2
lines changed

‎src/pl/plperl/GNUmakefile

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
# Makefile for PL/Perl
2-
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.20 2005/05/17 18:26:22 tgl Exp $
2+
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.21 2005/05/24 08:05:36 neilc Exp $
33

44
subdir = src/pl/plperl
55
top_builddir = ../../..
@@ -37,7 +37,7 @@ OBJS = plperl.o spi_internal.o SPI.o
3737
SHLIB_LINK = $(perl_embed_ldflags) $(BE_DLLLIBS)
3838

3939
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl
40-
REGRESS = plperl
40+
REGRESS = plperl plperl_trigger plperl_shared
4141

4242
include $(top_srcdir)/src/Makefile.shlib
4343

‎src/pl/plperl/expected/plperl_shared.out

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
-- test the shared hash
2+
create function setme(key text, val text) returns void language plperl as $$
3+
4+
my $key = shift;
5+
my $val = shift;
6+
$_SHARED{$key}= $val;
7+
8+
$$;
9+
create function getme(key text) returns text language plperl as $$
10+
11+
my $key = shift;
12+
return $_SHARED{$key};
13+
14+
$$;
15+
select setme('ourkey','ourval');
16+
setme
17+
-------
18+
19+
(1 row)
20+
21+
select getme('ourkey');
22+
getme
23+
--------
24+
ourval
25+
(1 row)
26+

‎src/pl/plperl/expected/plperl_trigger.out

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,67 @@
1+
-- test plperl triggers
2+
CREATE TABLE trigger_test (
3+
i int,
4+
v varchar
5+
);
6+
CREATE OR REPLACE FUNCTION valid_id() RETURNS trigger AS $$
7+
8+
if (($_TD->{new}{i}>=100) || ($_TD->{new}{i}<=0))
9+
{
10+
return "SKIP"; # Skip INSERT/UPDATE command
11+
}
12+
elsif ($_TD->{new}{v} ne "immortal")
13+
{
14+
$_TD->{new}{v} .= "(modified by trigger)";
15+
return "MODIFY"; # Modify tuple and proceed INSERT/UPDATE command
16+
}
17+
else
18+
{
19+
return; # Proceed INSERT/UPDATE command
20+
}
21+
$$ LANGUAGE plperl;
22+
CREATE TRIGGER "test_valid_id_trig" BEFORE INSERT OR UPDATE ON trigger_test
23+
FOR EACH ROW EXECUTE PROCEDURE "valid_id"();
24+
INSERT INTO trigger_test (i, v) VALUES (1,'first line');
25+
INSERT INTO trigger_test (i, v) VALUES (2,'second line');
26+
INSERT INTO trigger_test (i, v) VALUES (3,'third line');
27+
INSERT INTO trigger_test (i, v) VALUES (4,'immortal');
28+
INSERT INTO trigger_test (i, v) VALUES (101,'bad id');
29+
SELECT * FROM trigger_test;
30+
i | v
31+
---+----------------------------------
32+
1 | first line(modified by trigger)
33+
2 | second line(modified by trigger)
34+
3 | third line(modified by trigger)
35+
4 | immortal
36+
(4 rows)
37+
38+
UPDATE trigger_test SET i = 5 where i=3;
39+
UPDATE trigger_test SET i = 100 where i=1;
40+
SELECT * FROM trigger_test;
41+
i | v
42+
---+------------------------------------------------------
43+
1 | first line(modified by trigger)
44+
2 | second line(modified by trigger)
45+
4 | immortal
46+
5 | third line(modified by trigger)(modified by trigger)
47+
(4 rows)
48+
49+
CREATE OR REPLACE FUNCTION immortal() RETURNS trigger AS $$
50+
if ($_TD->{old}{v} eq $_TD->{args}[0])
51+
{
52+
return "SKIP"; # Skip DELETE command
53+
}
54+
else
55+
{
56+
return; # Proceed DELETE command
57+
};
58+
$$ LANGUAGE plperl;
59+
CREATE TRIGGER "immortal_trig" BEFORE DELETE ON trigger_test
60+
FOR EACH ROW EXECUTE PROCEDURE immortal('immortal');
61+
DELETE FROM trigger_test;
62+
SELECT * FROM trigger_test;
63+
i | v
64+
---+----------
65+
4 | immortal
66+
(1 row)
67+

‎src/pl/plperl/sql/plperl_shared.sql

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
-- test the shared hash
2+
3+
create function setme(key text, val text) returns void language plperl as $$
4+
5+
my $key = shift;
6+
my $val = shift;
7+
$_SHARED{$key}= $val;
8+
9+
$$;
10+
11+
create function getme(key text) returns text language plperl as $$
12+
13+
my $key = shift;
14+
return $_SHARED{$key};
15+
16+
$$;
17+
18+
select setme('ourkey','ourval');
19+
20+
select getme('ourkey');
21+
22+

‎src/pl/plperl/sql/plperl_trigger.sql

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
-- test plperl triggers
2+
3+
CREATE TABLE trigger_test (
4+
i int,
5+
v varchar
6+
);
7+
8+
CREATE OR REPLACE FUNCTION valid_id() RETURNS trigger AS $$
9+
10+
if (($_TD->{new}{i}>=100) || ($_TD->{new}{i}<=0))
11+
{
12+
return "SKIP"; # Skip INSERT/UPDATE command
13+
}
14+
elsif ($_TD->{new}{v} ne "immortal")
15+
{
16+
$_TD->{new}{v} .= "(modified by trigger)";
17+
return "MODIFY"; # Modify tuple and proceed INSERT/UPDATE command
18+
}
19+
else
20+
{
21+
return; # Proceed INSERT/UPDATE command
22+
}
23+
$$ LANGUAGE plperl;
24+
25+
CREATE TRIGGER "test_valid_id_trig" BEFORE INSERT OR UPDATE ON trigger_test
26+
FOR EACH ROW EXECUTE PROCEDURE "valid_id"();
27+
28+
INSERT INTO trigger_test (i, v) VALUES (1,'first line');
29+
INSERT INTO trigger_test (i, v) VALUES (2,'second line');
30+
INSERT INTO trigger_test (i, v) VALUES (3,'third line');
31+
INSERT INTO trigger_test (i, v) VALUES (4,'immortal');
32+
33+
INSERT INTO trigger_test (i, v) VALUES (101,'bad id');
34+
35+
SELECT * FROM trigger_test;
36+
37+
UPDATE trigger_test SET i = 5 where i=3;
38+
39+
UPDATE trigger_test SET i = 100 where i=1;
40+
41+
SELECT * FROM trigger_test;
42+
43+
CREATE OR REPLACE FUNCTION immortal() RETURNS trigger AS $$
44+
if ($_TD->{old}{v} eq $_TD->{args}[0])
45+
{
46+
return "SKIP"; # Skip DELETE command
47+
}
48+
else
49+
{
50+
return; # Proceed DELETE command
51+
};
52+
$$ LANGUAGE plperl;
53+
54+
CREATE TRIGGER "immortal_trig" BEFORE DELETE ON trigger_test
55+
FOR EACH ROW EXECUTE PROCEDURE immortal('immortal');
56+
57+
DELETE FROM trigger_test;
58+
59+
60+
SELECT * FROM trigger_test;
61+

0 commit comments

Comments
 (0)