1use strict;
2use warnings;
3
4use Test2::Tools::Tiny;
5
6use Test2::API qw/run_subtest intercept context/;
7
8# Test a subtest that should inherit the trace from the tool that calls it
9my ($file, $line) = (__FILE__, __LINE__ + 1);
10my $events = intercept { my_tool_inherit() };
11
12is(@$events, 1, "got 1 event");
13my $e = shift @$events;
14ok($e->isa('Test2::Event::Subtest'), "got a subtest event");
15is($e->trace->file, $file, "subtest is at correct file");
16is($e->trace->line, $line, "subtest is at correct line");
17my $plan = pop @{$e->subevents};
18ok($plan->isa('Test2::Event::Plan'), "Removed plan");
19for my $se (@{$e->subevents}) {
20    is($se->trace->file, $file, "subtest event is at correct file");
21    is($se->trace->line, $line, "subtest event is at correct line");
22    ok($se->facets->{assert}->pass, "subtest event passed");
23}
24
25
26
27
28# Test a subtest that should NOT inherit the trace from the tool that calls it
29($file, $line) = (__FILE__, __LINE__ + 1);
30$events = intercept { my_tool_no_inherit() };
31
32is(@$events, 1, "got 1 event");
33$e = shift @$events;
34ok($e->isa('Test2::Event::Subtest'), "got a subtest event");
35is($e->trace->file, $file, "subtest is at correct file");
36is($e->trace->line, $line, "subtest is at correct line");
37$plan = pop @{$e->subevents};
38ok($plan->isa('Test2::Event::Plan'), "Removed plan");
39for my $se (@{$e->subevents}) {
40    ok($se->trace->file ne $file, "subtest event is not in our file");
41    ok($se->trace->line ne $line, "subtest event is not on our line");
42    ok($se->facets->{assert}->{pass}, "subtest event passed");
43}
44
45done_testing;
46
47# Make these tools appear to be in a different file/line
48#line 100 'fake.pm'
49
50sub my_tool_inherit {
51    my $ctx = context();
52
53    run_subtest(
54        'foo',
55        sub {
56            ok(1, 'a');
57            ok(2, 'b');
58            is_deeply(\@_, [qw/arg1 arg2/], "got args");
59        },
60        {buffered => 1, inherit_trace => 1},
61        'arg1', 'arg2'
62    );
63
64    $ctx->release;
65}
66
67sub my_tool_no_inherit {
68    my $ctx = context();
69
70    run_subtest(
71        'foo',
72        sub {
73            ok(1, 'a');
74            ok(2, 'b');
75            is_deeply(\@_, [qw/arg1 arg2/], "got args");
76        },
77        {buffered => 1, inherit_trace => 0},
78        'arg1', 'arg2'
79    );
80
81    $ctx->release;
82}
83
84
85