lib/Test/Simple/t/diag.t

   1 #!perl -w
   2
   3 BEGIN {
   4     if( $ENV{PERL_CORE} ) {
   5         chdir 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10
  11 # Turn on threads here, if available, since this test tends to find
  12 # lots of threading bugs.
  13 use Config;
  14 BEGIN {
  15     if( $] >= 5.008 && $Config{useithreads} ) {
  16         require threads;
  17         'threads'->import;
  18     }
  19 }
  20
  21
  22 use strict;
  23
  24 use Test::More tests => 7;
  25
  26 my $Test = Test::More->builder;
  27
  28 # now make a filehandle where we can send data
  29 my $output;
  30 tie *FAKEOUT, 'FakeOut', \$output;
  31
  32 # force diagnostic output to a filehandle, glad I added this to
  33 # Test::Builder :)
  34 my @lines;
  35 my $ret;
  36 {
  37     local $TODO = 1;
  38     $Test->todo_output(\*FAKEOUT);
  39
  40     diag("a single line");
  41
  42     push @lines, $output;
  43     $output = '';
  44
  45     $ret = diag("multiple\n", "lines");
  46     push @lines, split(/\n/, $output);
  47 }
  48
  49 is( @lines, 3,              'diag() should send messages to its filehandle' );
  50 like( $lines[0], '/^#\s+/', '    should add comment mark to all lines' );
  51 is( $lines[0], "# a single line\n",   '    should send exact message' );
  52 is( $output, "# multiple\n# lines\n", '    should append multi messages');
  53 ok( !$ret, 'diag returns false' );
  54
  55 {
  56     $Test->failure_output(\*FAKEOUT);
  57     $output = '';
  58     $ret = diag("# foo");
  59 }
  60 $Test->failure_output(\*STDERR);
  61 is( $output, "# # foo\n",   "diag() adds a # even if there's one already" );
  62 ok( !$ret,  'diag returns false' );
  63
  64 package FakeOut;
  65
  66 sub TIEHANDLE {
  67         bless( $_[1], $_[0] );
  68 }
  69
  70 sub PRINT {
  71         my $self = shift;
  72         $$self .= join('', @_);
  73 }