view release on metacpan or  search on metacpan

t/test/20_async_future_io_unloadable_adapter.t  view on Meta::CPAN

# ---------------------------------------------------------------------------
my $tmplib = File::Temp->newdir;

# T::Unl::MissingDep::Storage::Async -- file EXISTS, but its base class dist is
# not installed (mirrors DBIO::MySQL::Storage::Async when DBIO::Async is absent).
my $missing_dir = dir_path("$tmplib", qw(T Unl MissingDep Storage));
mkpath($missing_dir);
write_file(file_path($missing_dir, 'Async.pm'), <<'EOF');
package T::Unl::MissingDep::Storage::Async;
use strict; use warnings;
use base 'DBIO::Async::NotInstalled::Storage';   # not installed -> compile dies
1;
EOF

# T::Unl::Syntax::Storage::Async -- file EXISTS, installs fine on disk, but has a
# genuine syntax error. Must NOT be misreported as a missing dependency.
my $syntax_dir = dir_path("$tmplib", qw(T Unl Syntax Storage));
mkpath($syntax_dir);
write_file(file_path($syntax_dir, 'Async.pm'), <<'EOF');
package T::Unl::Syntax::Storage::Async;
use strict; use warnings;
this is not valid perl $#@!;
1;
EOF

# T::Unl::Layer::Async -- convention sibling of a storage LAYER, present on disk
# but unloadable (missing base class). Exercises the layer-composition call site.
my $layer_dir = dir_path("$tmplib", qw(T Unl Layer));
mkpath($layer_dir);
write_file(file_path($layer_dir, 'Async.pm'), <<'EOF');
package T::Unl::Layer::Async;
use strict; use warnings;
use base 'DBIO::Async::NotInstalled::LayerBase';   # not installed -> compile dies
1;
EOF

unshift @INC, "$tmplib";

# ---------------------------------------------------------------------------
# Driver storage classes (inline; isa DBIO::Test::Storage). The ::Async siblings
# for the first two live on disk in $tmplib; the "absent" one has none anywhere.
# ---------------------------------------------------------------------------
{
  package T::Unl::MissingDep::Storage;
  use base 'DBIO::Test::Storage';
  use mro 'c3';
}
{
  package T::Unl::Syntax::Storage;
  use base 'DBIO::Test::Storage';
  use mro 'c3';
}
{
  package T::Unl::Absent::Storage;    # no ::Async anywhere in its MRO
  use base 'DBIO::Test::Storage';
  use mro 'c3';
}

# Build a driver storage of $class in future_io mode bound to a live schema,
# matching t/test/17's helper. Returns ($storage, $schema); keep $schema in
# scope (storage weakens its schema back-reference).
sub driver_storage {
  my ($class) = @_;
  my $schema  = DBIO::Test->init_schema;
  my $storage = $class->new($schema);
  $storage->_async_mode('future_io');
  delete $storage->{_async_storage_obj};
  $storage->_connect_info([ { host => 'localhost' } ]);
  return ($storage, $schema);
}

# ---------------------------------------------------------------------------
# (a) Genuinely NO adapter anywhere: the existing friendly "no adapter found"
#     croak still fires unchanged (regression guard for the untouched path).
# ---------------------------------------------------------------------------
{
  my ($storage, $schema) = driver_storage('T::Unl::Absent::Storage');
  my $async = eval { $storage->async };
  my $err   = $@;

  ok !defined($async) && $err, 'absent adapter still croaks';
  like $err, qr/does not support future_io/,
    'absent: existing future_io croak wording preserved';
  like $err, qr/no \QT::Unl::Absent::Storage::Async\E adapter found/,
    'absent: existing "no <class>::Async adapter found" wording preserved';
  unlike $err, qr/is not installed|present but/,
    'absent: not mistaken for a present-but-unloadable adapter';
}

# ---------------------------------------------------------------------------
# (b) Adapter file PRESENT but its own dependency is not installed: a clear,
#     actionable message naming the adapter AND the missing module -- not a raw
#     compile trace, and not the generic "no adapter found" (absent) wording.
# ---------------------------------------------------------------------------
{
  my ($storage, $schema) = driver_storage('T::Unl::MissingDep::Storage');
  my $async = eval { $storage->async };
  my $err   = $@;

  ok !defined($async) && $err, 'present-but-unloadable adapter croaks';
  like $err, qr/\QT::Unl::MissingDep::Storage::Async\E/,
    'present-but-unloadable: message names the adapter that could not load';
  like $err, qr/\QDBIO::Async::NotInstalled::Storage\E/,
    'present-but-unloadable: message names the actual missing module';
  like $err, qr/is not installed/,
    'present-but-unloadable: message says the dependency is not installed';
  like $err, qr/Install the distribution/,
    'present-but-unloadable: message gives an actionable install hint';

  # It must NOT be misreported as "no adapter found" -- the adapter IS present.
  unlike $err, qr/no \S+ adapter found/,
    'present-but-unloadable: NOT misreported as a genuinely-absent adapter';

  # The underlying cause is surfaced, not swallowed...
  like $err, qr/Underlying error:/,
    'present-but-unloadable: the underlying cause is surfaced, not swallowed';
  # ...but wrapped in our framing, not left as a bare Componentised stack.
  like $err, qr/present but cannot be loaded/,
    'present-but-unloadable: wrapped in our framing, not a bare compile stack';
}