Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit11a0c37

Browse files
author
Neil Conway
committed
Add regression tests for previously-untested PL/Perl features. From
Andrew Dunstan.
1 parent443f217 commit11a0c37

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

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+
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+
createfunctionsetme(keytext, valtext) returns void language plperlas $$
4+
5+
my $key= shift;
6+
my $val= shift;
7+
$_SHARED{$key}= $val;
8+
9+
$$;
10+
11+
createfunctiongetme(keytext) returnstext language plperlas $$
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+
CREATETABLEtrigger_test (
4+
iint,
5+
vvarchar
6+
);
7+
8+
CREATE OR REPLACEFUNCTIONvalid_id() RETURNS triggerAS $$
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+
CREATETRIGGER "test_valid_id_trig" BEFORE INSERTORUPDATEON 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_testSET i=5where i=3;
38+
39+
UPDATE trigger_testSET i=100where i=1;
40+
41+
SELECT*FROM trigger_test;
42+
43+
CREATE OR REPLACEFUNCTIONimmortal() RETURNS triggerAS $$
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+
CREATETRIGGER "immortal_trig" BEFOREDELETEON trigger_test
55+
FOR EACH ROW EXECUTE PROCEDURE immortal('immortal');
56+
57+
DELETEFROM trigger_test;
58+
59+
60+
SELECT*FROM trigger_test;
61+

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp