git.maemo.org Git - pkg-perl/blob - deb-src/libtest-warn-perl/libtest-warn-perl-0.11/t/warnings_are.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  => 16;
  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", [], ["a warning"], "no warning, but expected one"],
  20     ["not ok", ["a warning"], [], "warning, but didn't expect one"],
  21     [    "ok", [], [], "no warning"],
  22     [    "ok", ['$!"%&/()='], ['$!"%&/()='], "warning with crazy letters"],
  23     ["not ok", ["warning 1","warning 2"], ["warning 1"], "more than one warning (1)"],
  24     ["not ok", ["warning 1","warning 2"], ["warning 2"], "more than one warning (2)"],
  25     [    "ok", ["warning 1","warning 2"], ["warning 1", "warning 2"], "more than one warning (standard ok)"],
  26     [    "ok", ["warning 1","warning 1"], ["warning 1", "warning 1"], "more than one warning (two similar warnings)"],
  27     ["not ok", ["warning 1","warning 2"], ["warning 2", "warning 1"], "more than one warning (different order)"],
  28     [    "ok", [('01' .. '99')], [('01' .. '99')], "many warnings ok"],
  29     ["not ok", [('01' .. '99')], [('01' .. '99'), '100'], "many, but diff. warnings"]
  30 );
  31
  32 use Test::Builder::Tester tests  => TESTS() * SUBTESTS_PER_TESTS;
  33 use Test::Warn;
  34
  35 Test::Builder::Tester::color 'on';
  36
  37 use constant WARN_LINE => line_num +2;
  38 sub _make_warn {
  39     warn $_ for @_;
  40 }
  41
  42 use constant CARP_LINE => line_num +2;
  43 sub _make_carp {
  44     carp $_ for @_;
  45 }
  46
  47 use constant CARP_LEVELS => (0 .. 3);
  48 sub _create_exp_warning {
  49     my ($carplevel, $warning) = @_;
  50     # ['x', 'y', 'z']
  51     return $warning                           if $carplevel == 0;
  52     return [map { {carped => $_} } @$warning] if $carplevel == 1;
  53     return {carped => $warning}               if $carplevel == 2;
  54     return [{carped => $warning}]             if $carplevel == 3;
  55 }
  56
  57 my $i = 0;
  58 test_warnings_are(@$_) foreach TESTS();
  59
  60 sub test_warnings_are {
  61     my ($ok, $msg, $exp_warning, $testname) = @_;
  62     for my $carp (CARP_LEVELS) {
  63         *_found_msg         = $carp ? *_found_carp_msg : *_found_warn_msg;
  64         *_exp_msg           = $carp ? *_exp_carp_msg   : *_exp_warn_msg;
  65         *_make_warn_or_carp = $carp ? *_make_carp      : *_make_warn;
  66         for my $t (undef, $testname) {
  67             for my $is_or_are (qw/is are/) {
  68                 test_out "$ok 1" . ($t ? " - $t" : "");
  69                 if ($ok =~ /not/) {
  70                     test_fail +5;
  71                     test_diag  _found_msg(@$msg);
  72                     test_diag  _exp_msg(@$exp_warning);
  73                 }
  74                 my $ew = _create_exp_warning($carp, $exp_warning);
  75                 $is_or_are eq 'is' ? warning_is {_make_warn_or_carp(@$msg)} $ew, $t : warnings_are {_make_warn_or_carp(@$msg)} $ew, $t;
  76                 test_test  "$testname (with" . ($_ ? "" : "out") . " a testname)";
  77             }
  78         }
  79     }
  80 }
  81
  82 sub _found_warn_msg {
  83     @_ ? map({"found warning: $_ at ". __FILE__ . " line " . WARN_LINE . "." } @_)
  84        : "didn't found a warning";
  85 }
  86
  87 sub _found_carp_msg {
  88     @_ ? map({"found carped warning: $_ at ". __FILE__ . " line " . CARP_LINE} @_)
  89        : "didn't found a warning";
  90 }
  91
  92
  93 sub _exp_warn_msg {
  94     @_ ? map({"expected to find warning: $_" } @_)
  95        : "didn't expect to find a warning";
  96 }
  97
  98 sub _exp_carp_msg {
  99     @_ ? map({"expected to find carped warning: $_" } @_)
 100        : "didn't expect to find a warning";
 101 }