view release on metacpan or  search on metacpan

t/read_timeout.t  view on Meta::CPAN

# returns 0, while an expiry sets EAGAIN and returns undef.
package Test::ReadTimeout::Handle;

sub TIEHANDLE {
  my ($class, $script) = @_;
  return bless { script => $script, i => 0 }, $class;
}

sub _next {
  my ($self) = @_;
  return $self->{script}[ $self->{i}++ ] || {};
}

# sysread reaches a tied handle through READ, so this is the whole interface
# the transport uses now -- READLINE is gone from here because nothing calls
# it any more: _read_line finds its terminator in the transport's own buffer.
sub READ {
  my $self = $_[0];
  my $act  = $self->_next;

  # sysread cannot deliver and expire in the same call, unlike the PerlIO
  # read() this harness was first written against. An entry that tries to be
  # both is a script that was not translated when karr k60 landed, and saying
  # so here is cheaper than the silent near-miss it would otherwise be.
  die "a scripted read cannot both deliver and expire\n"
    if ($act->{timeout} || $act->{eintr} || $act->{fail})
      && (defined $act->{line} || defined $act->{bytes});

  # Set last and read first: errno is only meaningful straight after the
  # operation that failed, which is exactly the discipline the code under
  # test has to keep. With keep_errno it is left exactly as the caller left
  # it, which is how a stale value gets in front of the check.
  unless ($act->{keep_errno}) {
    $! = $act->{timeout} ? Errno::EAGAIN()
      : $act->{eintr}    ? Errno::EINTR()
      : 0;
  }
  return undef if $act->{timeout} || $act->{eintr} || $act->{fail};

  my $data = defined $act->{line} ? $act->{line}
    : defined $act->{bytes} ? $act->{bytes} : '';
  $_[1] = $data;
  # 0 is the clean end of the response, and is the only thing that means it.
  return length $data;
}

sub CLOSE { 1 }

package main;

my $client = API::Docker->new(
  host        => 'unix:///nonexistent.sock',
  api_version => '1.41',
);

my $ENDPOINT = 'GET /v1.41/probe';

sub scripted {
  my (@script) = @_;
  no warnings "once";
  my $glob = \do { local *HANDLE };
  tie *$glob, 'Test::ReadTimeout::Handle', \@script;
  return $glob;
}

# A context with the clock running, and one without. The second is what every
# call made before this option existed passes, and it must leave every read
# site behaving exactly as it did.
sub ctx      { return { endpoint => $ENDPOINT, timeout => 2 } }
sub ctx_off  { return { endpoint => $ENDPOINT } }

# Run $code and report whether it raised a timeout, so the two meanings of one
# short read can be asserted side by side.
sub timed_out {
  my ($code) = @_;
  my @out = eval { $code->() };
  my $err = $@;
  return (undef, $err) if $err && ref $err
    && $err->isa('API::Docker::Error::Timeout');
  return (\@out, undef) unless $err;
  return (undef, undef, $err);
}

# Reading an attribute off whatever was raised, so a mutation that stops
# raising one fails the assertion it belongs to instead of dying and taking
# the rest of the file with it -- a red test has to stay readable.
sub attr {
  my ($err, $name) = @_;
  return ref $err && $err->can($name) ? $err->$name : undef;
}

# The pair of assertions every read site gets: with EAGAIN it croaks with a
# timeout, without it it does whatever a real end of the response means at
# that site. A test that only made the first half would pass just as well
# against a transport that croaked on every end of response.
#
# The second half is declared, not merely inspected. Each site says which of
# the two shapes it has -- `returns => sub {...}` for a site where the close
# really is the end of the response, `raises => sub {...}` for one where it is
# not -- and site_ok asserts that it is that shape and not the other one. The
# earlier version took a single check sub and ran it either way, so a site
# that started croaking where it used to return still passed as long as the
# check itself did not look at the return value. Four of the streaming sites
# below were in exactly that position when karr k64 landed: the check asserted
# what had reached the callback, which a croak does not change, so the change
# in outcome went unseen. Declaring the shape is what makes those four able to
# fail.
sub site_ok {
  my ($name, $make_handle, $drive, %eof) = @_;

  die "site_ok $name: declare exactly one of returns/raises\n"
    unless 1 == grep { $eof{$_} } qw( returns raises );

  subtest $name => sub {
    my ($out, $err, $other) = timed_out(
      sub { $drive->($make_handle->(1), ctx()) });
    ok !$other, 'the expiry raised nothing but a timeout'
      or diag "raised instead: $other";
    ok $err, 'ran out of time -> API::Docker::Error::Timeout';
    is $err && attr($err, "timeout"), 2, 'the error names the timeout that expired'
      if $err;
    is $err && attr($err, "endpoint"), $ENDPOINT, 'and the request it belongs to'
      if $err;