xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Simple/t/Legacy/diag.t (revision 5759b3d249badf144a6240f7eec4dcf9df003e6b)
1*5759b3d2Safresh1#!perl -w
2*5759b3d2Safresh1use strict;
3*5759b3d2Safresh1
4*5759b3d2Safresh1use Test2::Util qw/CAN_THREAD/;
5*5759b3d2Safresh1
6*5759b3d2Safresh1# Turn on threads here, if available, since this test tends to find
7*5759b3d2Safresh1# lots of threading bugs.
8*5759b3d2Safresh1BEGIN {
9*5759b3d2Safresh1    if (CAN_THREAD) {
10*5759b3d2Safresh1        require threads;
11*5759b3d2Safresh1        threads->import;
12*5759b3d2Safresh1    }
13*5759b3d2Safresh1}
14*5759b3d2Safresh1
15*5759b3d2Safresh1BEGIN {
16*5759b3d2Safresh1    if( $ENV{PERL_CORE} ) {
17*5759b3d2Safresh1        chdir 't';
18*5759b3d2Safresh1        @INC = ('../lib', 'lib');
19*5759b3d2Safresh1    }
20*5759b3d2Safresh1    else {
21*5759b3d2Safresh1        unshift @INC, 't/lib';
22*5759b3d2Safresh1    }
23*5759b3d2Safresh1}
24*5759b3d2Safresh1
25*5759b3d2Safresh1use Test::Builder::NoOutput;
26*5759b3d2Safresh1use Test::More tests => 7;
27*5759b3d2Safresh1
28*5759b3d2Safresh1my $test = Test::Builder::NoOutput->create;
29*5759b3d2Safresh1
30*5759b3d2Safresh1# Test diag() goes to todo_output() in a todo test.
31*5759b3d2Safresh1{
32*5759b3d2Safresh1    $test->todo_start();
33*5759b3d2Safresh1
34*5759b3d2Safresh1    $test->diag("a single line");
35*5759b3d2Safresh1    is( $test->read('todo'), <<'DIAG',   'diag() with todo_output set' );
36*5759b3d2Safresh1# a single line
37*5759b3d2Safresh1DIAG
38*5759b3d2Safresh1
39*5759b3d2Safresh1    my $ret = $test->diag("multiple\n", "lines");
40*5759b3d2Safresh1    is( $test->read('todo'), <<'DIAG',   '  multi line' );
41*5759b3d2Safresh1# multiple
42*5759b3d2Safresh1# lines
43*5759b3d2Safresh1DIAG
44*5759b3d2Safresh1    ok( !$ret, 'diag returns false' );
45*5759b3d2Safresh1
46*5759b3d2Safresh1    $test->todo_end();
47*5759b3d2Safresh1}
48*5759b3d2Safresh1
49*5759b3d2Safresh1
50*5759b3d2Safresh1# Test diagnostic formatting
51*5759b3d2Safresh1{
52*5759b3d2Safresh1    $test->diag("# foo");
53*5759b3d2Safresh1    is( $test->read('err'), "# # foo\n", "diag() adds # even if there's one already" );
54*5759b3d2Safresh1
55*5759b3d2Safresh1    $test->diag("foo\n\nbar");
56*5759b3d2Safresh1    is( $test->read('err'), <<'DIAG', "  blank lines get escaped" );
57*5759b3d2Safresh1# foo
58*5759b3d2Safresh1#
59*5759b3d2Safresh1# bar
60*5759b3d2Safresh1DIAG
61*5759b3d2Safresh1
62*5759b3d2Safresh1    $test->diag("foo\n\nbar\n\n");
63*5759b3d2Safresh1    is( $test->read('err'), <<'DIAG', "  even at the end" );
64*5759b3d2Safresh1# foo
65*5759b3d2Safresh1#
66*5759b3d2Safresh1# bar
67*5759b3d2Safresh1#
68*5759b3d2Safresh1DIAG
69*5759b3d2Safresh1}
70*5759b3d2Safresh1
71*5759b3d2Safresh1
72*5759b3d2Safresh1# [rt.cpan.org 8392] diag(@list) emulates print
73*5759b3d2Safresh1{
74*5759b3d2Safresh1    $test->diag(qw(one two));
75*5759b3d2Safresh1
76*5759b3d2Safresh1    is( $test->read('err'), <<'DIAG' );
77*5759b3d2Safresh1# onetwo
78*5759b3d2Safresh1DIAG
79*5759b3d2Safresh1}
80