view release on metacpan or  search on metacpan

t/64-options.t  view on Meta::CPAN

{
    my $f = Hyperman::Future->new;
    my $g = $f->new;
    isa_ok($g, 'Hyperman::Future', 'new on an instance');
    my $failed = Hyperman::Future->fail_future;
    is(($failed->_values)[0], "Failed\n", 'fail with no message says Failed');
    my $h = Hyperman::Future->new;
    $h->fail;
    is(($h->_values)[0], "Failed\n", 'and so does failing a pending future');
    eval { $h->get };
    like($@, qr/^Failed/, 'get on it dies with the message');
    my $done = Hyperman::Future->done_future(1, 2);
    is_deeply([ $done->_values ], [1, 2], '_values lists the result');
    is($done->await, $done, 'await on a ready future returns it');
    eval { $done->transform('lonely') };
    like($@, qr/transform: odd number/, 'transform with an odd list');
    eval { $done->transform(zzz => sub { }) };
    like($@, qr/transform: unknown argument 'zzz'/, 'transform with an unknown key');
    my $t = $done->transform(done => sub { map { $_ * 2 } @_ });
    is_deeply([ $t->_values ], [2, 4], 'transform done applies');
    my $derived = Hyperman::Future->new;
    my $upstream = Hyperman::Future->new;
    $derived->_set_upstream($upstream);
    $derived->cancel;
    ok($upstream->is_cancelled, 'cancelling the derived future cancels its upstream');
}

# --- writers of shapes that own nothing ---
{
    my $pair = bless [ -1, 0 ], 'Hyperman::Writer';
    ok($pair->write('x') < 0, 'a connection pair with no loop cannot write');
    is($pair->abort, Hyperman::Writer->can('abort') ? $pair->abort : 0, 'abort on a pair is a no-op');
    my $handle = bless [ 0, 0, 0 ], 'Hyperman::Writer';
    ok($handle->write('x') < 0, 'a freed stream handle cannot write');
    is($handle->abort, $handle->abort, 'and abort twice says the same');
    undef $handle;
    pass('a freed stream handle is destroyed quietly');
    my $h1 = bless [ -1, 0, 0, 'h1' ], 'Hyperman::Writer';
    ok($h1->write('x') < 0, 'an HTTP/1 triple with no loop cannot write');
    undef $h1;
    pass('and is destroyed quietly');
}

SKIP: {
    skip 'zlib is not built in', 2 unless Hyperman->can('has_zlib') ? Hyperman->has_zlib : defined Hyperman::_gzip('x' x 100);
    ok(!defined Hyperman::_gzip(undef), 'nothing to gzip');
    ok(!defined Hyperman::_gzip('x'), 'a byte that would not shrink');
}

# --- a log handle whose dup fails: the descriptor table is full ---
SKIP: {
    skip "fork is not Windows", 2 if $^O eq "MSWin32";
    skip "no /bin/sh to lower the descriptor limit", 2 unless -x "/bin/sh";
    my $dir = File::Temp::tempdir(CLEANUP => 1);
    for my $which (qw(access_log error_log)) {
        my $file = "$dir/dup-$which";
        my $code = "my \@hold; while (open my \$fh, q{<}, q{/dev/null}) { push \@hold, \$fh } "
            . "eval { Hyperman->run(app => sub { [200, [], [q{x}]] }, host => q{127.0.0.1}, port => 0, workers => 1, $which => \\*STDOUT) }; "
            . "print STDOUT qq{err=\$\@}";
        system "/bin/sh", "-c", "ulimit -n 48 && exec $^X -Mblib -MHyperman -e '$code' >$file 2>&1";
        my $got = do { local (@ARGV, $/) = ($file); <> } // "";
        like($got, qr/err=Hyperman->run: dup $which fd: /, "a $which handle that cannot be duplicated is refused");
    }
}

done_testing;