1#!/usr/bin/perl 2 3use v5.10; 4use strict; 5use warnings; 6 7use Test::More; 8 9BEGIN { 10 $ENV{PERL_FUTURE_DEBUG} = 1; 11} 12 13use Future; 14 15use Time::HiRes qw( gettimeofday tv_interval ); 16 17my $LINE; 18my $LOSTLINE; 19 20sub warnings(&) 21{ 22 my $code = shift; 23 my $warnings = ""; 24 local $SIG{__WARN__} = sub { $warnings .= shift }; 25 $code->(); 26 $LOSTLINE = __LINE__; return $warnings; 27} 28 29is( warnings { 30 my $f = Future->new; 31 $f->done; 32 }, "", 'Completed Future does not give warning' ); 33 34is( warnings { 35 my $f = Future->new; 36 $f->cancel; 37 }, "", 'Cancelled Future does not give warning' ); 38 39like( warnings { 40 $LINE = __LINE__; my $f = Future->new; 41 undef $f; 42 }, 43 qr/^Future=\S+ was constructed at \Q$0\E line $LINE and was lost near \Q$0\E line (?:$LOSTLINE|${\($LINE+1)}) before it was ready\.?$/, 44 'Lost Future raises a warning' ); 45 46my $THENLINE; 47my $SEQLINE; 48like( warnings { 49 $LINE = __LINE__; my $f1 = Future->new; 50 $THENLINE = __LINE__; my $fseq = $f1->then( sub { } ); undef $fseq; 51 $SEQLINE = __LINE__; $f1->done; 52 }, 53 qr/^Future=\S+ was constructed at \Q$0\E line $THENLINE and was lost near \Q$0\E line (?:$SEQLINE|$THENLINE) before it was ready\.? 54Future=\S+ \(constructed at \Q$0\E line $LINE\) lost a sequence Future at \Q$0\E line $SEQLINE\.?$/, 55 'Lost sequence Future raises warning' ); 56 57like( warnings { 58 $LINE = __LINE__; my $f = Future->fail("Failed!"); 59 undef $f; 60 }, 61 qr/^Future=\S+ was constructed at \Q$0\E line $LINE and was lost near \Q$0\E line (?:$LOSTLINE|${\($LINE+1)}) with an unreported failure of: Failed!\.?/, 62 'Destroyed failed future raises warning' ); 63 64{ 65 local $Future::TIMES = 1; 66 67 my $before = [ gettimeofday ]; 68 69 my $future = Future->new; 70 71 ok( defined $future->btime, '$future has btime with $TIMES=1' ); 72 ok( tv_interval( $before, $future->btime ) >= 0, '$future btime is not earlier than $before' ); 73 74 $future->done; 75 76 ok( defined $future->rtime, '$future has rtime with $TIMES=1' ); 77 ok( tv_interval( $future->btime, $future->rtime ) >= 0, '$future rtime is not earlier than btime' ); 78 ok( tv_interval( $future->rtime ) >= 0, '$future rtime is not later than now' ); 79 80 ok( defined $future->elapsed, '$future has ->elapsed time' ); 81 ok( $future->elapsed >= 0, '$future elapsed time >= 0' ); 82} 83 84done_testing; 85