2aaec6a218
NOW we're really getting to the part where this module is more awesome than DBD::Pg. (When I started working on this module I was expecting that the Postgres binary protocol would send jsonb in a binary format as well and that I'd be duplicating parts of the JSON parser/formatter to make that work, but it turns out that Postgres just uses plain json for exchange. Saves me some trouble, I guess)
93 lines
3.4 KiB
Perl
93 lines
3.4 KiB
Perl
use v5.36;
|
|
use Test::More;
|
|
no warnings 'experimental::builtin';
|
|
use builtin qw/true false is_bool created_as_number/;
|
|
|
|
plan skip_all => $@ if !eval { require FU::PG; } && $@ =~ /Unable to load libpq/;
|
|
die $@ if $@;
|
|
plan skip_all => 'Please set FU_TEST_DB to a PostgreSQL connection string to run these tests' if !$ENV{FU_TEST_DB};
|
|
|
|
my $conn = FU::PG->connect($ENV{FU_TEST_DB});
|
|
$conn->_debug_trace(0);
|
|
|
|
# TODO: Test behavior of magic bind params
|
|
|
|
sub v($type, $p_in, @args) {
|
|
my $p_out = @args > 0 && defined $args[0] ? $args[0] : $p_in;
|
|
my $s_in = @args > 1 && defined $args[1] ? $args[1] : $p_in;
|
|
my $s_out = @args > 2 && defined $args[2] ? $args[2] : $s_in;
|
|
|
|
{
|
|
my $res = $conn->q("SELECT \$1::$type", $s_in)->text_params->val;
|
|
ok is_bool($res), "$type $s_in is bool" if $type eq 'bool';
|
|
ok created_as_number($res), "$type $s_in is number" if $type =~ /^int/;
|
|
is_deeply $res, $p_out, "$type $s_in text->bin" =~ s/\n/\\n/rg;
|
|
}
|
|
{
|
|
my $res = $conn->q("SELECT \$1::$type", $p_in)->text_results->val;
|
|
is $res, $s_out, "$type $s_out bin->text" =~ s/\n/\\n/rg;
|
|
}
|
|
{
|
|
my $res = $conn->q("SELECT \$1::$type", $p_in)->val;
|
|
is_deeply $res, $p_out, "$type $s_in bin->bin" =~ s/\n/\\n/rg;
|
|
}
|
|
}
|
|
sub f($type, $p_in) {
|
|
ok !eval { $conn->q("SELECT \$1::$type", $p_in)->val; 1 }, "$type $p_in fail";
|
|
}
|
|
|
|
v bool => true, undef, 1, 't';
|
|
v bool => false, undef, 0, 'f';
|
|
|
|
v int2 => $_ for (1, -1, -32768, 32767, '12345', -12345, 123.0);
|
|
f int2 => $_ for (-32769, 32768, [], '', 'a', 1.5);
|
|
v int4 => $_ for (1, -1, -2147483648, 2147483647, 1234567890, -1234567890);
|
|
f int4 => $_ for (-2147483649, 2147483648, []);
|
|
v int8 => $_ for (1, -1, -9223372036854775808, 9223372036854775807, 1234567890123456789, -1234567890123456789, 1e10);
|
|
f int8 => $_ for ('aaa', '-9223372036854775809', '9223372036854775808', 1e20);
|
|
|
|
for my $t (qw/regproc oid xid cid regprocedure regoper regoperator regtype regconfig regdictionary regnamespace regrole regcollation/) {
|
|
# These numbers must not refer to an existing thing in the database, otherwise the text format differs
|
|
v $t, $_ for (1, 12345678, 4294967295);
|
|
f $t, $_ for (-1, 4294967296);
|
|
}
|
|
v regtype => 17, undef, 'bytea'; # like this
|
|
|
|
v bytea => '', undef, '\x';
|
|
v bytea => 'hello', undef, '\x68656c6c6f';
|
|
v bytea => "\xaf\x90", undef, '\xaf90';
|
|
f bytea => "\x{1234}";
|
|
|
|
v '"char"' => $_ for (1, '1', 'a', 'A', '-');
|
|
v '"char"' => "\x84", undef, '\204';
|
|
f '"char"' => $_ for ('', 'ab', "\x{1234}");
|
|
|
|
for my $t (qw/name text bpchar varchar/) {
|
|
v $t, $_ for ('', "\x{1234}", "hello, world");
|
|
}
|
|
f name => 'a'x64;
|
|
# These truncate rather than throw an error on conversion?
|
|
v 'char(3)' => 'abcd', 'abc', 'abcd', 'abc';
|
|
v 'varchar(3)' => 'abcd', 'abc', 'abcd', 'abc';
|
|
|
|
# TODO: xml; requires postgres to be built with support for it
|
|
|
|
v float4 => $_ for (0, 1234, 1.5);
|
|
f float4 => $_ for ('', 'a', '123g', []);
|
|
v float8 => $_ for (0, 1234, 1.5);
|
|
f float8 => $_ for ('', 'a', '123g', []);
|
|
|
|
# Limitation: There's no way to send a JSON 'null' or differentiate between that and SQL NULL.
|
|
v json => {}, undef, '{}';
|
|
# XXX: Huh, what's causing this "pretty" formatting?
|
|
v json => [1, undef, true, "hello"], undef, qq#[\n 1,\n null,\n true,\n "hello"\n]#;
|
|
f json => \1;
|
|
|
|
v jsonb => {}, undef, '{}';
|
|
v jsonb => [1, undef, true, "hello"], undef, '[1, null, true, "hello"]';
|
|
f jsonb => \1;
|
|
|
|
v jsonpath => $_ for ('$."key"', '$."a[*]"?(@ > 2)');
|
|
f jsonpath => $_ for ('', 'hello world');
|
|
|
|
done_testing;
|