--
-- 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);
 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:  elements of Perl result array must be reference to hash
SELECT * FROM perl_set();
ERROR:  elements of Perl result array must be reference to hash
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:  function returning record called in context that cannot accept type 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:  function returning record called in context that cannot accept type 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:  elements of Perl result array must be reference to hash
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:  function returning record called in context that cannot accept type 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)

CREATE OR REPLACE FUNCTION
perl_out_params(f1 out integer, f2 out text, f3 out text) AS $$
    return {f2 => 'hello', f1 => 1, f3 => 'world'};
$$ LANGUAGE plperl;
SELECT perl_out_params();
 perl_out_params 
-----------------
 (1,hello,world)
(1 row)

SELECT * FROM perl_out_params();
 f1 |  f2   |  f3   
----+-------+-------
  1 | hello | world
(1 row)

SELECT (perl_out_params()).f2;
  f2   
-------
 hello
(1 row)

CREATE OR REPLACE FUNCTION
perl_out_params_set(out f1 integer, out f2 text, out f3 text)
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_out_params_set();
 perl_out_params_set  
----------------------
 (1,Hello,World)
 (2,Hello,PostgreSQL)
 (3,Hello,PL/Perl)
(3 rows)

SELECT * FROM perl_out_params_set();
 f1 |  f2   |     f3     
----+-------+------------
  1 | Hello | World
  2 | Hello | PostgreSQL
  3 | Hello | PL/Perl
(3 rows)

SELECT (perl_out_params_set()).f3;
     f3     
------------
 World
 PostgreSQL
 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 [
    {x => 1, y => 2},
    {x => 3, y => 4}
];
$$ LANGUAGE plperl;
SELECT * FROM foo_good();
 x | y 
---+---
 1 | 2
 3 | 4
(2 rows)

CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
    return {y => 3, z => 4};
$$ LANGUAGE plperl;
SELECT * FROM foo_bad();
ERROR:  Perl hash contains nonexistent column "z"
CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
return 42;
$$ LANGUAGE plperl;
SELECT * FROM foo_bad();
ERROR:  composite-returning Perl function must return reference to hash
CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$
return [
    [1, 2],
    [3, 4]
];
$$ LANGUAGE plperl;
SELECT * FROM foo_bad();
ERROR:  composite-returning Perl function must return reference to hash
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
    return 42;
$$ LANGUAGE plperl;
SELECT * FROM foo_set_bad();
ERROR:  set-returning Perl function must return reference to array
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
    return {y => 3, z => 4};
$$ LANGUAGE plperl;
SELECT * FROM foo_set_bad();
ERROR:  set-returning Perl function must return reference to array
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
return [
    [1, 2],
    [3, 4]
];
$$ LANGUAGE plperl;
SELECT * FROM foo_set_bad();
ERROR:  elements of Perl result array must be reference to hash
CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$
return [
    {y => 3, z => 4}
];
$$ 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;
SELECT perl_get_field((11,12), 'x');
 perl_get_field 
----------------
             11
(1 row)

SELECT perl_get_field((11,12), 'y');
 perl_get_field 
----------------
             12
(1 row)

SELECT perl_get_field((11,12), 'z');
 perl_get_field 
----------------
               
(1 row)

