# IO::Callback 1.08 t/callback.t
# Check the interface to the callback coderef
use strict;
use warnings;
use Test::More tests => 11;
use Test::Exception;
use Test::NoWarnings;
use IO::Callback;
foreach my $ret_eof ('return', 'return undef', 'return ""') {
my @blocks = ('foo', 'bar', 'RETURN_EOF', 'baz');
my $callback = eval <<EOF; die $@ if $@;
sub {
my \$blocks = shift;
my \$ret = shift \@\$blocks;
$ret_eof if \$ret eq 'RETURN_EOF';
return \$ret;
}
EOF
my $fh = IO::Callback->new('<', $callback, \@blocks);
my $got = join '', <$fh>;
is $got, "foobar", "recognised '$ret_eof' as EOF";
}
our $fh = IO::Callback->new("<", sub { return });
my $ret = read $fh, $_, 100;
is $_, "", "empty string read if callback sends nothing";
is $ret, 0, "0 len reported if callback sends nothing";
$fh = IO::Callback->new('<', sub { return IO::Callback::Error });
$ret = read $fh, $_, 100;
ok ! defined $ret, "error reported if read callback returns Error";
$fh = IO::Callback->new('<', sub { return [] });
SKIP: {
skip "perl too old", 1 if $] < 5.008;
# Running this under 5.6.2 causes the test script to exit with status 0,
# feels like an old perl bug.
throws_ok { read $fh, $_, 100 }
'/^unexpected reference type ARRAY returned by callback/',
"invalid read callback ref return trapped";
};
$fh = IO::Callback->new('>', sub { return IO::Callback::Error });
$ret = print $fh "foo\n";
ok ! defined $ret, "error reported if write callback returns Error";
$fh = IO::Callback->new('>', sub { return [] });
lives_ok { $ret = print $fh "foo\n" } "arbitrary write callback ref return: no croak";
ok $ret, "arbitrary write callback ref return: no fail";