1#!/usr/bin/perl 2 3use v5.10; 4use strict; 5use warnings; 6 7use Test::More; 8use Test::Refcount; 9use Test::Builder::Tester; 10 11use Future; 12use Test::Future; 13 14# pass 15{ 16 test_out( "ok 1 - immediate Future" ); 17 18 my $ran_code; 19 no_pending_futures { 20 $ran_code++; 21 Future->done(1,2,3); 22 } 'immediate Future'; 23 24 test_test( "immediate Future passes" ); 25 ok( $ran_code, 'actually ran the code' ); 26} 27 28# fail 29{ 30 test_out( "not ok 1 - pending Future" ); 31 test_fail( +8 ); 32 test_err( "# The following Futures are still pending:" ); 33 test_err( qr/^# 0x[0-9a-f]+\n/ ); 34 test_err( qr/^# Writing heap dump to \S+\n/ ) if Test::Future::HAVE_DEVEL_MAT_DUMPER; 35 36 my $f; 37 no_pending_futures { 38 $f = Future->new; 39 } 'pending Future'; 40 41 test_test( "pending Future fails" ); 42 43 $f->cancel; 44} 45 46# does not retain Futures 47{ 48 test_out( "ok 1 - refcount 2 before drop" ); 49 test_out( "ok 2 - refcount 1 after drop" ); 50 test_out( "ok 3 - retain" ); 51 52 no_pending_futures { 53 my $arr = [1,2,3]; 54 my $f = Future->new; 55 $f->done( $arr ); 56 is_refcount( $arr, 2, 'refcount 2 before drop' ); 57 undef $f; 58 is_refcount( $arr, 1, 'refcount 1 after drop' ); 59 } 'retain'; 60 61 test_test( "no_pending_futures does not retain completed Futures" ); 62} 63 64# does not retain immedate Futures 65{ 66 test_out( "ok 1 - refcount 2 before drop" ); 67 test_out( "ok 2 - refcount 1 after drop" ); 68 test_out( "ok 3 - retain" ); 69 70 no_pending_futures { 71 my $arr = [1,2,3]; 72 my $f = Future->done( $arr ); 73 is_refcount( $arr, 2, 'refcount 2 before drop' ); 74 undef $f; 75 is_refcount( $arr, 1, 'refcount 1 after drop' ); 76 } 'retain'; 77 78 test_test( "no_pending_futures does not retain immediate Futures" ); 79} 80 81END { 82 # Clean up Devel::MAT dumpfile 83 my $pmat = $0; 84 $pmat =~ s/\.t$/-1.pmat/; 85 unlink $pmat if -f $pmat; 86} 87 88done_testing; 89