lib/Test/Simple/t/tbt_06errormess.t

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4     if( $ENV{PERL_CORE} ) {
   5         chdir 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 use Test::More tests => 8;
  11 use Symbol;
  12 use Test::Builder;
  13 use Test::Builder::Tester;
  14
  15 use strict;
  16
  17 # argh! now we need to test the thing we're testing.  Basically we need
  18 # to pretty much reimplement the whole code again.  This is very
  19 # annoying but can't be avoided.  And onwards with the cut and paste
  20
  21 # My brain is melting.  My brain is melting.  ETOOMANYLAYERSOFTESTING
  22
  23 # create some private file handles
  24 my $output_handle = gensym;
  25 my $error_handle  = gensym;
  26
  27 # and tie them to this package
  28 my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT";
  29 my $err = tie *$error_handle,  "Test::Tester::Tie", "STDERR";
  30
  31 # ooooh, use the test suite
  32 my $t = Test::Builder->new;
  33
  34 # remember the testing outputs
  35 my $original_output_handle;
  36 my $original_failure_handle;
  37 my $original_todo_handle;
  38 my $original_harness_env;
  39 my $testing_num;
  40
  41 sub start_testing
  42 {
  43     # remember what the handles were set to
  44     $original_output_handle  = $t->output();
  45     $original_failure_handle = $t->failure_output();
  46     $original_todo_handle    = $t->todo_output();
  47     $original_harness_env    = $ENV{HARNESS_ACTIVE};
  48
  49     # switch out to our own handles
  50     $t->output($output_handle);
  51     $t->failure_output($error_handle);
  52     $t->todo_output($error_handle);
  53
  54     $ENV{HARNESS_ACTIVE} = 0;
  55
  56     # clear the expected list
  57     $out->reset();
  58     $err->reset();
  59
  60     # remeber that we're testing
  61     $testing_num = $t->current_test;
  62     $t->current_test(0);
  63 }
  64
  65 # each test test is actually two tests.  This is bad and wrong
  66 # but makes blood come out of my ears if I don't at least simplify
  67 # it a little this way
  68
  69 sub my_test_test
  70 {
  71   my $text = shift;
  72   local $^W = 0;
  73
  74   # reset the outputs
  75   $t->output($original_output_handle);
  76   $t->failure_output($original_failure_handle);
  77   $t->todo_output($original_todo_handle);
  78   $ENV{HARNESS_ACTIVE} = $original_harness_env;
  79
  80   # reset the number of tests
  81   $t->current_test($testing_num);
  82
  83   # check we got the same values
  84   my $got;
  85   my $wanted;
  86
  87   # stdout
  88   $t->ok($out->check, "STDOUT $text");
  89
  90   # stderr
  91   $t->ok($err->check, "STDERR $text");
  92 }
  93
  94 ####################################################################
  95 # Meta meta tests
  96 ####################################################################
  97
  98 # this is a quick test to check the hack that I've just implemented
  99 # actually does a cut down version of Test::Builder::Tester
 100
 101 start_testing();
 102 $out->expect("ok 1 - foo");
 103 pass("foo");
 104 my_test_test("basic meta meta test");
 105
 106 start_testing();
 107 $out->expect("not ok 1 - foo");
 108 $err->expect("#     Failed test ($0 at line ".line_num(+1).")");
 109 fail("foo");
 110 my_test_test("basic meta meta test 2");
 111
 112 start_testing();
 113 $out->expect("ok 1 - bar");
 114 test_out("ok 1 - foo");
 115 pass("foo");
 116 test_test("bar");
 117 my_test_test("meta meta test with tbt");
 118
 119 start_testing();
 120 $out->expect("ok 1 - bar");
 121 test_out("not ok 1 - foo");
 122 test_err("#     Failed test ($0 at line ".line_num(+1).")");
 123 fail("foo");
 124 test_test("bar");
 125 my_test_test("meta meta test with tbt2 ");
 126
 127 ####################################################################