The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use IO::Async::Test;

use Test::More;
use Test::Fatal;
use Test::Refcount;

use Errno qw( EAGAIN EWOULDBLOCK );

use IO::Async::Loop;

use IO::Async::OS;

use IO::Async::Stream;

my $loop = IO::Async::Loop->new_builtin;

testing_loop( $loop );

sub mkhandles
{
   my ( $rd, $wr ) = IO::Async::OS->pipepair or die "Cannot pipe() - $!";
   # Need handles in nonblocking mode
   $rd->blocking( 0 );
   $wr->blocking( 0 );

   return ( $rd, $wr );
}

# useful test function
sub read_data
{
   my ( $s ) = @_;

   my $buffer;
   my $ret = $s->sysread( $buffer, 8192 );

   return $buffer if( defined $ret && $ret > 0 );
   die "Socket closed" if( defined $ret && $ret == 0 );
   return "" if $! == EAGAIN or $! == EWOULDBLOCK;
   die "Cannot sysread() - $!";
}

# To test correct multi-byte encoding handling, we'll use a UTF-8 character
# that requires multiple bytes. Furthermore we'll use one that doesn't appear
# in Latin-1
#
# 'ĉ' [U+0109] - LATIN SMALL LETTER C WITH CIRCUMFLEX
#    :0xc4 0x89

# Read encoding
{
   my ( $rd, $wr ) = mkhandles;

   my $read = "";
   my $stream = IO::Async::Stream->new(
      read_handle => $rd,
      encoding => "UTF-8",
      on_read => sub {
         $read = ${$_[1]};
         ${$_[1]} = "";
         return 0;
      },
   );

   $loop->add( $stream );

   $wr->syswrite( "\xc4\x89" );

   wait_for { length $read };

   is( $read, "\x{109}", 'Unicode characters read by on_read' );

   $wr->syswrite( "\xc4\x8a\xc4" );

   $read = "";
   wait_for { length $read };

   is( $read, "\x{10a}", 'Partial UTF-8 character not yet visible' );

   $wr->syswrite( "\x8b" );

   $read = "";
   wait_for { length $read };

   is( $read, "\x{10b}", 'Partial UTF-8 character visible after completion' );

   # An invalid sequence
   $wr->syswrite( "\xc4!" );

   $read = "";
   wait_for { length $read };

   is( $read, "\x{fffd}!", 'Invalid UTF-8 byte yields U+FFFD' );

   $loop->remove( $stream );
}

# Write encoding
{
   my ( $rd, $wr ) = mkhandles;

   my $stream = IO::Async::Stream->new(
      write_handle => $wr,
      encoding => "UTF-8",
   );

   $loop->add( $stream );

   my $flushed;
   $stream->write( "\x{109}", on_flush => sub { $flushed++ } );

   wait_for { $flushed };

   is( read_data( $rd ), "\xc4\x89", 'UTF-8 bytes written by ->write string' );

   $stream->configure( write_len => 1 );

   $stream->write( "\x{109}" );

   my $byte;

   $loop->loop_once while !length( $byte = read_data( $rd ) );
   is( $byte, "\xc4", 'First UTF-8 byte written with write_len 1' );

   $loop->loop_once while !length( $byte = read_data( $rd ) );
   is( $byte, "\x89", 'Remaining UTF-8 byte written with write_len 1' );

   $flushed = 0;
   $stream->write( Future->done( "\x{10a}" ), on_flush => sub { $flushed++ } );

   wait_for { $flushed };

   is( read_data( $rd ), "\xc4\x8a", 'UTF-8 bytes written by ->write Future' );

   $flushed = 0;
   my $once = 0;
   $stream->write( sub { $once++ ? undef : "\x{10b}" }, on_flush => sub { $flushed++ } );

   wait_for { $flushed };

   is( read_data( $rd ), "\xc4\x8b", 'UTF-8 bytes written by ->write CODE' );

   $loop->remove( $stream );
}

done_testing;