File: abort.t

package info (click to toggle)
libtest-routine-perl 0.031-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 296 kB
  • sloc: perl: 705; makefile: 2
file content (110 lines) | stat: -rw-r--r-- 2,630 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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
use strict;
use warnings;

use Test2::API qw(intercept);
use Test::More;
use Test::Routine::Util;

{
  package Abort::Test;
  sub throw {
    my $self = bless $_[1], $_[0];
    die $self;
  }

  sub as_test_abort_events {
    my @diag = @{ $_[0]{diagnostics} || [] };
    return [
      [ Ok => (pass => $_[0]{pass} || 0, name => $_[0]{description}) ],
      map {; [ Diag => (message => $_) ] } @diag,
    ];
  }
}

{
  package Abortive;
  use Test::Routine;

  use Test::More;

  use namespace::autoclean;

  test "this test will abort" => sub {
    my ($self) = @_;

    pass("one");
    pass("two");

    Abort::Test->throw({
      description => "just give up",
    });

    pass("three");
    pass("four");
    pass("five");
  };

  test "this will run just fine" => sub {
    pass("everything is just fine");
  };

  test "I like fine wines and cheeses" => sub {
    pass("wine wine wine wine cheese");

    Abort::Test->throw({
      pass => 1,
      description => "that was enough wine and cheese",
      diagnostics => [ "Fine wine", "Fine cheese" ],
    });

    fail("feeling gross");
  };
}

my $events = intercept {
  run_tests("test run with aborts", 'Abortive');
};

my @top = grep {; $_->isa('Test2::Event::Subtest') } @$events;
is(@top, 1, "we have only the one top-level subtest for Routine");

my @subtests = grep {; $_->isa('Test2::Event::Subtest') }
               @{ $top[0]->subevents };

is(@subtests, 3, "we ran three subtests (the three test methods)");

subtest "first subtest" => sub {
  my @oks = grep {; $_->isa('Test2::Event::Ok') } @{ $subtests[0]->subevents };
  is(@oks, 3, "three pass/fail events");
  ok($oks[0]->pass, "first passed");
  ok($oks[1]->pass, "second passed");
  ok(! $oks[2]->pass, "third failed");
  is($oks[2]->name, "just give up", "the final Ok test looks like our abort");
  isa_ok($oks[2]->get_meta('test_abort_object'), 'Abort::Test', 'test_abort_object');
};

subtest "third subtest" => sub {
  my @oks = grep {; $_->isa('Test2::Event::Ok') } @{ $subtests[2]->subevents };
  is(@oks, 2, "two pass/fail events");
  ok($oks[0]->pass, "first passed");
  ok($oks[1]->pass, "second passed");
  is(
    $oks[1]->name,
    "that was enough wine and cheese",
    "the final Ok test looks like our abort"
  );
  isa_ok($oks[1]->get_meta('test_abort_object'), 'Abort::Test', 'test_abort_object');

  my @diags = grep {; $_->isa('Test2::Event::Diag') } @{ $subtests[2]->subevents };
  is(@diags, 2, "we have two diagnostics");
  is_deeply(
    [ map {; $_->message } @diags ],
    [
      "Fine wine",
      "Fine cheese",
    ],
    "...which we expected",
  );
};

done_testing;