The beginnings of a regression test for plperl. Right now it only

covers return value processing, but that was the most broken stuff...

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
+
+echo "**** Create procedural language plperl ****"
+createlang plperl $DBNAME
+
+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/plperl/test/test.expected

+checkpoint;
+CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$
+return undef;
+$$ LANGUAGE plperl;
+SELECT perl_int(11);
+ perl_int 
+----------
+         
+(1 row)
+
+SELECT * FROM perl_int(42);
+ perl_int 
+----------
+         
+(1 row)
+
+CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$
+return $_[0] + 1;
+$$ LANGUAGE plperl;
+SELECT perl_int(11);
+ perl_int 
+----------
+       12
+(1 row)
+
+SELECT * FROM perl_int(42);
+ perl_int 
+----------
+       43
+(1 row)
+
+CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$
+return undef;
+$$ LANGUAGE plperl;
+SELECT perl_set_int(5);
+ perl_set_int 
+--------------
+(0 rows)
+
+SELECT * FROM perl_set_int(5);
+ perl_set_int 
+--------------
+(0 rows)
+
+CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$
+return [0..$_[0]];
+$$ LANGUAGE plperl;
+SELECT perl_set_int(5);
+ perl_set_int 
+--------------
+            0
+            1
+            2
+            3
+            4
+            5
+(6 rows)
+
+SELECT * FROM perl_set_int(5);
+ perl_set_int 
+--------------
+            0
+            1
+            2
+            3
+            4
+            5
+(6 rows)
+
+CREATE TYPE testrowperl AS (f1 integer, f2 text, f3 text);
+CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
+    return undef;
+$$ LANGUAGE plperl;
+SELECT perl_row();
+ perl_row 
+----------
+ 
+(1 row)
+
+SELECT * FROM perl_row();
+ f1 | f2 | f3 
+----+----+----
+    |    | 
+(1 row)
+
+CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
+    return {f2 => 'hello', f1 => 1, f3 => 'world'};
+$$ LANGUAGE plperl;
+SELECT perl_row();
+    perl_row     
+-----------------
+ (1,hello,world)
+(1 row)
+
+SELECT * FROM perl_row();
+ f1 |  f2   |  f3   
+----+-------+-------
+  1 | hello | world
+(1 row)
+
+CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
+    return undef;
+$$  LANGUAGE plperl;
+SELECT perl_set();
+ perl_set 
+----------
+(0 rows)
+
+SELECT * FROM perl_set();
+ f1 | f2 | f3 
+----+----+----
+(0 rows)
+
+CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        undef,
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+SELECT perl_set();
+ERROR:  plperl: check your return value structure
+SELECT * FROM perl_set();
+ERROR:  plperl: check your return value structure
+CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+SELECT perl_set();
+       perl_set       
+----------------------
+ (1,Hello,World)
+ (2,Hello,PostgreSQL)
+ (3,Hello,PL/Perl)
+(3 rows)
+
+SELECT * FROM perl_set();
+ f1 |  f2   |     f3     
+----+-------+------------
+  1 | Hello | World
+  2 | Hello | PostgreSQL
+  3 | Hello | PL/Perl
+(3 rows)
+
+CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
+    return undef;
+$$ LANGUAGE plperl;
+SELECT perl_record();
+ perl_record 
+-------------
+ 
+(1 row)
+
+SELECT * FROM perl_record();
+ERROR:  a column definition list is required for functions returning "record"
+SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
+ f1 | f2 | f3 
+----+----+----
+    |    | 
+(1 row)
+
+CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
+    return {f2 => 'hello', f1 => 1, f3 => 'world'};
+$$ LANGUAGE plperl;
+SELECT perl_record();
+ERROR:  could not determine row description for function returning record
+SELECT * FROM perl_record();
+ERROR:  a column definition list is required for functions returning "record"
+SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
+ f1 |  f2   |  f3   
+----+-------+-------
+  1 | hello | world
+(1 row)
+
+CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
+    return undef;
+$$  LANGUAGE plperl;
+SELECT perl_record_set();
+ perl_record_set 
+-----------------
+(0 rows)
+
+SELECT * FROM perl_record_set();
+ERROR:  a column definition list is required for functions returning "record"
+SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
+ f1 | f2 | f3 
+----+----+----
+(0 rows)
+
+CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        undef,
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+SELECT perl_record_set();
+ERROR:  could not determine row description for function returning record
+SELECT * FROM perl_record_set();
+ERROR:  a column definition list is required for functions returning "record"
+SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
+ERROR:  plperl: check your return value structure
+CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+SELECT perl_record_set();
+ERROR:  could not determine row description for function returning record
+SELECT * FROM perl_record_set();
+ERROR:  a column definition list is required for functions returning "record"
+SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
+ f1 |  f2   |     f3     
+----+-------+------------
+  1 | Hello | World
+  2 | Hello | PostgreSQL
+  3 | Hello | PL/Perl
+(3 rows)
+

