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