1#!/usr/bin/perl 2 3use v5.10; 4use strict; 5use warnings; 6 7use Test::More; 8use Test::Identity; 9 10# subclass->... 11{ 12 my $f = t::Future::Subclass->new; 13 my @seq; 14 15 isa_ok( $seq[@seq] = $f->then( sub {} ), 16 "t::Future::Subclass", 17 '$f->then' ); 18 19 isa_ok( $seq[@seq] = $f->else( sub {} ), 20 "t::Future::Subclass", 21 '$f->and_then' ); 22 23 isa_ok( $seq[@seq] = $f->then_with_f( sub {} ), 24 "t::Future::Subclass", 25 '$f->then_with_f' ); 26 27 isa_ok( $seq[@seq] = $f->else_with_f( sub {} ), 28 "t::Future::Subclass", 29 '$f->else_with_f' ); 30 31 isa_ok( $seq[@seq] = $f->followed_by( sub {} ), 32 "t::Future::Subclass", 33 '$f->followed_by' ); 34 35 isa_ok( $seq[@seq] = $f->transform(), 36 "t::Future::Subclass", 37 '$f->transform' ); 38 39 $_->cancel for @seq; 40} 41 42# immediate subclass->... 43{ 44 my $fdone = t::Future::Subclass->new->done; 45 my $ffail = t::Future::Subclass->new->fail( "Oop\n" ); 46 47 isa_ok( $fdone->then( sub { 1 } ), 48 "t::Future::Subclass", 49 'immediate $f->then' ); 50 51 isa_ok( $ffail->else( sub { 1 } ), 52 "t::Future::Subclass", 53 'immediate $f->else' ); 54 55 isa_ok( $fdone->then_with_f( sub {} ), 56 "t::Future::Subclass", 57 'immediate $f->then_with_f' ); 58 59 isa_ok( $ffail->else_with_f( sub {} ), 60 "t::Future::Subclass", 61 'immediate $f->else_with_f' ); 62 63 isa_ok( $fdone->followed_by( sub {} ), 64 "t::Future::Subclass", 65 '$f->followed_by' ); 66} 67 68# immediate->followed_by( sub { subclass } ) 69{ 70 my $f = t::Future::Subclass->new; 71 my $seq; 72 73 isa_ok( $seq = Future->done->followed_by( sub { $f } ), 74 "t::Future::Subclass", 75 'imm->followed_by $f' ); 76 77 $seq->cancel; 78} 79 80# convergents 81{ 82 my $f = t::Future::Subclass->new; 83 my @seq; 84 85 isa_ok( $seq[@seq] = Future->wait_all( $f ), 86 "t::Future::Subclass", 87 'Future->wait_all( $f )' ); 88 89 isa_ok( $seq[@seq] = Future->wait_any( $f ), 90 "t::Future::Subclass", 91 'Future->wait_any( $f )' ); 92 93 isa_ok( $seq[@seq] = Future->needs_all( $f ), 94 "t::Future::Subclass", 95 'Future->needs_all( $f )' ); 96 97 isa_ok( $seq[@seq] = Future->needs_any( $f ), 98 "t::Future::Subclass", 99 'Future->needs_any( $f )' ); 100 101 my $imm = Future->done; 102 103 isa_ok( $seq[@seq] = Future->wait_all( $imm, $f ), 104 "t::Future::Subclass", 105 'Future->wait_all( $imm, $f )' ); 106 107 # Pick the more derived subclass even if all are pending 108 109 isa_ok( $seq[@seq] = Future->wait_all( Future->new, $f ), 110 "t::Future::Subclass", 111 'Future->wait_all( Future->new, $f' ); 112 113 $_->cancel for @seq; 114} 115 116# empty convergents (RT97537) 117{ 118 my $f; 119 120 isa_ok( $f = t::Future::Subclass->wait_all(), 121 "t::Future::Subclass", 122 'subclass ->wait_all' ); 123 124 isa_ok( $f = t::Future::Subclass->wait_any(), 125 "t::Future::Subclass", 126 'subclass ->wait_any' ); 127 $f->failure; 128 129 isa_ok( $f = t::Future::Subclass->needs_all(), 130 "t::Future::Subclass", 131 'subclass ->needs_all' ); 132 133 isa_ok( $f = t::Future::Subclass->needs_any(), 134 "t::Future::Subclass", 135 'subclass ->needs_any' ); 136 $f->failure; 137} 138 139# ->get calls the correct await 140{ 141 my $f = t::Future::Subclass->new; 142 143 my $called; 144 no warnings 'once'; 145 local *t::Future::Subclass::await = sub { 146 $called++; 147 identical( $_[0], $f, '->await is called on $f' ); 148 $_[0]->done( "Result here" ); 149 }; 150 151 is_deeply( [ $f->get ], 152 [ "Result here" ], 153 'Result from ->get' ); 154 155 ok( $called, '$f->await called' ); 156} 157 158done_testing; 159 160package t::Future::Subclass; 161use base qw( Future ); 162