Convert the existing regression test scripts for the various optional

PLs to use the standard pg_regress infrastructure.  No changes in the
tests themselves.  Andrew Dunstan

src/pl/Makefile

@@ -4,7 +4,7 @@
 #
 # 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 $
 #
 #-------------------------------------------------------------------------
 
@@ -14,10 +14,6 @@ include $(top_builddir)/src/Makefile.global
 
 DIRS := plpgsql
 
-ifeq ($(with_tcl), yes)
-DIRS += tcl
-endif
-
 ifeq ($(with_perl), yes)
 DIRS += plperl
 endif
@@ -26,8 +22,22 @@ ifeq ($(with_python), yes)
 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

src/pl/plperl/GNUmakefile

 # 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 = ../../..
@@ -36,6 +36,8 @@ OBJS = plperl.o spi_internal.o SPI.o
 
 SHLIB_LINK = $(perl_embed_ldflags) $(BE_DLLLIBS)
 
+REGRESS = plperl
+
 include $(top_srcdir)/src/Makefile.shlib
 
 
@@ -59,8 +61,17 @@ installdirs:
 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
 

src/pl/plperl/test/test.expected → src/pl/plperl/expected/plperl.out

+--
+-- 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;
@@ -277,6 +284,9 @@ SELECT (perl_out_params_set()).f3;
  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 [
@@ -334,6 +344,9 @@ 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;

src/pl/plperl/test/runtest

-#!/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

src/pl/plpython/Makefile

-# $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 = ../../..
@@ -58,6 +58,8 @@ endif
 
 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
 
 
@@ -78,16 +80,21 @@ installdirs:
 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:

src/pl/plpython/expected/plpython_drop.out

+--
+-- For paranoia's sake, don't leave an untrusted language sitting around
+--
+SET client_min_messages = WARNING;
+DROP PROCEDURAL LANGUAGE plpythonu CASCADE;

src/pl/plpython/error.expected → src/pl/plpython/expected/plpython_error.out

+-- 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
@@ -16,6 +19,7 @@ SELECT valid_type('rick');
  
 (1 row)
 
+-- Security sandbox tests
 SELECT write_file('/tmp/plpython','Only trusted users should be able to do this!');
           write_file          
 ------------------------------

src/pl/plpython/expected/plpython_function.out

+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;

src/pl/plpython/expected/plpython_populate.out

+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') ;

src/pl/plpython/expected/plpython_schema.out

+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) ;

src/pl/plpython/feature.expected → src/pl/plpython/expected/plpython_test.out

+-- first some tests of basic functionality
+--
+-- better succeed
+--
 select stupid();
  stupid 
 --------
  zarkon
 (1 row)
 
+-- check static and global data
+--
 SELECT static_test();
  static_test 
 -------------
@@ -28,6 +34,8 @@ SELECT global_test_two();
  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     
@@ -41,18 +49,24 @@ SELECT import_succeed();
  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                           
 -----------------------------------------------------------------------
@@ -61,6 +75,8 @@ select argument_test_one(users, fname, lname) from users where lname = 'doe' ord
  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                         
 -----------------------------------------------------------------
@@ -85,6 +101,8 @@ select spi_prepared_plan_test_nested('smith');
  there are 1 smiths
 (1 row)
 
+-- quick peek at the table
+--
 SELECT * FROM users;
  fname  | lname | username | userid 
 --------+-------+----------+--------
@@ -94,7 +112,11 @@ SELECT * FROM users;
  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;
@@ -137,6 +159,11 @@ SELECT join_sequences(sequences) FROM sequences
 ----------------
 (0 rows)
 
+-- error in trigger
+--
+--
+-- Check Universal Newline Support
+--
 SELECT newline_lf();
  newline_lf 
 ------------

src/pl/plpython/plpython_depopulate.sql

-
-DELETE FROM users ;

src/pl/plpython/plpython_deschema.sql

-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 ;

src/pl/plpython/plpython_drop.sql

-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() ;

src/pl/plpython/plpython_setof.sql

-
-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;

src/pl/plpython/sql/plpython_drop.sql

+--
+-- For paranoia's sake, don't leave an untrusted language sitting around
+--
+SET client_min_messages = WARNING;
+
+DROP PROCEDURAL LANGUAGE plpythonu CASCADE;

src/pl/plpython/test.sh

-#!/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. ***"

src/pl/tcl/Makefile

@@ -2,7 +2,7 @@
 #
 # 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 $
 #
 #-------------------------------------------------------------------------
 
@@ -40,6 +40,8 @@ SO_MAJOR_VERSION = 2
 SO_MINOR_VERSION = 0
 OBJS = pltcl.o
 
+REGRESS = pltcl_setup pltcl_queries
+
 include $(top_srcdir)/src/Makefile.shlib
 
 ifeq ($(TCL_SHARED_BUILD), 1)
@@ -65,6 +67,13 @@ uninstall:
 	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.
@@ -77,4 +86,6 @@ endif # TCL_SHARED_BUILD = 0
 
 clean distclean maintainer-clean: clean-lib
 	rm -f $(OBJS)
+	rm -rf results
+	rm -f regression.diffs regression.out
 	$(MAKE) -C modules $@

src/pl/tcl/test/test.expected → src/pl/tcl/expected/pltcl_queries.out

+-- 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');
@@ -21,6 +23,7 @@ select * from T_pkey1;
     2 | key2-3               | test key                                
 (6 rows)
 
+-- key2 in T_pkey2 should have upper case only
 select * from T_pkey2;
  key1 |         key2         |                   txt                    
 ------+----------------------+------------------------------------------
@@ -33,16 +36,19 @@ select * from T_pkey2;
 (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;
@@ -132,6 +138,7 @@ select tcl_sum(key1) from T_pkey2;
        6
 (1 row)
 
+-- The following should return NULL instead of 0
 select tcl_avg(key1) from T_pkey1 where key1 = 99;
  tcl_avg 
 ---------

src/pl/tcl/expected/pltcl_setup.out

+--
+-- 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
+	);

src/pl/tcl/test/README

-
-    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

src/pl/tcl/test/runtest

-#!/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
-