1-- test plperl utility functions (defined in Util.xs) 2 3-- test quote_literal 4 5create or replace function perl_quote_literal() returns setof text language plperl as $$ 6 return_next "undef: ".quote_literal(undef); 7 return_next sprintf"$_: ".quote_literal($_) 8 for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{}; 9 return undef; 10$$; 11 12select perl_quote_literal(); 13 14-- test quote_nullable 15 16create or replace function perl_quote_nullable() returns setof text language plperl as $$ 17 return_next "undef: ".quote_nullable(undef); 18 return_next sprintf"$_: ".quote_nullable($_) 19 for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{}; 20 return undef; 21$$; 22 23select perl_quote_nullable(); 24 25-- test quote_ident 26 27create or replace function perl_quote_ident() returns setof text language plperl as $$ 28 return_next "undef: ".quote_ident(undef); # generates undef warning if warnings enabled 29 return_next "$_: ".quote_ident($_) 30 for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{g.h}, q{}; 31 return undef; 32$$; 33 34select perl_quote_ident(); 35 36-- test decode_bytea 37 38create or replace function perl_decode_bytea() returns setof text language plperl as $$ 39 return_next "undef: ".decode_bytea(undef); # generates undef warning if warnings enabled 40 return_next "$_: ".decode_bytea($_) 41 for q{foo}, q{a\047b}, q{}; 42 return undef; 43$$; 44 45select perl_decode_bytea(); 46 47-- test encode_bytea 48 49create or replace function perl_encode_bytea() returns setof text language plperl as $$ 50 return_next encode_bytea(undef); # generates undef warning if warnings enabled 51 return_next encode_bytea($_) 52 for q{@}, qq{@\x01@}, qq{@\x00@}, q{}; 53 return undef; 54$$; 55 56select perl_encode_bytea(); 57 58-- test encode_array_literal 59 60create or replace function perl_encode_array_literal() returns setof text language plperl as $$ 61 return_next encode_array_literal(undef); 62 return_next encode_array_literal(0); 63 return_next encode_array_literal(42); 64 return_next encode_array_literal($_) 65 for [], [0], [1..5], [[]], [[1,2,[3]],4]; 66 return_next encode_array_literal($_,'|') 67 for [], [0], [1..5], [[]], [[1,2,[3]],4]; 68 return undef; 69$$; 70 71select perl_encode_array_literal(); 72 73-- test encode_array_constructor 74 75create or replace function perl_encode_array_constructor() returns setof text language plperl as $$ 76 return_next encode_array_constructor(undef); 77 return_next encode_array_constructor(0); 78 return_next encode_array_constructor(42); 79 return_next encode_array_constructor($_) 80 for [], [0], [1..5], [[]], [[1,2,[3]],4]; 81 return undef; 82$$; 83 84select perl_encode_array_constructor(); 85 86-- test looks_like_number 87 88create or replace function perl_looks_like_number() returns setof text language plperl as $$ 89 return_next "undef is undef" if not defined looks_like_number(undef); 90 return_next quote_nullable($_).": ". (looks_like_number($_) ? "number" : "not number") 91 for 'foo', 0, 1, 1.3, '+3.e-4', 92 '42 x', # trailing garbage 93 '99 ', # trailing space 94 ' 99', # leading space 95 ' ', # only space 96 ''; # empty string 97 return undef; 98$$; 99 100select perl_looks_like_number(); 101 102-- test encode_typed_literal 103create type perl_foo as (a integer, b text[]); 104create type perl_bar as (c perl_foo[]); 105create domain perl_foo_pos as perl_foo check((value).a > 0); 106 107create or replace function perl_encode_typed_literal() returns setof text language plperl as $$ 108 return_next encode_typed_literal(undef, 'text'); 109 return_next encode_typed_literal([[1,2,3],[3,2,1],[1,3,2]], 'integer[]'); 110 return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo'); 111 return_next encode_typed_literal({c => [{a => 9, b => ['PostgreSQL']}, {b => ['Postgres'], a => 1}]}, 'perl_bar'); 112 return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo_pos'); 113$$; 114 115select perl_encode_typed_literal(); 116 117create or replace function perl_encode_typed_literal() returns setof text language plperl as $$ 118 return_next encode_typed_literal({a => 0, b => ['PL','/','Perl']}, 'perl_foo_pos'); 119$$; 120 121select perl_encode_typed_literal(); -- fail 122