1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use IO::Async::Test; 7 8use Test::More; 9use Test::Fatal; 10use Test::Refcount; 11 12use Errno qw( EAGAIN EWOULDBLOCK ); 13 14use IO::Async::Loop; 15 16use IO::Async::OS; 17 18use IO::Async::Stream; 19 20my $loop = IO::Async::Loop->new_builtin; 21 22testing_loop( $loop ); 23 24sub mkhandles 25{ 26 my ( $rd, $wr ) = IO::Async::OS->pipepair or die "Cannot pipe() - $!"; 27 # Need handles in nonblocking mode 28 $rd->blocking( 0 ); 29 $wr->blocking( 0 ); 30 31 return ( $rd, $wr ); 32} 33 34# useful test function 35sub read_data 36{ 37 my ( $s ) = @_; 38 39 my $buffer; 40 my $ret = $s->sysread( $buffer, 8192 ); 41 42 return $buffer if( defined $ret && $ret > 0 ); 43 die "Socket closed" if( defined $ret && $ret == 0 ); 44 return "" if $! == EAGAIN or $! == EWOULDBLOCK; 45 die "Cannot sysread() - $!"; 46} 47 48# To test correct multi-byte encoding handling, we'll use a UTF-8 character 49# that requires multiple bytes. Furthermore we'll use one that doesn't appear 50# in Latin-1 51# 52# 'ĉ' [U+0109] - LATIN SMALL LETTER C WITH CIRCUMFLEX 53# :0xc4 0x89 54 55# Read encoding 56{ 57 my ( $rd, $wr ) = mkhandles; 58 59 my $read = ""; 60 my $stream = IO::Async::Stream->new( 61 read_handle => $rd, 62 encoding => "UTF-8", 63 on_read => sub { 64 $read = ${$_[1]}; 65 ${$_[1]} = ""; 66 return 0; 67 }, 68 ); 69 70 $loop->add( $stream ); 71 72 $wr->syswrite( "\xc4\x89" ); 73 74 wait_for { length $read }; 75 76 is( $read, "\x{109}", 'Unicode characters read by on_read' ); 77 78 $wr->syswrite( "\xc4\x8a\xc4" ); 79 80 $read = ""; 81 wait_for { length $read }; 82 83 is( $read, "\x{10a}", 'Partial UTF-8 character not yet visible' ); 84 85 $wr->syswrite( "\x8b" ); 86 87 $read = ""; 88 wait_for { length $read }; 89 90 is( $read, "\x{10b}", 'Partial UTF-8 character visible after completion' ); 91 92 # An invalid sequence 93 $wr->syswrite( "\xc4!" ); 94 95 $read = ""; 96 wait_for { length $read }; 97 98 is( $read, "\x{fffd}!", 'Invalid UTF-8 byte yields U+FFFD' ); 99 100 $loop->remove( $stream ); 101} 102 103# Write encoding 104{ 105 my ( $rd, $wr ) = mkhandles; 106 107 my $stream = IO::Async::Stream->new( 108 write_handle => $wr, 109 encoding => "UTF-8", 110 ); 111 112 $loop->add( $stream ); 113 114 my $flushed; 115 $stream->write( "\x{109}", on_flush => sub { $flushed++ } ); 116 117 wait_for { $flushed }; 118 119 is( read_data( $rd ), "\xc4\x89", 'UTF-8 bytes written by ->write string' ); 120 121 $stream->configure( write_len => 1 ); 122 123 $stream->write( "\x{109}" ); 124 125 my $byte; 126 127 $loop->loop_once while !length( $byte = read_data( $rd ) ); 128 is( $byte, "\xc4", 'First UTF-8 byte written with write_len 1' ); 129 130 $loop->loop_once while !length( $byte = read_data( $rd ) ); 131 is( $byte, "\x89", 'Remaining UTF-8 byte written with write_len 1' ); 132 133 $flushed = 0; 134 $stream->write( Future->done( "\x{10a}" ), on_flush => sub { $flushed++ } ); 135 136 wait_for { $flushed }; 137 138 is( read_data( $rd ), "\xc4\x8a", 'UTF-8 bytes written by ->write Future' ); 139 140 $flushed = 0; 141 my $once = 0; 142 $stream->write( sub { $once++ ? undef : "\x{10b}" }, on_flush => sub { $flushed++ } ); 143 144 wait_for { $flushed }; 145 146 is( read_data( $rd ), "\xc4\x8b", 'UTF-8 bytes written by ->write CODE' ); 147 148 $loop->remove( $stream ); 149} 150 151done_testing; 152