vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libtest-warn-perl/libtest-warn-perl-0.11/t/warning_is.t

   1 #!/usr/bin/perl
   2
   3 BEGIN {
   4         chdir 't' if -d 't';
   5         unshift @INC, '../blib/lib';
   6 }
   7
   8 use strict;
   9 use warnings;
  10
  11 use Carp;
  12
  13 use constant SUBTESTS_PER_TESTS  => 6;
  14
  15 use constant TESTS =>(
  16     ["ok", "my warning", "my warning", "standard warning to find"],
  17     ["not ok", "my warning", "another warning", "another warning instead of my warning"],
  18     ["not ok", "warning general not", "warning general", "quite only a sub warning"],
  19     ["not ok", undef, "a warning", "no warning, but expected one"],
  20     ["not ok", "a warning", undef, "warning, but didn't expect one"],
  21     ["ok", undef, undef, "no warning"],
  22     ["ok", '$!"%&/()=', '$!"%&/()=', "warning with crazy letters"],
  23     ["not ok", "warning 1|warning 2", "warning1", "more than one warning"]
  24 );
  25
  26 use Test::Builder::Tester tests  => TESTS() * SUBTESTS_PER_TESTS;
  27 use Test::Warn;
  28 use Test::Exception;
  29
  30 Test::Builder::Tester::color 'on';
  31
  32 use constant WARN_LINE => line_num +2;
  33 sub _make_warn {
  34     warn $_ for grep $_, split m:\|:, (shift() || "");
  35 }
  36
  37 use constant CARP_LINE => line_num +2;
  38 sub _make_carp {
  39     carp $_ for grep $_, split m:\|:, (shift() || "");
  40 }
  41
  42 use constant CARP_LEVELS => (0 .. 2);
  43 sub _create_exp_warning {
  44     my ($carplevel, $warning) = @_;
  45     return $warning               if $carplevel == 0;
  46     return {carped => $warning}   if $carplevel == 1;
  47     return {carped => [$warning]} if $carplevel == 2;
  48 }
  49
  50 test_warning_is(@$_) foreach  TESTS();
  51
  52 sub test_warning_is {
  53     my ($ok, $msg, $exp_warning, $testname) = @_;
  54     for my $carp (CARP_LEVELS) {
  55         *_found_msg         = $carp ? *_found_carp_msg : *_found_warn_msg;
  56         *_exp_msg           = $carp ? *_exp_carp_msg   : *_exp_warn_msg;
  57         *_make_warn_or_carp = $carp ? *_make_carp      : *_make_warn;
  58         for my $t (undef, $testname) {
  59             test_out "$ok 1" . ($t ? " - $t" : "");
  60             if ($ok =~ /not/) {
  61                 test_fail +4;
  62                 test_diag  _found_msg($_) for ($msg ? (split m-\|-, $msg) : $msg);
  63                 test_diag  _exp_msg($exp_warning);
  64             }
  65             warning_is {_make_warn_or_carp($msg)} _create_exp_warning($carp, $exp_warning), $t;
  66             test_test  "$testname (with" . ($_ ? "" : "out") . " a testname)";
  67         }
  68     }
  69 }
  70
  71
  72 sub _found_warn_msg {
  73     defined($_[0])
  74         ? ( join " " => ("found warning:",
  75                          $_[0],
  76                          "at",
  77                          __FILE__,
  78                          "line",
  79                          WARN_LINE . ".") )
  80         : "didn't found a warning";
  81 }
  82
  83 sub _exp_warn_msg {
  84     defined($_[0])
  85         ? "expected to find warning: $_[0]"
  86         : "didn't expect to find a warning";
  87 }
  88
  89 sub _found_carp_msg {
  90     defined($_[0])
  91         ? ( join " " => ("found carped warning:",
  92                          $_[0],
  93                          "at",
  94                          __FILE__,
  95                          "line",
  96                          CARP_LINE) )     # Note the difference, that carp msg
  97         : "didn't found a warning";       # aren't finished by '.'
  98 }
  99
 100 sub _exp_carp_msg {
 101     defined($_[0])
 102         ? "expected to find carped warning: $_[0]"
 103         : "didn't expect to find a warning";
 104 }