src/pl/plperl/sql/plperl_util.sql - master - balmaster/postgres

src/pl/plperl/sql/plperl_util.sql
121 строка4 KB
Tom Lane
Support domains over composite types in PL/Perl.
28 окт 2017, 21:02
28 окт 2017, 21:0260651e4
-- test plperl utility functions (defined in Util.xs)

-- test quote_literal

create or replace function perl_quote_literal() returns setof text language plperl as $$
	return_next "undef: ".quote_literal(undef);
	return_next sprintf"$_: ".quote_literal($_)
		for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
	return undef;
$$;

select perl_quote_literal();

-- test quote_nullable

create or replace function perl_quote_nullable() returns setof text language plperl as $$
	return_next "undef: ".quote_nullable(undef);
	return_next sprintf"$_: ".quote_nullable($_)
		for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
	return undef;
$$;

select perl_quote_nullable();

-- test quote_ident

create or replace function perl_quote_ident() returns setof text language plperl as $$
	return_next "undef: ".quote_ident(undef); # generates undef warning if warnings enabled
	return_next "$_: ".quote_ident($_)
		for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{g.h}, q{};
	return undef;
$$;

select perl_quote_ident();

-- test decode_bytea

create or replace function perl_decode_bytea() returns setof text language plperl as $$
	return_next "undef: ".decode_bytea(undef); # generates undef warning if warnings enabled
	return_next "$_: ".decode_bytea($_)
		for q{foo}, q{a\047b}, q{};
	return undef;
$$;

select perl_decode_bytea();

-- test encode_bytea

create or replace function perl_encode_bytea() returns setof text language plperl as $$
	return_next encode_bytea(undef); # generates undef warning if warnings enabled
	return_next encode_bytea($_)
		for q{@}, qq{@\x01@}, qq{@\x00@}, q{};
	return undef;
$$;

select perl_encode_bytea();

-- test encode_array_literal

create or replace function perl_encode_array_literal() returns setof text language plperl as $$
	return_next encode_array_literal(undef);
	return_next encode_array_literal(0);
	return_next encode_array_literal(42);
	return_next encode_array_literal($_)
		for [], [0], [1..5], [[]], [[1,2,[3]],4];
	return_next encode_array_literal($_,'|')
		for [], [0], [1..5], [[]], [[1,2,[3]],4];
	return undef;
$$;

select perl_encode_array_literal();

-- test encode_array_constructor

create or replace function perl_encode_array_constructor() returns setof text language plperl as $$
	return_next encode_array_constructor(undef);
	return_next encode_array_constructor(0);
	return_next encode_array_constructor(42);
	return_next encode_array_constructor($_)
		for [], [0], [1..5], [[]], [[1,2,[3]],4];
	return undef;
$$;

select perl_encode_array_constructor();

-- test looks_like_number

create or replace function perl_looks_like_number() returns setof text language plperl as $$
	return_next "undef is undef" if not defined looks_like_number(undef);
	return_next quote_nullable($_).": ". (looks_like_number($_) ? "number" : "not number")
		for 'foo', 0, 1, 1.3, '+3.e-4',
			'42 x', # trailing garbage
			'99  ', # trailing space
			'  99', # leading space
			'    ', # only space
			'';     # empty string
	return undef;
$$;

select perl_looks_like_number();

-- test encode_typed_literal
create type perl_foo as (a integer, b text[]);
create type perl_bar as (c perl_foo[]);
create domain perl_foo_pos as perl_foo check((value).a > 0);

create or replace function perl_encode_typed_literal() returns setof text language plperl as $$
	return_next encode_typed_literal(undef, 'text');
	return_next encode_typed_literal([[1,2,3],[3,2,1],[1,3,2]], 'integer[]');
	return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo');
	return_next encode_typed_literal({c => [{a => 9, b => ['PostgreSQL']}, {b => ['Postgres'], a => 1}]}, 'perl_bar');
	return_next encode_typed_literal({a => 1, b => ['PL','/','Perl']}, 'perl_foo_pos');
$$;

select perl_encode_typed_literal();

create or replace function perl_encode_typed_literal() returns setof text language plperl as $$
	return_next encode_typed_literal({a => 0, b => ['PL','/','Perl']}, 'perl_foo_pos');
$$;

select perl_encode_typed_literal();  -- fail