The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
use strict;
use warnings;
use Test::More;
use Test::TCP;
use FindBin;

use UV;

my $testport = empty_port();

my $nested = 0;

my $MESSAGE = 'Failure is for the weak. Everyone dies alone.';

my $connect_cb_called  = 0;
my $write_cb_called    = 0;
my $timer_cb_called    = 0;
my $bytes_received     = 0;
my $shutdown_cb_called = 0;

# echo server
my $pid = fork;
if (!defined $pid) {
    die 'fork failed';
}
elsif (0 == $pid) {
    exec $^X, "$FindBin::Bin/echo_server.pl", $testport;
}
else {
    END { kill 9, $pid };
}

my ($client, $timer);

my $shutdown_cb = sub {
    my ($status) = @_;

    is $status, 0, 'shutdown status ok';
    is $nested, 0, 'shutdown_cb must be called from a fresh stack ok';

    $shutdown_cb_called++;
};

my $read_cb = sub {
    my ($nread, $buf) = @_;

    if ($nread == 0) {
        is UV::last_error(), UV::EAGAIN(), 'err is EAGAIN ok';
        return;
    }
    elsif ($nread == -1) {
        is UV::last_error(), UV::EOF(), 'eof ok';

        $nested++;
        UV::close($client);
        $nested--;

        return;
    }

    $bytes_received += $nread;

    if ($bytes_received == length $MESSAGE) {
        $nested++;
        UV::shutdown($client, $shutdown_cb) and die 'uv_shutdown failed';
        $nested--;
    }
};

my $timer_cb = sub {
    my ($status) = @_;

    is $status, 0, 'timer status ok';
    is $nested, 0, 'timer_cb must be called from a fresh stack ok';

    $nested++;

    UV::read_start($client, $read_cb);

    $nested--;

    $timer_cb_called++;

    UV::close($timer);
};

my $write_cb = sub {
    my ($status) = @_;

    is $status, 0, 'write status ok';
    is $nested, 0, 'write_cb must be called from a fresh stack ok';

    $nested++;

    $timer = UV::timer_init();
    UV::timer_start($timer, 500, 0, $timer_cb);

    $nested--;

    $write_cb_called++;
};

my $connect_cb = sub {
    my ($status) = @_;

    is $status, 0, 'connect status ok';
    is $nested, 0, 'connect_cb must be called from a fresh stack ok';

    $nested++;

    UV::write($client, $MESSAGE, $write_cb) and die 'uv_write failed';

    $nested--;

    $connect_cb_called++;
};

sleep 1; # wait for server

$client = UV::tcp_init();

$nested++;

if (UV::tcp_connect($client, '127.0.0.1', $testport, $connect_cb)) {
    die 'uv_tcp_connect failed';
}
$nested--;

UV::run();

is $nested, 0, 'nested ok';
is $connect_cb_called, 1, 'connect_cb must be called exactly once ok';
is $write_cb_called, 1, 'write_cb must be called exactly once ok';
is $timer_cb_called, 1, 'timer_cb must be called exactly once ok';
is $bytes_received, length $MESSAGE, 'bytes_received ok';
is $shutdown_cb_called, 1, 'shutdown_cb must be called exactly once ok';

done_testing;