view release on metacpan or  search on metacpan

t/13-async-e2e.t  view on Meta::CPAN

# Truncate so reruns in the same DB don't accumulate rows.
{
  my $f = $storage->txn_do_async(sub {
    my ($txn) = @_;
    return $txn->_query_async("TRUNCATE TABLE $TABLE", []);
  });
  pump_until(sub { $f->is_ready });
  ok $f->is_ready && !$f->is_failed, "truncated $TABLE"
    or diag "truncate failure: " . ($f->failure // 'unknown');
}

# Populate with 16 rows. Each row is its own one-insert transaction so we
# never have multiple in-flight queries on a single pinned EV::MariaDB
# connection (which would trip EV::MariaDB's "exclusive operation in
# progress" guard — a property of the EV::MariaDB API, not of this
# driver). The concurrency block below is what actually proves
# in-flight parallelism, and it does so across MULTIPLE pool connections
# (one acquire per facade call).
for my $i (1 .. 16) {
  my $f = $storage->txn_do_async(sub {
    my ($txn) = @_;
    return $txn->insert_async(
      $TABLE,
      { label => "row-$i", value => $i * 10 },
    );
  });
  pump_until(sub { $f->is_ready });
  ok $f->is_ready && !$f->is_failed, "inserted row-$i"
    or diag "populate-$i failure: " . ($f->failure // 'unknown');
}

# =============================================================================
# BLOCK 1 — NON-BLOCKING PROOF
# A single select_async MUST return BEFORE the EV::MariaDB has answered.
# The defining async property: the Future is still pending at the moment
# the call returned. EV::run is what drives it to completion.
#
# Determinism note: the SELECT is wrapped in `AND SLEEP(0.05) = 0` so the
# server-side round-trip is forced to ~50ms. EV::MariaDB's pipelining can
# otherwise fire callbacks synchronously when the conn is hot (a previously
# released pool conn's TCP buffers still hold a queued response), making
# the Future resolve before the caller observes its return value. 50ms is
# long enough that the response cannot be in the kernel buffer at the
# moment the SQL hits the wire — the callback MUST be dispatched via EV::run.
# =============================================================================

subtest 'non-blocking: facade call returns before DB answers' => sub {
  # Issue the facade query. Do NOT pump EV::run yet.
  my $f = $storage->select_async(
    $TABLE,
    '*',
    { -and => [
        { label => 'row-7' },
        \"SLEEP(0.05) = 0",
      ]
    },
  );

  isa_ok $f, 'Future', 'select_async returns a Future';

  # THIS is the assertion that defines async-ness. If the call blocked
  # waiting for the DB, $f->is_ready would already be true here.
  ok !$f->is_ready,
    'Future is PENDING the instant select_async returns '
    . '(proves the call did not block on the DB)';

  # Now drive the event loop until it settles. Timeout bumped from 500 to
  # 5000 to give the SLEEP-injected query headroom under load.
  pump_until(sub { $f->is_ready }, 5000);

  ok $f->is_ready, 'Future resolves after EV::run drives the EV::MariaDB callback';
  ok !$f->is_failed, 'Future succeeded (no query error)';

  my @rows = $f->get;
  is scalar(@rows), 1, 'exactly one row matches label=row-7';
  is $rows[0][1], 'row-7', 'row label matches the WHERE clause';
  is $rows[0][2], 70,     'row value matches what was inserted (7 * 10)';
};

# =============================================================================
# BLOCK 2 — CONCURRENCY PROOF
# N facade calls issued in a tight loop are ALL pending simultaneously.
# No event loop has run between the calls — only after the loop.
# Each Future resolves with its own correct result, regardless of order.
#
# Determinism note: every SELECT here carries AND SLEEP(0.05) = 0 so the
# server-side round-trip is forced to ~50ms (see Block 1 for rationale).
# Without it, EV::MariaDB's pipelining on a hot pool conn can resolve some
# of these 16 Futures synchronously, intermittently failing the
# "all 16 PENDING before any EV::run" assertion.
# =============================================================================

subtest 'concurrency: N facade queries are all in-flight before any EV::run' => sub {
  my $N = 16;
  my @futures;

  # Tight loop — no EV::run in here. Each select also pulls
  # CONNECTION_ID() AS cid from the server so we can prove below that the
  # 16 in-flight queries landed on 16 DISTINCT backend connections — not
  # one hot one (which is what an LIFO pool acquire does: it reuses the
  # most-recently-released conn every time, so all 16 facade calls hit
  # the same backend CONNECTION_ID). With a FIFO pool the CIDs fan out
  # 1-per-pool-slot.
  for my $i (1 .. $N) {
    push @futures, $storage->select_async(
      $TABLE,
      # CONNECTION_ID() is a literal SQL expr (scalarref -- a plain string
      # would be backtick-quoted into an unknown column); the star must be
      # table-qualified ($TABLE.*), since a bare `*` after a named select-expr
      # is a syntax error on MySQL/MariaDB.
      [ \'CONNECTION_ID() AS cid', "$TABLE.*" ],
      { -and => [
          { label => "row-$i" },
          \"SLEEP(0.05) = 0",
        ]
      },
    );
  }

  ok scalar(@futures) == $N, "issued $N facade select_async calls";

  # EVERY Future must be pending right now. If the driver accidentally
  # serialized or blocked, some/all would already be ready.
  my @pending = grep { !$_->is_ready } @futures;
  is scalar(@pending), $N,
    "all $N Futures are PENDING before any EV::run "
    . '(proves the facade does not serialize via blocking)';

  # Drive EV::run until ALL are ready. Timeout bumped to 5000: with
  # 50ms SLEEP on each conn, 16 in-flight on 16 pool conns should drain
  # in roughly 50ms — give 100x headroom for pool contention or future
  # refactors that serialize any of the acquires.
  pump_until(sub { !grep { !$_->is_ready } @futures }, 5000);

  ok !(grep { !$_->is_ready } @futures),
    'all N Futures resolved after a single EV::run drain';

  # Each future resolves to its own row — distinct WHERE values, distinct
  # expected values. This proves completion order is decoupled from issue
  # order: even if the server returns them in a different order, each
  # future carries the row that matches ITS own WHERE.
  my %seen_cid;
  for my $i (1 .. $N) {
    my $f = $futures[$i - 1];
    ok $f->is_ready && !$f->is_failed,
      "future $i (row-$i) settled successfully";
    my @rows = $f->get;
    is scalar(@rows), 1, "future $i returned exactly one row";
    is $rows[0][2], "row-$i", "future $i got the row matching its own WHERE";
    is $rows[0][3], $i * 10, "future $i got the correct value ($i * 10)";
    # Column 0 is `cid` (CONNECTION_ID()), column 1 is the auto-increment `id`,
    # column 2 is `label`, column 3 is `value`.
    $seen_cid{ $rows[0][0] }++;
  }

  # The whole point of the FIFO pool fix (karr #13): each acquire hands
  # out a distinct idle conn, so each backend hit carries its own
  # CONNECTION_ID. Pre-fix this would collapse to 1 distinct CID even
  # with 16 in-flight Futures (LIFO pool releases back to the same conn).
  is scalar(keys %seen_cid), $N,
    "all $N concurrent queries landed on $N DISTINCT backend connections "
    . '(proves the pool acquire is FIFO, not LIFO — '
    . 'see karr #13: each facade call hit a unique server-side CONNECTION_ID)';
};

# =============================================================================
# BLOCK 3 — TRANSACTION PINNING (BEGIN/COMMIT + visible-after-commit)
# txn_do_async pins the CRUD ops to the SAME EV::MariaDB handle that ran
# BEGIN and will run COMMIT. We prove this end-to-end by:
#   (a) capturing txn_mdb at entry and confirming refaddr is stable across
#       CRUD ops (same EV::MariaDB handle),
#   (b) INSERT inside the txn,
#   (c) SELECT inside the txn sees the inserted row,
#   (d) COMMIT, then a fresh facade SELECT (different conn from the pool)
#       also sees the row.
# Then a ROLLBACK variant: insert inside a failing txn, then the row must
# NOT be visible from a fresh facade SELECT.
# =============================================================================

subtest 'txn pinning: BEGIN/COMMIT/INSERT/SELECT run on the same pinned conn' => sub {
  my $label = 'txn-commit-row';
  my $value = 4242;