lib/Test/Simple/t/diag.t

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