#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Identity; use Future; use Future::Utils qw( repeat try_repeat try_repeat_until_success ); { my $trial_f; my $previous_trial; my $arg; my $again; my $future = repeat { $previous_trial = shift; return $trial_f = Future->new } while => sub { $arg = shift; $again }; ok( defined $future, '$future defined for repeat while' ); ok( defined $trial_f, 'An initial future is running' ); my $first_f = $trial_f; $again = 1; $trial_f->done( "one" ); ok( defined $arg, '$arg defined for while test' ); is( scalar $arg->get, "one", '$arg->get for first' ); identical( $previous_trial, $first_f, 'code block is passed previous trial' ); $again = 0; $trial_f->done( "two" ); ok( $future->is_ready, '$future is now ready after second attempt ->done' ); is( scalar $future->get, "two", '$future->get' ); } # return keyword { my $trial_f; my $future = repeat { return $trial_f = Future->new } while => sub { 1 }, return => my $ret = Future->new; identical( $future, $ret, 'repeat with return yields correct instance' ); } # cancellation { my @running; my $i = 0; my $future = repeat { return $running[$i++] = Future->new } while => sub { 1 }; ok( defined $future, '$future defined for repeat while' ); ok( defined $running[0], 'An initial future is running' ); $running[0]->done; $future->cancel; ok( !$running[0]->is_cancelled, 'previously running future not cancelled' ); ok( $running[1]->is_cancelled, 'running future cancelled after eventual is cancelled' ); ok( !$running[2], 'a third trial is not started' ); } # until { my $trial_f; my $arg; my $accept; my $future = repeat { return $trial_f = Future->new } until => sub { $arg = shift; $accept }; ok( defined $future, '$future defined for repeat until' ); ok( defined $trial_f, 'An initial future is running' ); $accept = 0; $trial_f->done( "three" ); ok( defined $arg, '$arg defined for while test' ); is( scalar $arg->get, "three", '$arg->get for first' ); $accept = 1; $trial_f->done( "four" ); ok( $future->is_ready, '$future is now ready after second attempt ->done' ); is( scalar $future->get, "four", '$future->get' ); } # body code dies { my $future; $future = repeat { die "It failed\n"; } while => sub { !shift->failure }; is( $future->failure, "It failed\n", 'repeat while failure after code exception' ); $future = repeat { die "It failed\n"; } until => sub { shift->failure }; is( $future->failure, "It failed\n", 'repeat until failure after code exception' ); } # condition code dies (RT100067) { my $future = repeat { Future->done(1); } while => sub { die "it dies!\n" }; is( $future->failure, "it dies!\n", 'repeat while failure after condition exception' ); } # Non-Future return fails { my $future; $future = repeat { "non-Future" } while => sub { !shift->failure }; like( $future->failure, qr/^Expected __ANON__.*\(\S+ line \d+\) to return a Future$/, 'repeat failure for non-Future return' ); } # try_repeat catches failures { my $attempt = 0; my $future = try_repeat { if( ++$attempt < 3 ) { return FUture->new->fail( "Too low" ); } else { return Future->done( $attempt ); } } while => sub { shift->failure }; ok( $future->is_ready, '$future is now ready for try_repeat' ); is( scalar $future->get, 3, '$future->get' ); } { my $attempt = 0; my $future = try_repeat_until_success { if( ++$attempt < 3 ) { return Future->fail( "Too low" ); } else { return Future->done( $attempt ); } }; ok( $future->is_ready, '$future is now ready for try_repeat_until_success' ); is( scalar $future->get, 3, '$future->get' ); } # repeat prints a warning if asked to retry a failure { my $warnings = ""; local $SIG{__WARN__} = sub { $warnings .= join "", @_ }; my $attempt = 0; my $future = repeat { if( ++$attempt < 3 ) { return Future->fail( "try again" ); } else { return Future->done( "OK" ); } } while => sub { $_[0]->failure }; ok( $future->is_ready, '$future is now ready after repeat retries failures' ); like( $warnings, qr/(?:^Using Future::Utils::repeat to retry a failure is deprecated; use try_repeat instead at \Q$0\E line \d+\.?$)+/m, 'Warnings printing by repeat retries failures' ); } done_testing;