git.maemo.org Git - dh-make-perl/blob - dev/arm/libtest-simple-perl/libtest-simple-perl-0.80/t/tbt_06errormess.t

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