lib/Test/Simple/t/tbt_07args.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 => 18;
  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 $testing_num;
  39 my $original_harness_env;
  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 ####################################################################
 128 # Actual meta tests
 129 ####################################################################
 130
 131 # set up the outer wrapper again
 132 start_testing();
 133 $out->expect("ok 1 - bar");
 134
 135 # set up what the inner wrapper expects
 136 test_out("ok 1 - foo");
 137
 138 # the actual test function that we are testing
 139 ok("1","foo");
 140
 141 # test the name
 142 test_test(name => "bar");
 143
 144 # check that passed
 145 my_test_test("meta test name");
 146
 147 ####################################################################
 148
 149 # set up the outer wrapper again
 150 start_testing();
 151 $out->expect("ok 1 - bar");
 152
 153 # set up what the inner wrapper expects
 154 test_out("ok 1 - foo");
 155
 156 # the actual test function that we are testing
 157 ok("1","foo");
 158
 159 # test the name
 160 test_test(title => "bar");
 161
 162 # check that passed
 163 my_test_test("meta test title");
 164
 165 ####################################################################
 166
 167 # set up the outer wrapper again
 168 start_testing();
 169 $out->expect("ok 1 - bar");
 170
 171 # set up what the inner wrapper expects
 172 test_out("ok 1 - foo");
 173
 174 # the actual test function that we are testing
 175 ok("1","foo");
 176
 177 # test the name
 178 test_test(label => "bar");
 179
 180 # check that passed
 181 my_test_test("meta test title");
 182
 183 ####################################################################
 184
 185 # set up the outer wrapper again
 186 start_testing();
 187 $out->expect("ok 1 - bar");
 188
 189 # set up what the inner wrapper expects
 190 test_out("not ok 1 - foo this is wrong");
 191 test_fail(+3);
 192
 193 # the actual test function that we are testing
 194 ok("0","foo");
 195
 196 # test that we got what we expect, ignoring our is wrong
 197 test_test(skip_out => 1, name => "bar");
 198
 199 # check that that passed
 200 my_test_test("meta test skip_out");
 201
 202 ####################################################################
 203
 204 # set up the outer wrapper again
 205 start_testing();
 206 $out->expect("ok 1 - bar");
 207
 208 # set up what the inner wrapper expects
 209 test_out("not ok 1 - foo");
 210 test_err("this is wrong");
 211
 212 # the actual test function that we are testing
 213 ok("0","foo");
 214
 215 # test that we got what we expect, ignoring err is wrong
 216 test_test(skip_err => 1, name => "bar");
 217
 218 # diagnostics failing out
 219 # check that that passed
 220 my_test_test("meta test skip_err");
 221
 222 ####################################################################