diff options
Diffstat (limited to 'src/pl/plperl/expected/plperl.out')
| -rw-r--r-- | src/pl/plperl/expected/plperl.out | 794 |
1 files changed, 794 insertions, 0 deletions
diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out new file mode 100644 index 0000000..e3d7c88 --- /dev/null +++ b/src/pl/plperl/expected/plperl.out @@ -0,0 +1,794 @@ +-- +-- 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 testnestperl AS (f5 integer[]); +CREATE TYPE testrowperl AS (f1 integer, f2 text, f3 text, f4 testnestperl); +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 | f4 +----+----+----+---- + | | | +(1 row) + +CREATE OR REPLACE FUNCTION perl_row() RETURNS testrowperl AS $$ + return {f2 => 'hello', f1 => 1, f3 => 'world', 'f4' => { 'f5' => [[1]] } }; +$$ LANGUAGE plperl; +SELECT perl_row(); + perl_row +--------------------------- + (1,hello,world,"({{1}})") +(1 row) + +SELECT * FROM perl_row(); + f1 | f2 | f3 | f4 +----+-------+-------+--------- + 1 | hello | world | ({{1}}) +(1 row) + +-- test returning a composite literal +CREATE OR REPLACE FUNCTION perl_row_lit() RETURNS testrowperl AS $$ + return '(1,hello,world,"({{1}})")'; +$$ LANGUAGE plperl; +SELECT perl_row_lit(); + perl_row_lit +--------------------------- + (1,hello,world,"({{1}})") +(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 | f4 +----+----+----+---- +(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', 'f4' => {} }, + { f1 => 4, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => undef }}, + { f1 => 5, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => '{1}' }}, + { f1 => 6, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => [1] }}, + ]; +$$ LANGUAGE plperl; +SELECT perl_set(); +ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash +CONTEXT: PL/Perl function "perl_set" +SELECT * FROM perl_set(); +ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash +CONTEXT: PL/Perl function "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', 'f4' => undef }, + { f1 => 3, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => {} }, + { f1 => 4, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => undef }}, + { f1 => 5, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => '{1}' }}, + { f1 => 6, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => { 'f5' => [1] }}, + { f1 => 7, f2 => 'Hello', f3 => 'PL/Perl', 'f4' => '({1})' }, + ]; +$$ LANGUAGE plperl; +SELECT perl_set(); + perl_set +--------------------------- + (1,Hello,World,) + (2,Hello,PostgreSQL,) + (3,Hello,PL/Perl,"()") + (4,Hello,PL/Perl,"()") + (5,Hello,PL/Perl,"({1})") + (6,Hello,PL/Perl,"({1})") + (7,Hello,PL/Perl,"({1})") +(7 rows) + +SELECT * FROM perl_set(); + f1 | f2 | f3 | f4 +----+-------+------------+------- + 1 | Hello | World | + 2 | Hello | PostgreSQL | + 3 | Hello | PL/Perl | () + 4 | Hello | PL/Perl | () + 5 | Hello | PL/Perl | ({1}) + 6 | Hello | PL/Perl | ({1}) + 7 | Hello | PL/Perl | ({1}) +(7 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" +LINE 1: SELECT * FROM perl_record(); + ^ +SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text, f4 testnestperl); + f1 | f2 | f3 | f4 +----+----+----+---- + | | | +(1 row) + +CREATE OR REPLACE FUNCTION perl_record() RETURNS record AS $$ + return {f2 => 'hello', f1 => 1, f3 => 'world', 'f4' => { 'f5' => [1] } }; +$$ LANGUAGE plperl; +SELECT perl_record(); +ERROR: function returning record called in context that cannot accept type record +CONTEXT: PL/Perl function "perl_record" +SELECT * FROM perl_record(); +ERROR: a column definition list is required for functions returning "record" +LINE 1: SELECT * FROM perl_record(); + ^ +SELECT * FROM perl_record() AS (f1 integer, f2 text, f3 text, f4 testnestperl); + f1 | f2 | f3 | f4 +----+-------+-------+------- + 1 | hello | world | ({1}) +(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" +LINE 1: SELECT * FROM perl_record_set(); + ^ +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 +CONTEXT: PL/Perl function "perl_record_set" +SELECT * FROM perl_record_set(); +ERROR: a column definition list is required for functions returning "record" +LINE 1: SELECT * FROM perl_record_set(); + ^ +SELECT * FROM perl_record_set() AS (f1 integer, f2 text, f3 text); +ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash +CONTEXT: PL/Perl function "perl_record_set" +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 +CONTEXT: PL/Perl function "perl_record_set" +SELECT * FROM perl_record_set(); +ERROR: a column definition list is required for functions returning "record" +LINE 1: SELECT * FROM perl_record_set(); + ^ +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" +CONTEXT: PL/Perl function "foo_bad" +CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ +return 42; +$$ LANGUAGE plperl; +SELECT * FROM foo_bad(); +ERROR: malformed record literal: "42" +DETAIL: Missing left parenthesis. +CONTEXT: PL/Perl function "foo_bad" +CREATE OR REPLACE FUNCTION foo_bad() RETURNS footype AS $$ +return [ + [1, 2], + [3, 4] +]; +$$ LANGUAGE plperl; +SELECT * FROM foo_bad(); +ERROR: cannot convert Perl array to non-array type footype +CONTEXT: PL/Perl function "foo_bad" +CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ + return 42; +$$ LANGUAGE plperl; +SELECT * FROM foo_set_bad(); +ERROR: set-returning PL/Perl function must return reference to array or use return_next +CONTEXT: PL/Perl function "foo_set_bad" +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 PL/Perl function must return reference to array or use return_next +CONTEXT: PL/Perl function "foo_set_bad" +CREATE OR REPLACE FUNCTION foo_set_bad() RETURNS SETOF footype AS $$ +return [ + [1, 2], + [3, 4] +]; +$$ LANGUAGE plperl; +SELECT * FROM foo_set_bad(); +ERROR: SETOF-composite-returning PL/Perl function must call return_next with reference to hash +CONTEXT: PL/Perl function "foo_set_bad" +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" +CONTEXT: PL/Perl function "foo_set_bad" +CREATE DOMAIN orderedfootype AS footype CHECK ((VALUE).x <= (VALUE).y); +CREATE OR REPLACE FUNCTION foo_ordered() RETURNS orderedfootype AS $$ + return {x => 3, y => 4}; +$$ LANGUAGE plperl; +SELECT * FROM foo_ordered(); + x | y +---+--- + 3 | 4 +(1 row) + +CREATE OR REPLACE FUNCTION foo_ordered() RETURNS orderedfootype AS $$ + return {x => 5, y => 4}; +$$ LANGUAGE plperl; +SELECT * FROM foo_ordered(); -- fail +ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" +CONTEXT: PL/Perl function "foo_ordered" +CREATE OR REPLACE FUNCTION foo_ordered_set() RETURNS SETOF orderedfootype AS $$ +return [ + {x => 3, y => 4}, + {x => 4, y => 7} +]; +$$ LANGUAGE plperl; +SELECT * FROM foo_ordered_set(); + x | y +---+--- + 3 | 4 + 4 | 7 +(2 rows) + +CREATE OR REPLACE FUNCTION foo_ordered_set() RETURNS SETOF orderedfootype AS $$ +return [ + {x => 3, y => 4}, + {x => 9, y => 7} +]; +$$ LANGUAGE plperl; +SELECT * FROM foo_ordered_set(); -- fail +ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" +CONTEXT: PL/Perl function "foo_ordered_set" +-- +-- 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) + +CREATE OR REPLACE FUNCTION perl_get_cfield(orderedfootype, text) RETURNS integer AS $$ + return $_[0]->{$_[1]}; +$$ LANGUAGE plperl; +SELECT perl_get_cfield((11,12), 'x'); + perl_get_cfield +----------------- + 11 +(1 row) + +SELECT perl_get_cfield((11,12), 'y'); + perl_get_cfield +----------------- + 12 +(1 row) + +SELECT perl_get_cfield((12,11), 'x'); -- fail +ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" +CREATE OR REPLACE FUNCTION perl_get_rfield(record, text) RETURNS integer AS $$ + return $_[0]->{$_[1]}; +$$ LANGUAGE plperl; +SELECT perl_get_rfield((11,12), 'f1'); + perl_get_rfield +----------------- + 11 +(1 row) + +SELECT perl_get_rfield((11,12)::footype, 'y'); + perl_get_rfield +----------------- + 12 +(1 row) + +SELECT perl_get_rfield((11,12)::orderedfootype, 'x'); + perl_get_rfield +----------------- + 11 +(1 row) + +SELECT perl_get_rfield((12,11)::orderedfootype, 'x'); -- fail +ERROR: value for domain orderedfootype violates check constraint "orderedfootype_check" +-- +-- Test return_next +-- +CREATE OR REPLACE FUNCTION perl_srf_rn() RETURNS SETOF RECORD AS $$ +my $i = 0; +for ("World", "PostgreSQL", "PL/Perl") { + return_next({f1=>++$i, f2=>'Hello', f3=>$_}); +} +return; +$$ language plperl; +SELECT * from perl_srf_rn() AS (f1 INTEGER, f2 TEXT, f3 TEXT); + f1 | f2 | f3 +----+-------+------------ + 1 | Hello | World + 2 | Hello | PostgreSQL + 3 | Hello | PL/Perl +(3 rows) + +-- +-- Test spi_query/spi_fetchrow +-- +CREATE OR REPLACE FUNCTION perl_spi_func() RETURNS SETOF INTEGER AS $$ +my $x = spi_query("select 1 as a union select 2 as a"); +while (defined (my $y = spi_fetchrow($x))) { + return_next($y->{a}); +} +return; +$$ LANGUAGE plperl; +SELECT * from perl_spi_func(); + perl_spi_func +--------------- + 1 + 2 +(2 rows) + +-- +-- Test spi_fetchrow abort +-- +CREATE OR REPLACE FUNCTION perl_spi_func2() RETURNS INTEGER AS $$ +my $x = spi_query("select 1 as a union select 2 as a"); +spi_cursor_close( $x); +return 0; +$$ LANGUAGE plperl; +SELECT * from perl_spi_func2(); + perl_spi_func2 +---------------- + 0 +(1 row) + +--- +--- Test recursion via SPI +--- +CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl +AS $$ + + my $i = shift; + foreach my $x (1..$i) + { + return_next "hello $x"; + } + if ($i > 2) + { + my $z = $i-1; + my $cursor = spi_query("select * from recurse($z)"); + while (defined(my $row = spi_fetchrow($cursor))) + { + return_next "recurse $i: $row->{recurse}"; + } + } + return undef; + +$$; +SELECT * FROM recurse(2); + recurse +--------- + hello 1 + hello 2 +(2 rows) + +SELECT * FROM recurse(3); + recurse +-------------------- + hello 1 + hello 2 + hello 3 + recurse 3: hello 1 + recurse 3: hello 2 +(5 rows) + +--- +--- Test array return +--- +CREATE OR REPLACE FUNCTION array_of_text() RETURNS TEXT[][] +LANGUAGE plperl as $$ + return [['a"b',undef,'c,d'],['e\\f',undef,'g']]; +$$; +SELECT array_of_text(); + array_of_text +--------------------------------------- + {{"a\"b",NULL,"c,d"},{"e\\f",NULL,g}} +(1 row) + +-- +-- Test spi_prepare/spi_exec_prepared/spi_freeplan +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared(INTEGER) RETURNS INTEGER AS $$ + my $x = spi_prepare('select $1 AS a', 'INTEGER'); + my $q = spi_exec_prepared( $x, $_[0] + 1); + spi_freeplan($x); +return $q->{rows}->[0]->{a}; +$$ LANGUAGE plperl; +SELECT * from perl_spi_prepared(42); + perl_spi_prepared +------------------- + 43 +(1 row) + +-- +-- Test spi_prepare/spi_query_prepared/spi_freeplan +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared_set(INTEGER, INTEGER) RETURNS SETOF INTEGER AS $$ + my $x = spi_prepare('SELECT $1 AS a union select $2 as a', 'INT4', 'INT4'); + my $q = spi_query_prepared( $x, 1+$_[0], 2+$_[1]); + while (defined (my $y = spi_fetchrow($q))) { + return_next $y->{a}; + } + spi_freeplan($x); + return; +$$ LANGUAGE plperl; +SELECT * from perl_spi_prepared_set(1,2); + perl_spi_prepared_set +----------------------- + 2 + 4 +(2 rows) + +-- +-- Test prepare with a type with spaces +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared_double(double precision) RETURNS double precision AS $$ + my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'DOUBLE PRECISION'); + my $q = spi_query_prepared($x,$_[0]); + my $result; + while (defined (my $y = spi_fetchrow($q))) { + $result = $y->{a}; + } + spi_freeplan($x); + return $result; +$$ LANGUAGE plperl; +SELECT perl_spi_prepared_double(4.35) as "double precision"; + double precision +------------------ + 43.5 +(1 row) + +-- +-- Test with a bad type +-- +CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS double precision AS $$ + my $x = spi_prepare('SELECT 10.0 * $1 AS a', 'does_not_exist'); + my $q = spi_query_prepared($x,$_[0]); + my $result; + while (defined (my $y = spi_fetchrow($q))) { + $result = $y->{a}; + } + spi_freeplan($x); + return $result; +$$ LANGUAGE plperl; +SELECT perl_spi_prepared_bad(4.35) as "double precision"; +ERROR: type "does_not_exist" does not exist at line 2. +CONTEXT: PL/Perl function "perl_spi_prepared_bad" +-- Test with a row type +CREATE OR REPLACE FUNCTION perl_spi_prepared() RETURNS INTEGER AS $$ + my $x = spi_prepare('select $1::footype AS a', 'footype'); + my $q = spi_exec_prepared( $x, '(1, 2)'); + spi_freeplan($x); +return $q->{rows}->[0]->{a}->{x}; +$$ LANGUAGE plperl; +SELECT * from perl_spi_prepared(); + perl_spi_prepared +------------------- + 1 +(1 row) + +CREATE OR REPLACE FUNCTION perl_spi_prepared_row(footype) RETURNS footype AS $$ + my $footype = shift; + my $x = spi_prepare('select $1 AS a', 'footype'); + my $q = spi_exec_prepared( $x, {}, $footype ); + spi_freeplan($x); +return $q->{rows}->[0]->{a}; +$$ LANGUAGE plperl; +SELECT * from perl_spi_prepared_row('(1, 2)'); + x | y +---+--- + 1 | 2 +(1 row) + +-- simple test of a DO block +DO $$ + $a = 'This is a test'; + elog(NOTICE, $a); +$$ LANGUAGE plperl; +NOTICE: This is a test +-- check that restricted operations are rejected in a plperl DO block +DO $$ system("/nonesuch"); $$ LANGUAGE plperl; +ERROR: 'system' trapped by operation mask at line 1. +CONTEXT: PL/Perl anonymous code block +DO $$ qx("/nonesuch"); $$ LANGUAGE plperl; +ERROR: 'quoted execution (``, qx)' trapped by operation mask at line 1. +CONTEXT: PL/Perl anonymous code block +DO $$ open my $fh, "</nonesuch"; $$ LANGUAGE plperl; +ERROR: 'open' trapped by operation mask at line 1. +CONTEXT: PL/Perl anonymous code block +-- check that eval is allowed and eval'd restricted ops are caught +DO $$ eval q{chdir '.';}; warn "Caught: $@"; $$ LANGUAGE plperl; +WARNING: Caught: 'chdir' trapped by operation mask at line 1. +-- check that compiling do (dofile opcode) is allowed +-- but that executing it for a file not already loaded (via require) dies +DO $$ warn do "/dev/null"; $$ LANGUAGE plperl; +ERROR: Unable to load /dev/null into plperl at line 1. +CONTEXT: PL/Perl anonymous code block +-- check that we can't "use" a module that's not been loaded already +-- compile-time error: "Unable to load blib.pm into plperl" +DO $$ use blib; $$ LANGUAGE plperl; +ERROR: Unable to load blib.pm into plperl at line 1. +BEGIN failed--compilation aborted at line 1. +CONTEXT: PL/Perl anonymous code block +-- check that we can "use" a module that has already been loaded +-- runtime error: "Can't use string ("foo") as a SCALAR ref while "strict refs" in use +DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl; +ERROR: Can't use string ("foo") as a SCALAR ref while "strict refs" in use at line 1. +CONTEXT: PL/Perl anonymous code block +-- check that we can "use warnings" (in this case to turn a warn into an error) +-- yields "ERROR: Useless use of sort in void context." +DO $do$ use warnings FATAL => qw(void) ; my @y; sort @y; 1; $do$ LANGUAGE plperl; +ERROR: Useless use of sort in void context at line 1. +CONTEXT: PL/Perl anonymous code block +-- make sure functions marked as VOID without an explicit return work +CREATE OR REPLACE FUNCTION myfuncs() RETURNS void AS $$ + $_SHARED{myquote} = sub { + my $arg = shift; + $arg =~ s/(['\\])/\\$1/g; + return "'$arg'"; + }; +$$ LANGUAGE plperl; +SELECT myfuncs(); + myfuncs +--------- + +(1 row) + +-- make sure we can't return an array as a scalar +CREATE OR REPLACE FUNCTION text_arrayref() RETURNS text AS $$ + return ['array']; +$$ LANGUAGE plperl; +SELECT text_arrayref(); +ERROR: cannot convert Perl array to non-array type text +CONTEXT: PL/Perl function "text_arrayref" +--- make sure we can't return a hash as a scalar +CREATE OR REPLACE FUNCTION text_hashref() RETURNS text AS $$ + return {'hash'=>1}; +$$ LANGUAGE plperl; +SELECT text_hashref(); +ERROR: cannot convert Perl hash to non-composite type text +CONTEXT: PL/Perl function "text_hashref" +---- make sure we can't return a blessed object as a scalar +CREATE OR REPLACE FUNCTION text_obj() RETURNS text AS $$ + return bless({}, 'Fake::Object'); +$$ LANGUAGE plperl; +SELECT text_obj(); +ERROR: cannot convert Perl hash to non-composite type text +CONTEXT: PL/Perl function "text_obj" +-- test looking through a scalar ref +CREATE OR REPLACE FUNCTION text_scalarref() RETURNS text AS $$ + my $str = 'str'; + return \$str; +$$ LANGUAGE plperl; +SELECT text_scalarref(); + text_scalarref +---------------- + str +(1 row) + +-- check safe behavior when a function body is replaced during execution +CREATE OR REPLACE FUNCTION self_modify(INTEGER) RETURNS INTEGER AS $$ + spi_exec_query('CREATE OR REPLACE FUNCTION self_modify(INTEGER) RETURNS INTEGER AS \'return $_[0] * 3;\' LANGUAGE plperl;'); + spi_exec_query('select self_modify(42) AS a'); + return $_[0] * 2; +$$ LANGUAGE plperl; +SELECT self_modify(42); + self_modify +------------- + 84 +(1 row) + +SELECT self_modify(42); + self_modify +------------- + 126 +(1 row) + |