File: infinite_recursion.t

package info (click to toggle)
libpromise-xs-perl 0.20-1
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 908 kB
  • sloc: perl: 1,097; ansic: 355; makefile: 3
file content (60 lines) | stat: -rw-r--r-- 1,160 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
#!/usr/bin/env perl

use strict;
use warnings;

use Test::More;
use Test::Deep;
use Test::FailWarnings;

use Promise::XS;

plan skip_all => "Ancient perl: $^V" if $^V lt v5.10.0;

my @tests = (
    [ 'then', 'resolved' ],
    [ 'catch', 'rejected', 1 ],
    [ 'finally', 'resolved' ],
);

for my $t_ar (@tests) {
    my ($method, $factory, $throw_yn) = @$t_ar;

    my $promise_cr = sub { Promise::XS->can($factory)->(123) };

    sub foo {
        return $promise_cr->()->$method( sub {
            my $v = bar();
            die $v if $throw_yn;
            return $v;
        } );
    }

    sub bar {
        return $promise_cr->()->$method( sub {
            my $v = foo();
            die $v if $throw_yn;
            return $v;
        } );
    }

    my $err;
    my @warnings;

    my $rejected = do {
        local $SIG{'__WARN__'} = sub { push @warnings, @_ };
        foo()->catch( sub { $err = shift } );
    };

    cmp_deeply(
        \@warnings,
        array_each( re( qr<recurs>i ) ),
        "$method: only warnings are recursion warnings",
    );

    like( $err, qr<recurs>i, "$method: promise rejects as expected" );
}

done_testing;

1;