1#!/usr/bin/perl -w
2
3# Test the use of subtest() to define new test predicates that combine
4# multiple existing predicates.
5
6BEGIN {
7    if( $ENV{PERL_CORE} ) {
8        chdir 't';
9        @INC = ( '../lib', 'lib' );
10    }
11    else {
12        unshift @INC, 't/lib';
13    }
14}
15
16use strict;
17use warnings;
18
19use Test::More tests => 5;
20use Test::Builder;
21use Test::Builder::Tester;
22
23# Formatting may change if we're running under Test::Harness.
24$ENV{HARNESS_ACTIVE} = 0;
25
26our %line;
27
28# Define a new test predicate with Test::More::subtest(), using
29# Test::More predicates as building blocks...
30
31sub foobar_ok ($;$) {
32    my ($value, $name) = @_;
33    $name ||= "foobar_ok";
34
35    local $Test::Builder::Level = $Test::Builder::Level + 1;
36    subtest $name => sub {
37        plan tests => 2;
38        ok $value =~ /foo/, "foo";
39        ok $value =~ /bar/, "bar"; BEGIN{ $line{foobar_ok_bar} = __LINE__ }
40    };
41}
42{
43    test_out("# Subtest: namehere");
44    test_out("    1..2");
45    test_out("    ok 1 - foo");
46    test_out("    not ok 2 - bar");
47    test_err("    #   Failed test 'bar'");
48    test_err("    #   at $0 line $line{foobar_ok_bar}.");
49    test_err("    # Looks like you failed 1 test of 2.");
50    test_out("not ok 1 - namehere");
51    test_err("#   Failed test 'namehere'");
52    test_err("#   at $0 line ".(__LINE__+2).".");
53
54    foobar_ok "foot", "namehere";
55
56    test_test("foobar_ok failing line numbers");
57}
58
59# Wrap foobar_ok() to make another new predicate...
60
61sub foobar_ok_2 ($;$) {
62    my ($value, $name) = @_;
63
64    local $Test::Builder::Level = $Test::Builder::Level + 1;
65    foobar_ok($value, $name);
66}
67{
68    test_out("# Subtest: namehere");
69    test_out("    1..2");
70    test_out("    ok 1 - foo");
71    test_out("    not ok 2 - bar");
72    test_err("    #   Failed test 'bar'");
73    test_err("    #   at $0 line $line{foobar_ok_bar}.");
74    test_err("    # Looks like you failed 1 test of 2.");
75    test_out("not ok 1 - namehere");
76    test_err("#   Failed test 'namehere'");
77    test_err("#   at $0 line ".(__LINE__+2).".");
78
79    foobar_ok_2 "foot", "namehere";
80
81    test_test("foobar_ok_2 failing line numbers");
82}
83
84# Define another new test predicate, this time using
85# Test::Builder::subtest() rather than Test::More::subtest()...
86
87sub barfoo_ok ($;$) {
88    my ($value, $name) = @_;
89    $name ||= "barfoo_ok";
90
91    Test::Builder->new->subtest($name => sub {
92        plan tests => 2;
93        ok $value =~ /foo/, "foo";
94        ok $value =~ /bar/, "bar"; BEGIN{ $line{barfoo_ok_bar} = __LINE__ }
95    });
96}
97{
98    test_out("# Subtest: namehere");
99    test_out("    1..2");
100    test_out("    ok 1 - foo");
101    test_out("    not ok 2 - bar");
102    test_err("    #   Failed test 'bar'");
103    test_err("    #   at $0 line $line{barfoo_ok_bar}.");
104    test_err("    # Looks like you failed 1 test of 2.");
105    test_out("not ok 1 - namehere");
106    test_err("#   Failed test 'namehere'");
107    test_err("#   at $0 line ".(__LINE__+2).".");
108
109    barfoo_ok "foot", "namehere";
110
111    test_test("barfoo_ok failing line numbers");
112}
113
114# Wrap barfoo_ok() to make another new predicate...
115
116sub barfoo_ok_2 ($;$) {
117    my ($value, $name) = @_;
118
119    local $Test::Builder::Level = $Test::Builder::Level + 1;
120    barfoo_ok($value, $name);
121}
122{
123    test_out("# Subtest: namehere");
124    test_out("    1..2");
125    test_out("    ok 1 - foo");
126    test_out("    not ok 2 - bar");
127    test_err("    #   Failed test 'bar'");
128    test_err("    #   at $0 line $line{barfoo_ok_bar}.");
129    test_err("    # Looks like you failed 1 test of 2.");
130    test_out("not ok 1 - namehere");
131    test_err("#   Failed test 'namehere'");
132    test_err("#   at $0 line ".(__LINE__+2).".");
133
134    barfoo_ok_2 "foot", "namehere";
135
136    test_test("barfoo_ok_2 failing line numbers");
137}
138
139# A subtest-based predicate called from within a subtest
140{
141    test_out("# Subtest: outergroup");
142    test_out("    1..2");
143    test_out("    ok 1 - this passes");
144    test_out("    # Subtest: namehere");
145    test_out("        1..2");
146    test_out("        ok 1 - foo");
147    test_out("        not ok 2 - bar");
148    test_err("        #   Failed test 'bar'");
149    test_err("        #   at $0 line $line{barfoo_ok_bar}.");
150    test_err("        # Looks like you failed 1 test of 2.");
151    test_out("    not ok 2 - namehere");
152    test_err("    #   Failed test 'namehere'");
153    test_err("    #   at $0 line $line{ipredcall}.");
154    test_err("    # Looks like you failed 1 test of 2.");
155    test_out("not ok 1 - outergroup");
156    test_err("#   Failed test 'outergroup'");
157    test_err("#   at $0 line $line{outercall}.");
158
159    subtest outergroup => sub {
160        plan tests => 2;
161        ok 1, "this passes";
162        barfoo_ok_2 "foot", "namehere"; BEGIN{ $line{ipredcall} = __LINE__ }
163    }; BEGIN{ $line{outercall} = __LINE__ }
164
165    test_test("outergroup with internal barfoo_ok_2 failing line numbers");
166}
167