view release on metacpan or  search on metacpan

t/05-bind-release.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use Scalar::Util 'weaken';
use Future;

# OFFLINE regression test for karr #11 / CurtisPoe review #5 N1:
# "async bind-value leak". No EV::Pg, no real DB.
#
# WHAT THE TICKET FEARED (ported from the sync DBI driver's contract):
#   bind values issued through the async pool are retained on an in-flight
#   future / per-pool cache, so (1) a re-issued query could see stale binds
#   and (2) memory grows with total binds ever issued, not with outstanding
#   queries.
#
# WHAT THIS DRIVER ACTUALLY DOES: it bypasses DBI and hands each freshly-built
# @bind arrayref straight to EV::Pg->query_params, which serializes the params
# into libpq's wire buffer. The completion closure in _query_async /
# _query_async_pinned captures $f, $self, $pg, $sql -- but NOT $bind. So the
# ONLY live Perl reference to the bind arrayref is the lexical in the issuing
# scope, which dies when that scope returns. There is no storage/pool cache
# that accumulates binds (the pool's _ready table holds readiness Futures
# only). The "bind-clearing contract" is therefore lexical lifetime, not an
# explicit wipe -- and there is nothing to leak.
#
# WHY THIS TEST CAN ENCODE THAT INTENT WITHOUT A SERVER: the bind-retention
# question is a pure Perl reference-graph question. FakePg below faithfully
# emulates libpq's query_params contract -- it COPIES the params into private
# storage and retains ONLY the callback, never the $bind arrayref. We run the
# real _query_async / _query_async_pinned code through it, hold a weak ref to
# each bind arrayref, let the strong issuing-scope lexical drop, and assert the
# weak ref is gone. This FAILS the moment _query_async's closure starts closing
# over $bind, or the storage/pool starts stashing it anywhere keyed by query --
# i.e. exactly the leak shape the ticket describes. (Verified by hand: a variant
# whose completion closure captures $bind keeps every weak ref alive here.)

# --- FakePg: faithful EV::Pg->query_params contract -----------------------
#
# Stores ONLY the callback (like libpq keeping a pending-result slot), and
# copies the params into a private string list (like PQsendQueryParams
# serializing them onto the wire). It deliberately does NOT keep the $bind
# arrayref, so anything that survives must be held by DBIO's own code.
package FakePg;
sub new { bless { queue => [] }, shift }
sub query_params {
  my ($self, $sql, $bind, $cb) = @_;
  my @serialized = map { defined $_ ? "$_" : undef } @$bind;
  push @{ $self->{queue} }, { cb => $cb, wire => \@serialized };
}
sub pending_count { scalar @{ $_[0]->{queue} } }
# Complete the oldest in-flight query, firing its callback like a finished
# libpq result. The dequeued entry (cb + wire copy) is dropped here.
sub complete_one {
  my $self = shift;
  my $entry = shift @{ $self->{queue} } or return;
  $entry->{cb}->([[1]], undef);
}

# --- FakePool: hands back the FakePg, no per-query bookkeeping -------------
package FakePool;
sub new { bless { pg => $_[1] }, $_[0] }
sub acquire { Future->done($_[0]->{pg}) }
sub release { }   # no-op: the pool stores the connection, never the bind
sub shutdown { }

package main;

use DBIO::PostgreSQL::EV::Storage;

# Build a storage whose pool is our FakePool. _query_async acquires from the
# pool and calls query_params on whatever connection it gets.
sub new_storage {
  my $pg = FakePg->new;
  my $storage = DBIO::PostgreSQL::EV::Storage->new(undef);
  $storage->{pool} = FakePool->new($pg);
  return ($storage, $pg);
}

# --- 1. single pooled query: bind released once the future completes -------
{
  my ($storage, $pg) = new_storage;

  my $weak;
  my $f;
  {
    my $bind = [ 'payload' x 64 ];   # a large-ish bind, like the repro
    weaken($weak = $bind);
    $f = $storage->_query_async('SELECT $1', $bind);
  }   # the issuing-scope strong lexical dies here

  $pg->complete_one;
  $f->get;

  ok !defined $weak,
    'pooled query: bind arrayref is freed after the future completes '