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