view release on metacpan or  search on metacpan

t/composed/async_layer_default_seam.t  view on Meta::CPAN

# ABSTRACT: an async layer that declares NO required_transport_capabilities
# is treated as requiring the default query seam (_query_async), so a transport that
# does not own the query path (Model A / forked shape) refuses the composition.
#
# The capability gate used to protect by DECLARATION, not by SEAM: a layer that
# declared a requirement and did not find it was stopped, but a layer that simply said
# nothing composed onto ANY transport without a word -- including one with no
# _query_async for it to wrap, which is exactly the silent feature loss ADR 0032 §5
# exists to prevent. "Says nothing" is now the safe case, not the unchecked one.
use strict;
use warnings;

use Test::More;

use DBIO::Test;
use DBIO::Test::Storage;
use DBIO::Storage::DBI;
use DBIO::Storage::Async;
use DBIO::Storage::Composed;
use DBIO::Future::Immediate;

# ---------------------------------------------------------------------------
# Two transports of the two shapes the seam question distinguishes.
# ---------------------------------------------------------------------------

# Model B: owns the query path -- it overrides the _query_async seam, so a layer
# can wrap it. Every real pooled transport (DBIO::Async::Storage, the EV
# transports and everything derived from them) has this shape.
{
  package T::LDS::SeamTransport;
  use base 'DBIO::Storage::Async';
  use mro 'c3';
  sub future_class { 'DBIO::Future::Immediate' }
  sub _query_async {
    my ($self, $sql, $bind) = @_;
    push @{ $self->{recorded} ||= [] }, $sql;
    return DBIO::Future::Immediate->done([]);
  }
}

# Model A: the DBIO::Forked shape -- it overrides the six *_async entry points
# directly and runs the driver's ordinary sync CRUD elsewhere, so it inherits the
# abstract _query_async stub and there is NO seam for a layer to wrap.
{
  package T::LDS::ModelATransport;
  use base 'DBIO::Storage::Async';
  use mro 'c3';
  sub future_class        { 'DBIO::Future::Immediate' }
  sub select_async        { DBIO::Future::Immediate->done([]) }
  sub select_single_async { DBIO::Future::Immediate->done([]) }
  sub insert_async        { DBIO::Future::Immediate->done([]) }
  sub update_async        { DBIO::Future::Immediate->done(0)  }
  sub delete_async        { DBIO::Future::Immediate->done(0)  }
  sub txn_do_async        { DBIO::Future::Immediate->done(1)  }
}

# Sanity: the two transports really do differ in the one property under test.
my $abstract_seam = DBIO::Storage::Async->can('_query_async');
isnt( T::LDS::SeamTransport->can('_query_async'), $abstract_seam,
  'sanity: the Model B transport overrides the _query_async seam' );
is( T::LDS::ModelATransport->can('_query_async'), $abstract_seam,
  'sanity: the Model A transport inherits the abstract stub -- no seam' );

# ---------------------------------------------------------------------------
# Layers. "Silent" declares nothing at all; "Explicit" declares a real
# capability; "Nothing" declares an EXPLICIT empty list (the documented opt-out
# for a layer that genuinely needs nothing from the transport).
# ---------------------------------------------------------------------------
{ package T::LDS::Silent;          sub silent_sync { 1 } }
{ package T::LDS::Silent::Async;   sub silent_async { 1 } }

{ package T::LDS::Explicit;        sub explicit_sync { 1 } }
{
  package T::LDS::Explicit::Async;
  sub required_transport_capabilities { ('x') }
  sub explicit_async { 1 }
}

{ package T::LDS::Nothing;         sub nothing_sync { 1 } }
{
  package T::LDS::Nothing::Async;
  sub required_transport_capabilities { () }
  sub nothing_async { 1 }
}

# Build a fresh sync storage bound to a live schema carrying @layers, in the
# 'ram' mode the caller's storage class registered. Returns ($storage, $schema);
# the caller MUST hold $schema in scope (storage weakens its schema ref).
sub build_storage {
  my ($storage_class, @layers) = @_;
  my $schema = DBIO::Test->init_schema;
  $schema->register_storage_layer($_) for @layers;
  my $storage = $storage_class->new($schema);
  $storage->connect_info([ 'dbi:LDSMock:', '', '', { async => 'ram' } ]);
  return ($storage, $schema);
}

# ===========================================================================
# (a) A layer that declares NOTHING composes over a transport that DOES provide
#     the default seam -- the overwhelmingly common case must stay silent.
# ===========================================================================
{
  package T::LDS::A::Storage; use base 'DBIO::Test::Storage'; use mro 'c3';
}
T::LDS::A::Storage->register_async_mode( ram => 'T::LDS::SeamTransport' );

{
  my ($storage, $schema) = build_storage('T::LDS::A::Storage', 'T::LDS::Silent');
  my $async = eval { $storage->async };
  my $err   = $@;
  ok !$err, 'an undeclared layer composes over a transport that owns the query path'
    or diag "died with: $err";