The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Fatal qw( dies_ok );
use Test::HexString;
use Test::Memory::Cycle;
use IO::Async::Test;
use IO::Async::Loop;
use IO::Async::OS;

use Tangence::Constants;
use Tangence::Registry;

use t::Conversation;

use Net::Async::Tangence::Client;
$Tangence::Message::SORT_HASH_KEYS = 1;

unless( VERSION_MAJOR == 0 and VERSION_MINOR == 4 ) {
   plan skip_all => "Tangence version mismatch";
}

my $loop = IO::Async::Loop->new();
testing_loop( $loop );

my ( $S1, $S2 ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!";

{
   my $clientstream = "";
   sub wait_for_message
   {
      my $msglen;
      wait_for_stream { length $clientstream >= 5 and
                        length $clientstream >= ( $msglen = 5 + unpack "xN", $clientstream ) } $S2 => $clientstream;

      return substr( $clientstream, 0, $msglen, "" );
   }
}

my $client = Net::Async::Tangence::Client->new(
   handle => $S1,
   on_error => sub { die "Test died early - $_[0]" },
   identity => "testscript",
);
$loop->add( $client );

# Initialisation
{
   is_hexstr( wait_for_message, $C2S{INIT}, 'client stream initially contains MSG_INIT' );

   $S2->syswrite( $S2C{INITED} );

   is_hexstr( wait_for_message, $C2S{GETROOT}, 'client stream contains MSG_GETROOT' );

   $S2->syswrite( $S2C{GETROOT} );

   wait_for { defined $client->rootobj };

   is_hexstr( wait_for_message, $C2S{GETREGISTRY}, 'client stream contains MSG_GETREGISTRY' );

   $S2->syswrite( $S2C{GETREGISTRY} );

   wait_for { defined $client->registry };
}

my $objproxy = $client->rootobj;

# Methods
{
   my $f = $objproxy->call_method(
      method => 10, "hello",
   );

   is_hexstr( wait_for_message, $C2S{CALL}, 'client stream contains MSG_CALL' );

   $S2->syswrite( $S2C{CALL} );

   wait_for { $f->is_ready };

   is( scalar $f->get, "10/hello", 'result of call_method()' );
}

# That'll do; everything should be tested by Tangence itself

memory_cycle_ok( $objproxy, '$objproxy has no memory cycles' );

# Deconfigure the clientection otherwise Devel::Cycle will throw
#   Unhandled type: GLOB at /usr/share/perl5/Devel/Cycle.pm line 107.
# on account of filehandles
$client->configure( handle => undef );
memory_cycle_ok( $client, '$client has no memory cycles' );

done_testing;