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