lib/Test/Simple/t/output.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 # Can't use Test.pm, that's a 5.005 thing.
  14 print "1..4\n";
  15
  16 my $test_num = 1;
  17 # Utility testing functions.
  18 sub ok ($;$) {
  19     my($test, $name) = @_;
  20     my $ok = '';
  21     $ok .= "not " unless $test;
  22     $ok .= "ok $test_num";
  23     $ok .= " - $name" if defined $name;
  24     $ok .= "\n";
  25     print $ok;
  26     $test_num++;
  27
  28     return $test;
  29 }
  30
  31 use TieOut;
  32 use Test::Builder;
  33 my $Test = Test::Builder->new();
  34
  35 my $result;
  36 my $out = $Test->output('foo');
  37
  38 ok( defined $out );
  39
  40 print $out "hi!\n";
  41 close *$out;
  42
  43 undef $out;
  44 open(IN, 'foo') or die $!;
  45 chomp(my $line = <IN>);
  46 close IN;
  47
  48 ok($line eq 'hi!');
  49
  50 open(FOO, ">>foo") or die $!;
  51 $out = $Test->output(\*FOO);
  52 $old = select *$out;
  53 print "Hello!\n";
  54 close *$out;
  55 undef $out;
  56 select $old;
  57 open(IN, 'foo') or die $!;
  58 my @lines = <IN>;
  59 close IN;
  60
  61 ok($lines[1] =~ /Hello!/);
  62
  63 unlink('foo');
  64
  65
  66 # Ensure stray newline in name escaping works.
  67 $out = tie *FAKEOUT, 'TieOut';
  68 $Test->output(\*FAKEOUT);
  69 $Test->exported_to(__PACKAGE__);
  70 $Test->no_ending(1);
  71 $Test->plan(tests => 5);
  72
  73 $Test->ok(1, "ok");
  74 $Test->ok(1, "ok\n");
  75 $Test->ok(1, "ok, like\nok");
  76 $Test->skip("wibble\nmoof");
  77 $Test->todo_skip("todo\nskip\n");
  78
  79 my $output = $out->read;
  80 ok( $output eq <<OUTPUT ) || print STDERR $output;
  81 1..5
  82 ok 1 - ok
  83 ok 2 - ok
  84 #
  85 ok 3 - ok, like
  86 # ok
  87 ok 4 # skip wibble
  88 # moof
  89 not ok 5 # TODO & SKIP todo
  90 # skip
  91 #
  92 OUTPUT