src/pl/plperl/test/test_queries.sql

+--
+-- 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;
+
+SELECT perl_int(11);
+SELECT * FROM perl_int(42);
+
+CREATE OR REPLACE FUNCTION perl_int(int) RETURNS INTEGER AS $$
+return $_[0] + 1;
+$$ LANGUAGE plperl;
+
+SELECT perl_int(11);
+SELECT * FROM perl_int(42);
+
+
+CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$
+return undef;
+$$ LANGUAGE plperl;
+
+SELECT perl_set_int(5);
+SELECT * FROM perl_set_int(5);
+
+CREATE OR REPLACE FUNCTION perl_set_int(int) RETURNS SETOF INTEGER AS $$
+return [0..$_[0]];
+$$ LANGUAGE plperl;
+
+SELECT perl_set_int(5);
+SELECT * FROM perl_set_int(5);
+
+
+CREATE TYPE testrowperl AS (f1 integer, f2 text, f3 text);
+
+CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
+    return undef;
+$$ LANGUAGE plperl;
+
+SELECT perl_row();
+SELECT * FROM perl_row();
+
+CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$
+    return {f2 => 'hello', f1 => 1, f3 => 'world'};
+$$ LANGUAGE plperl;
+
+SELECT perl_row();
+SELECT * FROM perl_row();
+
+
+CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
+    return undef;
+$$  LANGUAGE plperl;
+
+SELECT perl_set();
+SELECT * FROM perl_set();
+
+CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        undef,
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+
+SELECT perl_set();
+SELECT * FROM perl_set();
+
+CREATE OR REPLACE FUNCTION perl_set() RETURNS SETOF testrowperl AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+
+SELECT perl_set();
+SELECT * FROM perl_set();
+
+
+
+CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
+    return undef;
+$$ LANGUAGE plperl;
+
+SELECT perl_record();
+SELECT * FROM perl_record();
+SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
+
+CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$
+    return {f2 => 'hello', f1 => 1, f3 => 'world'};
+$$ LANGUAGE plperl;
+
+SELECT perl_record();
+SELECT * FROM perl_record();
+SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text);
+
+
+CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
+    return undef;
+$$  LANGUAGE plperl;
+
+SELECT perl_record_set();
+SELECT * FROM perl_record_set();
+SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
+
+CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        undef,
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+
+SELECT perl_record_set();
+SELECT * FROM perl_record_set();
+SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);
+
+CREATE OR REPLACE FUNCTION perl_record_set() RETURNS SETOF record AS $$
+    return [
+        { f1 => 1, f2 => 'Hello', f3 =>  'World' },
+        { f1 => 2, f2 => 'Hello', f3 =>  'PostgreSQL' },
+        { f1 => 3, f2 => 'Hello', f3 =>  'PL/Perl' }
+    ];
+$$  LANGUAGE plperl;
+
+SELECT perl_record_set();
+SELECT * FROM perl_record_set();
+SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text);