1f7e2de9a0
The tests are not as thourough as I would like. There's many ways to mess this up. I was initially planning to drop the ref on the prepared statement immediately after executing the query, so that the $st object can be kept around for introspection without consuming excess resources. Unfortunately, PQcopyResult does not copy over information about bind parameters, so we need another way to keep that information alive. I ended up going for the simple solution: keep the ref on the prepared statement...
390 lines
13 KiB
Perl
390 lines
13 KiB
Perl
use v5.36;
|
|
use Test::More;
|
|
|
|
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};
|
|
|
|
sub okerr($sev, $act, $msg) {
|
|
is ref $@, 'FU::Pg::error';
|
|
is $@->{severity}, $sev;
|
|
is $@->{action}, $act;
|
|
like "$@", $msg;
|
|
}
|
|
|
|
ok !eval { FU::Pg->connect("invalid") };
|
|
okerr FATAL => connect => qr/missing "=" after "invalid"/;
|
|
|
|
ok FU::Pg::lib_version() > 100000;
|
|
|
|
my $conn = FU::Pg->connect($ENV{FU_TEST_DB})->text->cache(0);
|
|
$conn->_debug_trace(0);
|
|
|
|
is ref $conn, 'FU::Pg::conn';
|
|
ok $conn->server_version > 100000;
|
|
is $conn->lib_version, FU::Pg::lib_version();
|
|
is $conn->status, 'idle';
|
|
|
|
subtest '$conn->exec', sub {
|
|
ok !eval { $conn->exec('COPY (SELECT 1) TO STDOUT'); };
|
|
okerr FATAL => exec => qr/unexpected status code/;
|
|
|
|
ok !eval { $conn->exec('SELEXT'); };
|
|
okerr ERROR => exec => qr/syntax error/;
|
|
|
|
ok !defined $conn->exec('');
|
|
is $conn->exec('SELECT 1'), 1;
|
|
|
|
ok !eval { $conn->q('SELEXT')->param_types; };
|
|
okerr ERROR => prepare => qr/syntax error/;
|
|
|
|
is $conn->exec('SET client_encoding=utf8'), undef;
|
|
};
|
|
|
|
|
|
subtest '$st prepare & exec', sub {
|
|
{
|
|
my $st = $conn->q('SELECT 1');
|
|
is_deeply $st->param_types, [];
|
|
is_deeply $st->columns, [{ name => '?column?', oid => 23 }];
|
|
is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 1;
|
|
is $st->exec, 1;
|
|
ok !eval { $st->exec; 1 };
|
|
like $@, qr/Invalid attempt to execute statement multiple times/;
|
|
}
|
|
|
|
{
|
|
my $st = $conn->q("SELECT \$1::int AS a, \$2::char(5) AS \"\x{1F603}\"", 1, 2);
|
|
is_deeply $st->param_types, [ 23, 1042 ];
|
|
is_deeply $st->columns, [
|
|
{ oid => 23, name => 'a' },
|
|
{ oid => 1042, name => "\x{1F603}", typemod => 9 },
|
|
];
|
|
is $st->exec, 1;
|
|
}
|
|
|
|
is $conn->exec('SELECT 1 FROM pg_prepared_statements'), 0;
|
|
|
|
ok !eval { $conn->q('SELECT 1', 1)->exec; 1 };
|
|
like $@, qr/Statement expects 0 bind parameters but 1 were given/;
|
|
|
|
ok !eval { $conn->q('SELECT $1')->exec; 1 };
|
|
like $@, qr/Statement expects 1 bind parameters but 0 were given/;
|
|
|
|
# prepare + describe won't let us detect empty queries, hmm...
|
|
is_deeply $conn->q('')->param_types, [];
|
|
is_deeply $conn->q('')->columns, [];
|
|
|
|
ok !eval { $conn->q('')->exec; 1 };
|
|
okerr FATAL => exec => qr/unexpected status code/;
|
|
|
|
is $conn->q('SET client_encoding=utf8')->exec, undef;
|
|
};
|
|
|
|
subtest '$st->val', sub {
|
|
ok !eval { $conn->q('SELECT')->val; 1 };
|
|
like $@, qr/on query returning no data/;
|
|
|
|
ok !eval { $conn->q('SELECT 1, 2')->val; 1 };
|
|
like $@, qr/on query returning more than one column/;
|
|
|
|
ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->val; 1 };
|
|
like $@, qr/on query returning more than one row/;
|
|
|
|
ok !defined $conn->q('SELECT 1 WHERE false')->val;
|
|
ok !defined $conn->q('SELECT null')->val;
|
|
is $conn->q('SELECT $1::text', "\x{1F603}")->val, "\x{1F603}";
|
|
};
|
|
|
|
subtest '$st->rowl', sub {
|
|
ok !eval { $conn->q('SELECT 1 WHERE false')->rowl; 1 };
|
|
like $@, qr/on query returning zero rows/;
|
|
|
|
ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowl; 1 };
|
|
like $@, qr/on query returning more than one row/;
|
|
|
|
ok !eval { $conn->q('SELEXT')->rowl; 1; };
|
|
is scalar $conn->q('SELECT')->rowl, 0;
|
|
is scalar $conn->q('SELECT 1, 2')->rowl, 2;
|
|
is_deeply [$conn->q('SELECT')->rowl], [];
|
|
is_deeply [$conn->q('SELECT 1, null')->rowl], [1, undef];
|
|
is_deeply [$conn->q('SELECT 1, $1', undef)->rowl], [1, undef];
|
|
is_deeply [$conn->q('SELECT 1, $1::int', undef)->text_params(0)->rowl], [1, undef];
|
|
};
|
|
|
|
subtest '$st->rowa', sub {
|
|
ok !eval { $conn->q('SELECT 1 WHERE false')->rowa; 1 };
|
|
like $@, qr/on query returning zero rows/;
|
|
|
|
ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowa; 1 };
|
|
like $@, qr/on query returning more than one row/;
|
|
|
|
ok !eval { $conn->q('SELEXT')->rowa; 1; };
|
|
is_deeply $conn->q('SELECT')->rowa, [];
|
|
is_deeply $conn->q('SELECT 1, 2')->rowa, [1, 2];
|
|
is_deeply $conn->q('SELECT 1, null')->rowa, [1, undef];
|
|
is_deeply $conn->q('SELECT 1, $1', undef)->rowa, [1, undef];
|
|
is_deeply $conn->q('SELECT 1, $1::int', undef)->text_params(0)->rowa, [1, undef];
|
|
};
|
|
|
|
subtest '$st->rowh', sub {
|
|
ok !eval { $conn->q('SELECT 1 WHERE false')->rowh; 1 };
|
|
like $@, qr/on query returning zero rows/;
|
|
|
|
ok !eval { $conn->q('SELECT 1 UNION SELECT 2')->rowh; 1 };
|
|
like $@, qr/on query returning more than one row/;
|
|
|
|
ok !eval { $conn->q('SELECT 1 as a, 2 as a')->rowh; 1 };
|
|
like $@, qr/Query returns multiple columns with the same name/;
|
|
|
|
ok !eval { $conn->q('SELEXT')->rowh; 1; };
|
|
is_deeply $conn->q('SELECT')->rowh, {};
|
|
is_deeply $conn->q('SELECT 1 as a, 2 as b')->rowh, {a => 1, b => 2};
|
|
is_deeply $conn->q('SELECT 1 as a, null as b')->rowh, {a => 1, b => undef};
|
|
is_deeply $conn->q('SELECT 1 as a, $1::int as b', undef)->rowh, {a => 1, b => undef};
|
|
};
|
|
|
|
subtest '$st->alla', sub {
|
|
is_deeply $conn->q('SELECT 1 WHERE false')->alla, [];
|
|
is_deeply $conn->q('SELECT')->alla, [[]];
|
|
is_deeply $conn->q('SELECT 1')->alla, [[1]];
|
|
is_deeply $conn->q('SELECT 1, null UNION ALL SELECT NULL, 2')->alla, [[1,undef],[undef,2]];
|
|
};
|
|
|
|
subtest '$st->allh', sub {
|
|
ok !eval { $conn->q('SELECT 1 as a, 2 as a')->allh; 1 };
|
|
like $@, qr/Query returns multiple columns with the same name/;
|
|
|
|
is_deeply $conn->q('SELECT 1 WHERE false')->allh, [];
|
|
is_deeply $conn->q('SELECT')->allh, [{}];
|
|
is_deeply $conn->q('SELECT 1 a')->allh, [{a=>1}];
|
|
is_deeply $conn->q('SELECT 1 a, null b UNION ALL SELECT NULL, 2')->allh, [{a=>1,b=>undef},{a=>undef,b=>2}];
|
|
};
|
|
|
|
subtest '$st->flat', sub {
|
|
is_deeply $conn->q('SELECT 1 WHERE false')->flat, [];
|
|
is_deeply $conn->q('SELECT')->flat, [];
|
|
is_deeply $conn->q('SELECT 1')->flat, [1];
|
|
is_deeply $conn->q('SELECT 1, null UNION ALL SELECT NULL, 2')->flat, [1,undef,undef,2];
|
|
};
|
|
|
|
subtest '$st->kvv', sub {
|
|
ok !eval { $conn->q('SELECT')->kvv; 1; };
|
|
like $@, qr/returning no data/;
|
|
|
|
ok !eval { $conn->q('SELECT 1, 2, 3')->kvv; 1; };
|
|
like $@, qr/returning more than two columns/;
|
|
|
|
ok !eval { $conn->q('SELECT 1 UNION ALL SELECT 1')->kvv; 1; };
|
|
like $@, qr/is duplicated/;
|
|
|
|
is_deeply $conn->q('SELECT 1 WHERE false')->kvv, {};
|
|
is_deeply $conn->q('SELECT 1')->kvv, {1=>1};
|
|
is_deeply $conn->q('SELECT 1, null UNION ALL SELECT 3, 2')->kvv, {1=>undef,3=>2};
|
|
};
|
|
|
|
subtest '$st->kva', sub {
|
|
ok !eval { $conn->q('SELECT')->kva; 1; };
|
|
like $@, qr/returning no data/;
|
|
|
|
ok !eval { $conn->q('SELECT 1 UNION ALL SELECT 1')->kva; 1; };
|
|
like $@, qr/is duplicated/;
|
|
|
|
is_deeply $conn->q('SELECT 1 WHERE false')->kva, {};
|
|
is_deeply $conn->q('SELECT 1')->kva, {1=>[]};
|
|
is_deeply $conn->q("SELECT 1, null, 'hi' UNION ALL SELECT 3, 2, 'ok'")->kva,
|
|
{1=>[undef,'hi'], 3=>[2, 'ok']};
|
|
};
|
|
|
|
subtest '$st->kvh', sub {
|
|
ok !eval { $conn->q('SELECT')->kvh; 1; };
|
|
like $@, qr/returning no data/;
|
|
|
|
ok !eval { $conn->q('SELECT 1 UNION ALL SELECT 1')->kvh; 1; };
|
|
like $@, qr/is duplicated/;
|
|
|
|
ok !eval { $conn->q('SELECT 1, 2, 3')->kvh; 1; };
|
|
like $@, qr/Query returns multiple columns with the same name/;
|
|
|
|
is_deeply $conn->q('SELECT 1 WHERE false')->kvh, {};
|
|
is_deeply $conn->q('SELECT 1')->kvh, {1=>{}};
|
|
is_deeply $conn->q("SELECT 1 as a , null as a, 'hi' as b UNION ALL SELECT 3, 2, 'ok'")->kvh,
|
|
{1=>{a=>undef,b=>'hi'}, 3=>{a=>2,b=>'ok'}};
|
|
};
|
|
|
|
subtest 'txn', sub {
|
|
$conn->exec('CREATE TEMPORARY TABLE fupg_tst (id int)');
|
|
$conn->txn->exec('INSERT INTO fupg_tst VALUES (1)'); # rolled back
|
|
is $conn->q('SELECT COUNT(*) FROM fupg_tst')->val, 0;
|
|
|
|
my $st = $conn->q('SELECT COUNT(*) FROM fupg_tst');
|
|
my $sst;
|
|
{
|
|
my $txn = $conn->txn;
|
|
is $conn->status, 'txn_idle';
|
|
is $txn->status, 'idle';
|
|
|
|
ok !eval { $st->exec; 1 };
|
|
like $@, qr/Invalid cross-transaction/;
|
|
|
|
ok !eval { $conn->exec('SELECT 1'); 1 };
|
|
like $@, qr/Invalid operation on the top-level connection/;
|
|
ok !eval { $conn->q('SELECT 1'); 1 };
|
|
like $@, qr/Invalid operation on the top-level connection/;
|
|
ok !eval { $conn->txn; 1 };
|
|
like $@, qr/Invalid operation on the top-level connection/;
|
|
|
|
$txn->exec('INSERT INTO fupg_tst VALUES (1)');
|
|
$sst = $txn->q('SELECT 1');
|
|
|
|
is $conn->status, 'txn_idle';
|
|
is $txn->status, 'idle';
|
|
$txn->commit;
|
|
is $conn->status, 'txn_done';
|
|
is $txn->status, 'done';
|
|
|
|
ok !eval { $txn->rollback; 1 };
|
|
like $@, qr/Invalid operation on a transaction that has already been marked as done/;
|
|
ok !eval { $txn->commit; 1 };
|
|
like $@, qr/Invalid operation on a transaction that has already been marked as done/;
|
|
ok !eval { $txn->txn; 1 };
|
|
like $@, qr/Invalid operation on a transaction that has already been marked as done/;
|
|
ok !eval { $txn->exec('select 1'); 1 };
|
|
like $@, qr/Invalid operation on a transaction that has already been marked as done/;
|
|
ok !eval { $txn->q('select 1'); 1 };
|
|
like $@, qr/Invalid operation on a transaction that has already been marked as done/;
|
|
|
|
ok !eval { $conn->exec('SELECT 1'); 1 };
|
|
like $@, qr/Invalid operation on the top-level connection/;
|
|
}
|
|
is $conn->status, 'idle';
|
|
is $st->val, 1;
|
|
ok !eval { $sst->exec; 1 };
|
|
like $@, qr/Invalid cross-transaction/;
|
|
|
|
{
|
|
my $txn = $conn->txn;
|
|
ok !eval { $txn->exec('SELEXT'); 1 }; # puts txn in error state
|
|
is $conn->status, 'txn_error';
|
|
is $txn->status, 'error';
|
|
ok !eval { $txn->exec('SELECT 1'); 1 };
|
|
like $@, qr/current transaction is aborted/;
|
|
|
|
$txn->rollback;
|
|
is $conn->status, 'txn_done';
|
|
is $txn->status, 'done';
|
|
}
|
|
ok $conn->exec('SELECT 1');
|
|
|
|
{
|
|
my $txn = $conn->txn;
|
|
my $st = $txn->q('SELECT count(*) FROM fupg_tst WHERE id = 2');
|
|
{
|
|
my $sub = $txn->txn;
|
|
is $conn->status, 'txn_idle';
|
|
is $txn->status, 'txn_idle';
|
|
is $sub->status, 'idle';
|
|
|
|
$sub->exec('INSERT INTO fupg_tst VALUES (2)');
|
|
ok !eval { $sub->exec('SELEXT'); 1 };
|
|
|
|
ok !eval { $txn->rollback; 1 };
|
|
like $@, qr/Invalid operation on transaction/;
|
|
|
|
is $conn->status, 'txn_error';
|
|
is $txn->status, 'txn_error';
|
|
is $sub->status, 'error';
|
|
}
|
|
is $conn->status, 'txn_idle';
|
|
is $txn->status, 'idle';
|
|
is $st->val, 0;
|
|
|
|
$st = $txn->q('SELECT count(*) FROM fupg_tst WHERE id = 2');
|
|
{
|
|
my $sub = $txn->txn;
|
|
$sub->exec('INSERT INTO fupg_tst VALUES (2)');
|
|
$sub->commit;
|
|
is $conn->status, 'txn_idle';
|
|
is $txn->status, 'txn_idle'; # No way to tell that it's actually done
|
|
is $sub->status, 'done';
|
|
}
|
|
is $st->val, 1;
|
|
}
|
|
is $conn->status, 'idle';
|
|
|
|
{
|
|
my $txn = $conn->txn;
|
|
my $sub = $txn->txn;
|
|
undef $txn; # sub keeps a ref on $txn
|
|
is $sub->status, 'idle';
|
|
is $conn->status, 'txn_idle';
|
|
$sub->exec('INSERT INTO fupg_tst VALUES (3)');
|
|
$sub->commit;
|
|
}
|
|
# We didn't commit $txn, so $sub got aborted as well
|
|
is $conn->q('SELECT count(*) FROM fupg_tst WHERE id = 3')->val, 0;
|
|
};
|
|
|
|
{
|
|
local $_ = 'x';
|
|
my $st = $conn->q('SELECT $1', $_);
|
|
$_ = 'y';
|
|
is $st->val, 'x', 'shallow copy';
|
|
}
|
|
|
|
{
|
|
my $a = [1,2];
|
|
my $st = $conn->q('SELECT $1::int[]', $a)->text(0);
|
|
$a->[1] = 3;
|
|
is_deeply $st->val, [1,3], 'not deep copy';
|
|
}
|
|
|
|
subtest 'Prepared statement cache', sub {
|
|
my $txn = $conn->cache_size(2)->txn->cache;
|
|
my sub numexec($sql) {
|
|
$txn->q('SELECT generic_plans + custom_plans FROM pg_prepared_statements WHERE statement = $1', $sql)->cache(0)->val
|
|
}
|
|
is $txn->q('SELECT 1')->val, 1;
|
|
is numexec('SELECT 1'), 1;
|
|
|
|
my $sql = 'SELECT $1::int as a, $2::text as b';
|
|
ok !defined numexec($sql);
|
|
|
|
my $params = $txn->q($sql)->param_types;
|
|
is_deeply $params, [23, 25];
|
|
is numexec($sql), 0;
|
|
my $cparams = $txn->q($sql)->param_types;
|
|
is_deeply $cparams, $params;
|
|
|
|
my $cols = $txn->q($sql)->columns;
|
|
is_deeply $cols, [{ name => 'a', oid => 23 }, { name => 'b', oid => 25 }];
|
|
my $ccols = $txn->q($sql)->columns;
|
|
is_deeply $ccols, $cols;
|
|
|
|
$txn->q($sql, 0, '')->exec;
|
|
is numexec($sql), 1;
|
|
$txn->q($sql, 0, '')->exec;
|
|
is numexec($sql), 2;
|
|
|
|
is numexec('SELECT 1'), 1;
|
|
$txn->q('SELECT 2')->exec;
|
|
ok !defined numexec('SELECT 1');
|
|
is numexec('SELECT 2'), 1;
|
|
|
|
$conn->cache_size(1);
|
|
ok !defined numexec('SELECT 1');
|
|
ok !defined numexec($sql);
|
|
is numexec('SELECT 2'), 1;
|
|
|
|
$conn->cache_size(0);
|
|
ok !defined numexec($sql);
|
|
ok !defined numexec('SELECT 2');
|
|
};
|
|
|
|
{
|
|
my $st = $conn->q("SELECT 1");
|
|
undef $conn; # statement keeps the connection alive
|
|
is $st->val, 1;
|
|
}
|
|
|
|
done_testing;
|