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