#
# Copyright (c) 1994, Regents of the University of California
#
-# $PostgreSQL: pgsql/src/pl/Makefile,v 1.22 2003/11/29 19:52:12 pgsql Exp $
+# $PostgreSQL: pgsql/src/pl/Makefile,v 1.23 2005/05/14 17:55:20 tgl Exp $
#
#-------------------------------------------------------------------------
DIRS := plpgsql
-ifeq ($(with_tcl), yes)
-DIRS += tcl
-endif
-
ifeq ($(with_perl), yes)
DIRS += plperl
endif
DIRS += plpython
endif
+ifeq ($(with_tcl), yes)
+DIRS += tcl
+endif
+
all install installdirs uninstall depend distprep:
- @for dir in $(DIRS); do $(MAKE) -C $$dir $@ || exit; done
+ @for dir in $(DIRS); do $(MAKE) -C $$dir $@ || exit 1; done
clean distclean maintainer-clean:
@for dir in $(DIRS); do $(MAKE) -C $$dir $@; done
+
+# We'd like check operations to run all the subtests before failing;
+# also insert a sleep to ensure the previous test backend exited before
+# we try to drop the regression database.
+check installcheck:
+ @CHECKERR=0; for dir in $(DIRS); do \
+ sleep 1; \
+ $(MAKE) -C $$dir $@ || CHECKERR=$$?; \
+ done; \
+ exit $$CHECKERR
# Makefile for PL/Perl
-# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.18 2004/11/19 19:22:58 tgl Exp $
+# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.19 2005/05/14 17:55:20 tgl Exp $
subdir = src/pl/plperl
top_builddir = ../../..
SHLIB_LINK = $(perl_embed_ldflags) $(BE_DLLLIBS)
+REGRESS = plperl
+
include $(top_srcdir)/src/Makefile.shlib
uninstall:
rm -f $(DESTDIR)$(pkglibdir)/plperl$(DLSUFFIX)
+installcheck: submake
+ $(SHELL) $(top_builddir)/src/test/regress/pg_regress --load-language=plperl $(REGRESS)
+
+.PHONY: submake
+submake:
+ $(MAKE) -C $(top_builddir)/src/test/regress pg_regress
+
clean distclean maintainer-clean: clean-lib
rm -f SPI.c $(OBJS)
+ rm -rf results
+ rm -f regression.diffs regression.out
else # can't build
+--
+-- checkpoint so that if we have a crash in the tests, replay of the
+-- just-completed CREATE DATABASE won't discard the core dump file
+--
checkpoint;
+--
+-- Test result value processing
+--
CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$
return undef;
$$ LANGUAGE plperl;
PL/Perl
(3 rows)
+--
+-- Check behavior with erroneous return values
+--
CREATE TYPE footype AS (x INTEGER, y INTEGER);
CREATE OR REPLACE FUNCTION foo_good() RETURNS SETOF footype AS $$
return [
$$ LANGUAGE plperl;
SELECT * FROM foo_set_bad();
ERROR: Perl hash contains nonexistent column "z"
+--
+-- Check passing a tuple argument
+--
CREATE OR REPLACE FUNCTION perl_get_field(footype, text) RETURNS integer AS $$
return $_[0]->{$_[1]};
$$ LANGUAGE plperl;
+++ /dev/null
-#!/bin/sh
-
-DBNAME=plperl_test
-export DBNAME
-
-echo "**** Destroy old database $DBNAME ****"
-dropdb $DBNAME
-
-sleep 1
-
-echo "**** Create test database $DBNAME ****"
-createdb $DBNAME || exit 1
-
-echo "**** Create procedural language plperl ****"
-createlang plperl $DBNAME || exit 1
-
-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."
- rm test.out
-else
- echo " Tests failed - look at diffs between"
- echo " test.expected and test.out"
-fi
-# $PostgreSQL: pgsql/src/pl/plpython/Makefile,v 1.18 2004/11/19 19:23:01 tgl Exp $
+# $PostgreSQL: pgsql/src/pl/plpython/Makefile,v 1.19 2005/05/14 17:55:21 tgl Exp $
subdir = src/pl/plpython
top_builddir = ../../..
SHLIB_LINK = $(BE_DLLLIBS) $(python_libspec) $(python_additional_libs)
+REGRESS = plpython_schema plpython_populate plpython_function plpython_test plpython_error plpython_drop
+
include $(top_srcdir)/src/Makefile.shlib
uninstall:
rm -f $(DESTDIR)$(pkglibdir)/plpython$(DLSUFFIX)
+installcheck: submake
+ $(SHELL) $(top_builddir)/src/test/regress/pg_regress --load-language=plpythonu $(REGRESS)
+
+.PHONY: submake
+submake:
+ $(MAKE) -C $(top_builddir)/src/test/regress pg_regress
+
clean distclean maintainer-clean: clean-lib
rm -f $(OBJS)
- @rm -f error.diff feature.diff error.output feature.output test.log
+ rm -rf results
+ rm -f regression.diffs regression.out
ifeq ($(PORTNAME), win32)
rm -f python${pytverstr}.def
endif
-installcheck:
- PATH=$(bindir):$$PATH $(SHELL) $(srcdir)/test.sh
-
else # can't build
all:
--- /dev/null
+--
+-- For paranoia's sake, don't leave an untrusted language sitting around
+--
+SET client_min_messages = WARNING;
+DROP PROCEDURAL LANGUAGE plpythonu CASCADE;
+-- test error handling, i forgot to restore Warn_restart in
+-- the trigger handler once. the errors and subsequent core dump were
+-- interesting.
SELECT invalid_type_uncaught('rick');
WARNING: plpython: in function invalid_type_uncaught:
DETAIL: plpy.SPIError: Unknown error in PLy_spi_prepare
(1 row)
+-- Security sandbox tests
SELECT write_file('/tmp/plpython','Only trusted users should be able to do this!');
write_file
------------------------------
--- /dev/null
+CREATE FUNCTION global_test_one() returns text
+ AS
+'if not SD.has_key("global_test"):
+ SD["global_test"] = "set by global_test_one"
+if not GD.has_key("global_test"):
+ GD["global_test"] = "set by global_test_one"
+return "SD: " + SD["global_test"] + ", GD: " + GD["global_test"]'
+ LANGUAGE plpythonu;
+CREATE FUNCTION global_test_two() returns text
+ AS
+'if not SD.has_key("global_test"):
+ SD["global_test"] = "set by global_test_two"
+if not GD.has_key("global_test"):
+ GD["global_test"] = "set by global_test_two"
+return "SD: " + SD["global_test"] + ", GD: " + GD["global_test"]'
+ LANGUAGE plpythonu;
+CREATE FUNCTION static_test() returns int4
+ AS
+'if SD.has_key("call"):
+ SD["call"] = SD["call"] + 1
+else:
+ SD["call"] = 1
+return SD["call"]
+'
+ LANGUAGE plpythonu;
+-- import python modules
+CREATE FUNCTION import_fail() returns text
+ AS
+'try:
+ import foosocket
+except Exception, ex:
+ plpy.notice("import socket failed -- %s" % str(ex))
+ return "failed as expected"
+return "succeeded, that wasn''t supposed to happen"'
+ LANGUAGE plpythonu;
+CREATE FUNCTION import_succeed() returns text
+ AS
+'try:
+ import array
+ import bisect
+ import calendar
+ import cmath
+ import errno
+ import math
+ import md5
+ import operator
+ import random
+ import re
+ import sha
+ import string
+ import time
+ import whrandom
+except Exception, ex:
+ plpy.notice("import failed -- %s" % str(ex))
+ return "failed, that wasn''t supposed to happen"
+return "succeeded, as expected"'
+ LANGUAGE plpythonu;
+CREATE FUNCTION import_test_one(text) RETURNS text
+ AS
+'import sha
+digest = sha.new(args[0])
+return digest.hexdigest()'
+ LANGUAGE plpythonu;
+CREATE FUNCTION import_test_two(users) RETURNS text
+ AS
+'import sha
+plain = args[0]["fname"] + args[0]["lname"]
+digest = sha.new(plain);
+return "sha hash of " + plain + " is " + digest.hexdigest()'
+ LANGUAGE plpythonu;
+CREATE FUNCTION argument_test_one(users, text, text) RETURNS text
+ AS
+'keys = args[0].keys()
+keys.sort()
+out = []
+for key in keys:
+ out.append("%s: %s" % (key, args[0][key]))
+words = args[1] + " " + args[2] + " => {" + ", ".join(out) + "}"
+return words'
+ LANGUAGE plpythonu;
+-- these triggers are dedicated to HPHC of RI who
+-- decided that my kid's name was william not willem, and
+-- vigorously resisted all efforts at correction. they have
+-- since gone bankrupt...
+CREATE FUNCTION users_insert() returns trigger
+ AS
+'if TD["new"]["fname"] == None or TD["new"]["lname"] == None:
+ return "SKIP"
+if TD["new"]["username"] == None:
+ TD["new"]["username"] = TD["new"]["fname"][:1] + "_" + TD["new"]["lname"]
+ rv = "MODIFY"
+else:
+ rv = None
+if TD["new"]["fname"] == "william":
+ TD["new"]["fname"] = TD["args"][0]
+ rv = "MODIFY"
+return rv'
+ LANGUAGE plpythonu;
+CREATE FUNCTION users_update() returns trigger
+ AS
+'if TD["event"] == "UPDATE":
+ if TD["old"]["fname"] != TD["new"]["fname"] and TD["old"]["fname"] == TD["args"][0]:
+ return "SKIP"
+return None'
+ LANGUAGE plpythonu;
+CREATE FUNCTION users_delete() RETURNS trigger
+ AS
+'if TD["old"]["fname"] == TD["args"][0]:
+ return "SKIP"
+return None'
+ LANGUAGE plpythonu;
+CREATE TRIGGER users_insert_trig BEFORE INSERT ON users FOR EACH ROW
+ EXECUTE PROCEDURE users_insert ('willem');
+CREATE TRIGGER users_update_trig BEFORE UPDATE ON users FOR EACH ROW
+ EXECUTE PROCEDURE users_update ('willem');
+CREATE TRIGGER users_delete_trig BEFORE DELETE ON users FOR EACH ROW
+ EXECUTE PROCEDURE users_delete ('willem');
+-- nested calls
+--
+CREATE FUNCTION nested_call_one(text) RETURNS text
+ AS
+'q = "SELECT nested_call_two(''%s'')" % args[0]
+r = plpy.execute(q)
+return r[0]'
+ LANGUAGE plpythonu ;
+CREATE FUNCTION nested_call_two(text) RETURNS text
+ AS
+'q = "SELECT nested_call_three(''%s'')" % args[0]
+r = plpy.execute(q)
+return r[0]'
+ LANGUAGE plpythonu ;
+CREATE FUNCTION nested_call_three(text) RETURNS text
+ AS
+'return args[0]'
+ LANGUAGE plpythonu ;
+-- some spi stuff
+CREATE FUNCTION spi_prepared_plan_test_one(text) RETURNS text
+ AS
+'if not SD.has_key("myplan"):
+ q = "SELECT count(*) FROM users WHERE lname = $1"
+ SD["myplan"] = plpy.prepare(q, [ "text" ])
+try:
+ rv = plpy.execute(SD["myplan"], [args[0]])
+ return "there are " + str(rv[0]["count"]) + " " + str(args[0]) + "s"
+except Exception, ex:
+ plpy.error(str(ex))
+return None
+'
+ LANGUAGE plpythonu;
+CREATE FUNCTION spi_prepared_plan_test_nested(text) RETURNS text
+ AS
+'if not SD.has_key("myplan"):
+ q = "SELECT spi_prepared_plan_test_one(''%s'') as count" % args[0]
+ SD["myplan"] = plpy.prepare(q)
+try:
+ rv = plpy.execute(SD["myplan"])
+ if len(rv):
+ return rv[0]["count"]
+except Exception, ex:
+ plpy.error(str(ex))
+return None
+'
+ LANGUAGE plpythonu;
+/* really stupid function just to get the module loaded
+*/
+CREATE FUNCTION stupid() RETURNS text AS 'return "zarkon"' LANGUAGE plpythonu;
+/* a typo
+*/
+CREATE FUNCTION invalid_type_uncaught(text) RETURNS text
+ AS
+'if not SD.has_key("plan"):
+ q = "SELECT fname FROM users WHERE lname = $1"
+ SD["plan"] = plpy.prepare(q, [ "test" ])
+rv = plpy.execute(SD["plan"], [ args[0] ])
+if len(rv):
+ return rv[0]["fname"]
+return None
+'
+ LANGUAGE plpythonu;
+/* for what it's worth catch the exception generated by
+ * the typo, and return None
+ */
+CREATE FUNCTION invalid_type_caught(text) RETURNS text
+ AS
+'if not SD.has_key("plan"):
+ q = "SELECT fname FROM users WHERE lname = $1"
+ try:
+ SD["plan"] = plpy.prepare(q, [ "test" ])
+ except plpy.SPIError, ex:
+ plpy.notice(str(ex))
+ return None
+rv = plpy.execute(SD["plan"], [ args[0] ])
+if len(rv):
+ return rv[0]["fname"]
+return None
+'
+ LANGUAGE plpythonu;
+/* for what it's worth catch the exception generated by
+ * the typo, and reraise it as a plain error
+ */
+CREATE FUNCTION invalid_type_reraised(text) RETURNS text
+ AS
+'if not SD.has_key("plan"):
+ q = "SELECT fname FROM users WHERE lname = $1"
+ try:
+ SD["plan"] = plpy.prepare(q, [ "test" ])
+ except plpy.SPIError, ex:
+ plpy.error(str(ex))
+rv = plpy.execute(SD["plan"], [ args[0] ])
+if len(rv):
+ return rv[0]["fname"]
+return None
+'
+ LANGUAGE plpythonu;
+/* no typo no messing about
+*/
+CREATE FUNCTION valid_type(text) RETURNS text
+ AS
+'if not SD.has_key("plan"):
+ SD["plan"] = plpy.prepare("SELECT fname FROM users WHERE lname = $1", [ "text" ])
+rv = plpy.execute(SD["plan"], [ args[0] ])
+if len(rv):
+ return rv[0]["fname"]
+return None
+'
+ LANGUAGE plpythonu;
+/* Flat out syntax error
+*/
+CREATE FUNCTION sql_syntax_error() RETURNS text
+ AS
+'plpy.execute("syntax error")'
+ LANGUAGE plpythonu;
+/* check the handling of uncaught python exceptions
+ */
+CREATE FUNCTION exception_index_invalid(text) RETURNS text
+ AS
+'return args[1]'
+ LANGUAGE plpythonu;
+/* check handling of nested exceptions
+ */
+CREATE FUNCTION exception_index_invalid_nested() RETURNS text
+ AS
+'rv = plpy.execute("SELECT test5(''foo'')")
+return rv[0]'
+ LANGUAGE plpythonu;
+CREATE FUNCTION join_sequences(sequences) RETURNS text
+ AS
+'if not args[0]["multipart"]:
+ return args[0]["sequence"]
+q = "SELECT sequence FROM xsequences WHERE pid = ''%s''" % args[0]["pid"]
+rv = plpy.execute(q)
+seq = args[0]["sequence"]
+for r in rv:
+ seq = seq + r["sequence"]
+return seq
+'
+ LANGUAGE plpythonu;
+CREATE OR REPLACE FUNCTION read_file(text) RETURNS text AS '
+ return open(args[0]).read()
+' LANGUAGE plpythonu;
+CREATE OR REPLACE FUNCTION write_file(text,text) RETURNS text AS '
+ open(args[0],"w").write(args[1])
+ return "Wrote to file: %s" % args[0]
+' LANGUAGE plpythonu;
+--
+-- Universal Newline Support
+--
+CREATE OR REPLACE FUNCTION newline_lf() RETURNS integer AS
+'x = 100\ny = 23\nreturn x + y\n'
+LANGUAGE plpythonu;
+CREATE OR REPLACE FUNCTION newline_cr() RETURNS integer AS
+'x = 100\ry = 23\rreturn x + y\r'
+LANGUAGE plpythonu;
+CREATE OR REPLACE FUNCTION newline_crlf() RETURNS integer AS
+'x = 100\r\ny = 23\r\nreturn x + y\r\n'
+LANGUAGE plpythonu;
--- /dev/null
+INSERT INTO users (fname, lname, username) VALUES ('jane', 'doe', 'j_doe');
+INSERT INTO users (fname, lname, username) VALUES ('john', 'doe', 'johnd');
+INSERT INTO users (fname, lname, username) VALUES ('willem', 'doe', 'w_doe');
+INSERT INTO users (fname, lname, username) VALUES ('rick', 'smith', 'slash');
+-- multi table tests
+--
+INSERT INTO taxonomy (name) VALUES ('HIV I') ;
+INSERT INTO taxonomy (name) VALUES ('HIV II') ;
+INSERT INTO taxonomy (name) VALUES ('HCV') ;
+INSERT INTO entry (accession, txid) VALUES ('A00001', '1') ;
+INSERT INTO entry (accession, txid) VALUES ('A00002', '1') ;
+INSERT INTO entry (accession, txid) VALUES ('A00003', '1') ;
+INSERT INTO entry (accession, txid) VALUES ('A00004', '2') ;
+INSERT INTO entry (accession, txid) VALUES ('A00005', '2') ;
+INSERT INTO entry (accession, txid) VALUES ('A00006', '3') ;
+INSERT INTO sequences (sequence, eid, product, multipart) VALUES ('ABCDEF', 1, 'env', 'true') ;
+INSERT INTO xsequences (sequence, pid) VALUES ('GHIJKL', 1) ;
+INSERT INTO sequences (sequence, eid, product) VALUES ('ABCDEF', 2, 'env') ;
+INSERT INTO sequences (sequence, eid, product) VALUES ('ABCDEF', 3, 'env') ;
+INSERT INTO sequences (sequence, eid, product) VALUES ('ABCDEF', 4, 'gag') ;
+INSERT INTO sequences (sequence, eid, product) VALUES ('ABCDEF', 5, 'env') ;
+INSERT INTO sequences (sequence, eid, product) VALUES ('ABCDEF', 6, 'ns1') ;
--- /dev/null
+CREATE TABLE users (
+ fname text not null,
+ lname text not null,
+ username text,
+ userid serial,
+ PRIMARY KEY(lname, fname)
+ ) ;
+NOTICE: CREATE TABLE will create implicit sequence "users_userid_seq" for serial column "users.userid"
+NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "users_pkey" for table "users"
+CREATE INDEX users_username_idx ON users(username);
+CREATE INDEX users_fname_idx ON users(fname);
+CREATE INDEX users_lname_idx ON users(lname);
+CREATE INDEX users_userid_idx ON users(userid);
+CREATE TABLE taxonomy (
+ id serial primary key,
+ name text unique
+ ) ;
+NOTICE: CREATE TABLE will create implicit sequence "taxonomy_id_seq" for serial column "taxonomy.id"
+NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "taxonomy_pkey" for table "taxonomy"
+NOTICE: CREATE TABLE / UNIQUE will create implicit index "taxonomy_name_key" for table "taxonomy"
+CREATE TABLE entry (
+ accession text not null primary key,
+ eid serial unique,
+ txid int2 not null references taxonomy(id)
+ ) ;
+NOTICE: CREATE TABLE will create implicit sequence "entry_eid_seq" for serial column "entry.eid"
+NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "entry_pkey" for table "entry"
+NOTICE: CREATE TABLE / UNIQUE will create implicit index "entry_eid_key" for table "entry"
+CREATE TABLE sequences (
+ eid int4 not null references entry(eid),
+ pid serial primary key,
+ product text not null,
+ sequence text not null,
+ multipart bool default 'false'
+ ) ;
+NOTICE: CREATE TABLE will create implicit sequence "sequences_pid_seq" for serial column "sequences.pid"
+NOTICE: CREATE TABLE / PRIMARY KEY will create implicit index "sequences_pkey" for table "sequences"
+CREATE INDEX sequences_product_idx ON sequences(product) ;
+CREATE TABLE xsequences (
+ pid int4 not null references sequences(pid),
+ sequence text not null
+ ) ;
+CREATE INDEX xsequences_pid_idx ON xsequences(pid) ;
+-- first some tests of basic functionality
+--
+-- better succeed
+--
select stupid();
stupid
--------
zarkon
(1 row)
+-- check static and global data
+--
SELECT static_test();
static_test
-------------
SD: set by global_test_two, GD: set by global_test_one
(1 row)
+-- import python modules
+--
SELECT import_fail();
NOTICE: ('import socket failed -- No module named foosocket',)
import_fail
succeeded, as expected
(1 row)
+-- test import and simple argument handling
+--
SELECT import_test_one('sha hash of this string');
import_test_one
------------------------------------------
a04e23cb9b1a09cd1051a04a7c571aae0f90346c
(1 row)
+-- test import and tuple argument handling
+--
select import_test_two(users) from users where fname = 'willem';
import_test_two
-------------------------------------------------------------------
sha hash of willemdoe is 3cde6b574953b0ca937b4d76ebc40d534d910759
(1 row)
+-- test multiple arguments
+--
select argument_test_one(users, fname, lname) from users where lname = 'doe' order by 1;
argument_test_one
-----------------------------------------------------------------------
willem doe => {fname: willem, lname: doe, userid: 3, username: w_doe}
(3 rows)
+-- spi and nested calls
+--
select nested_call_one('pass this along');
nested_call_one
-----------------------------------------------------------------
there are 1 smiths
(1 row)
+-- quick peek at the table
+--
SELECT * FROM users;
fname | lname | username | userid
--------+-------+----------+--------
rick | smith | slash | 4
(4 rows)
+-- should fail
+--
UPDATE users SET fname = 'william' WHERE fname = 'willem';
+-- should modify william to willem and create username
+--
INSERT INTO users (fname, lname) VALUES ('william', 'smith');
INSERT INTO users (fname, lname, username) VALUES ('charles', 'darwin', 'beagle');
SELECT * FROM users;
----------------
(0 rows)
+-- error in trigger
+--
+--
+-- Check Universal Newline Support
+--
SELECT newline_lf();
newline_lf
------------
+++ /dev/null
-
-DELETE FROM users ;
+++ /dev/null
-DROP INDEX xsequences_pid_idx ;
-DROP TABLE xsequences ;
-DROP INDEX sequences_product_idx ;
-DROP TABLE sequences ;
-DROP SEQUENCE sequences_pid_seq ;
-DROP TABLE taxonomy ;
-DROP SEQUENCE taxonomy_id_seq ;
-DROP TABLE entry ;
-DROP SEQUENCE entry_eid_seq ;
-DROP INDEX logins_userid_idx ;
-DROP TABLE logins;
-DROP INDEX users_username_idx ;
-DROP INDEX users_fname_idx ;
-DROP INDEX users_lname_idx ;
-DROP INDEX users_userid_idx ;
-DROP TABLE users ;
-DROP SEQUENCE users_userid_seq ;
+++ /dev/null
-DROP FUNCTION plglobals() ;
-DROP FUNCTION plstatic() ;
-DROP FUNCTION plfail() ;
-DROP TRIGGER users_insert_trig on users ;
-DROP FUNCTION users_insert() ;
-DROP TRIGGER users_update_trig on users ;
-DROP FUNCTION users_update() ;
-DROP TRIGGER users_delete_trig on users ;
-DROP FUNCTION users_delete() ;
-DROP PROCEDURAL LANGUAGE plpythonu ;
-DROP FUNCTION plpython_call_handler() ;
+++ /dev/null
-
-CREATE FUNCTION test_setof() returns setof text
- AS
-'if GD.has_key("calls"):
- GD["calls"] = GD["calls"] + 1
- if GD["calls"] > 2:
- return None
-else:
- GD["calls"] = 1
-return str(GD["calls"])'
- LANGUAGE plpythonu;
--- /dev/null
+--
+-- For paranoia's sake, don't leave an untrusted language sitting around
+--
+SET client_min_messages = WARNING;
+
+DROP PROCEDURAL LANGUAGE plpythonu CASCADE;
+++ /dev/null
-#!/bin/sh
-
-DBNAME=pltest
-
-echo -n "*** Destroy $DBNAME."
-dropdb $DBNAME > test.log 2>&1
-# drop failure is ok...
-echo " Done. ***"
-
-sleep 1
-
-echo -n "*** Create $DBNAME."
-if createdb $DBNAME >> test.log 2>&1 ; then
- echo " Done. ***"
-else
- echo " Failed! See test.log. ***"
- exit 1
-fi
-
-echo -n "*** Create plpython."
-if createlang plpythonu $DBNAME >> test.log 2>&1 ; then
- echo " Done. ***"
-else
- echo " Failed! See test.log. ***"
- exit 1
-fi
-
-echo -n "*** Create tables"
-psql -q $DBNAME < plpython_schema.sql >> test.log 2>&1
-echo -n ", data"
-psql -q $DBNAME < plpython_populate.sql >> test.log 2>&1
-echo -n ", and functions and triggers."
-psql -q $DBNAME < plpython_function.sql >> test.log 2>&1
-echo " Done. ***"
-
-echo -n "*** Running feature tests."
-psql -q -e $DBNAME < plpython_test.sql > feature.output 2>&1
-echo " Done. ***"
-
-echo -n "*** Running error handling tests."
-psql -q -e $DBNAME < plpython_error.sql > error.output 2>&1
-echo " Done. ***"
-
-echo -n "*** Checking the results of the feature tests."
-if diff -c feature.expected feature.output > feature.diff 2>&1 ; then
- echo -n " passed!"
-else
- echo -n " failed! Please examine feature.diff."
-fi
-echo " Done. ***"
-
-echo -n "*** Checking the results of the error handling tests."
-if diff -c error.expected error.output > error.diff 2>&1 ; then
- echo -n " passed!"
-else
- echo -n " failed! Please examine error.diff."
-fi
-echo " Done. ***"
#
# Makefile for the pltcl shared object
#
-# $PostgreSQL: pgsql/src/pl/tcl/Makefile,v 1.44 2004/12/16 20:41:01 tgl Exp $
+# $PostgreSQL: pgsql/src/pl/tcl/Makefile,v 1.45 2005/05/14 17:55:22 tgl Exp $
#
#-------------------------------------------------------------------------
SO_MINOR_VERSION = 0
OBJS = pltcl.o
+REGRESS = pltcl_setup pltcl_queries
+
include $(top_srcdir)/src/Makefile.shlib
ifeq ($(TCL_SHARED_BUILD), 1)
rm -f $(DESTDIR)$(pkglibdir)/$(NAME)$(DLSUFFIX)
$(MAKE) -C modules $@
+installcheck: submake
+ $(SHELL) $(top_builddir)/src/test/regress/pg_regress --load-language=pltcl $(REGRESS)
+
+.PHONY: submake
+submake:
+ $(MAKE) -C $(top_builddir)/src/test/regress pg_regress
+
else # TCL_SHARED_BUILD = 0
# Provide dummy targets for the case where we can't build the shared library.
clean distclean maintainer-clean: clean-lib
rm -f $(OBJS)
+ rm -rf results
+ rm -f regression.diffs regression.out
$(MAKE) -C modules $@
+-- suppress CONTEXT so that function OIDs aren't in output
+\set VERBOSITY terse
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');
2 | key2-3 | test key
(6 rows)
+-- key2 in T_pkey2 should have upper case only
select * from T_pkey2;
key1 | key2 | txt
------+----------------------+------------------------------------------
(6 rows)
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');
ERROR: duplicate key '1', 'KEY1-3' for T_pkey2
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');
ERROR: key for t_dta1 not in t_pkey1
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');
ERROR: key for t_dta2 not in t_pkey2
select * from T_dta1;
6
(1 row)
+-- The following should return NULL instead of 0
select tcl_avg(key1) from T_pkey1 where key1 = 99;
tcl_avg
---------
--- /dev/null
+--
+-- checkpoint so that if we have a crash in the tests, replay of the
+-- just-completed CREATE DATABASE won't discard the core dump file
+--
+checkpoint;
+--
+-- 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 trigger 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 ERROR \\
+ "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 ERROR \\
+ "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 trigger 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 ERROR \\
+ "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 trigger 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 trigger 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_catalog.pg_type T, pg_catalog.pg_attribute A, pg_catalog.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 ERROR "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_catalog.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 ERROR "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';
+-- We use split(n) as a quick-and-dirty way of parsing the input array
+-- value, which comes in as a string like '{1,2}'. There are better ways...
+create function tcl_int4_accum(int4[], int4) returns int4[] as '
+ set state [split $1 "{,}"]
+ set newsum [expr {[lindex $state 1] + $2}]
+ set newcnt [expr {[lindex $state 2] + 1}]
+ return "{$newsum,$newcnt}"
+' language 'pltcl';
+create function tcl_int4_avg(int4[]) returns int4 as '
+ set state [split $1 "{,}"]
+ if {[lindex $state 2] == 0} { return_null }
+ return [expr {[lindex $state 1] / [lindex $state 2]}]
+' language 'pltcl';
+create aggregate tcl_avg (
+ sfunc = tcl_int4_accum,
+ basetype = int4,
+ stype = int4[],
+ finalfunc = tcl_int4_avg,
+ initcond = '{0,0}'
+ );
+create aggregate tcl_sum (
+ sfunc = tcl_int4add,
+ basetype = int4,
+ stype = 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
+ );
+++ /dev/null
-
- 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
+++ /dev/null
-#!/bin/sh
-
-DBNAME=pltcl_test
-export DBNAME
-
-echo "**** Destroy old database $DBNAME ****"
-dropdb $DBNAME
-
-sleep 1
-
-echo "**** Create test database $DBNAME ****"
-createdb $DBNAME || exit 1
-
-echo "**** Create procedural language pltcl ****"
-createlang pltcl $DBNAME || exit 1
-
-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."
- rm test.out
-else
- echo " Tests failed - look at diffs between"
- echo " test.expected and test.out"
-fi
-
projects / postgresql / commitdiff