git.maemo.org Git - pkg-perl/blob - deb-src/libtest-warn-perl/libtest-warn-perl-0.11/t/warnings_like.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 Test::Exception;
  12 use Carp;
  13
  14 use constant TESTS =>(
  15     [    "ok", ["my warning"], ["my"], "standard warning to find"],
  16     ["not ok", ["my warning"], ["another"], "another warning instead of my warning"],
  17     ["not ok", ["warning general not"], ["^(?!warning general)"], "quite only a sub warning"],
  18     ["not ok", [], ["a warning"], "no warning, but expected one"],
  19     ["not ok", ["a warning"], [], "warning, but didn't expect one"],
  20     [    "ok", [], [], "no warning"],
  21     [    "ok", ['$!"%&/()='], ['\$\!\"\%\&\/\(\)\='], "warning with crazy letters"],
  22     ["not ok", ["warning 1","warning 2"], ["warning 1"], "more than one warning (1)"],
  23     ["not ok", ["warning 1","warning 2"], ["warning 2"], "more than one warning (2)"],
  24     [    "ok", ["warning 1","warning 2"], ["warning 1", "warning 2"], "more than one warning (standard ok)"],
  25     [    "ok", ["warning 1","warning 1"], ["warning 1", "warning 1"], "more than one warning (two similar warnings)"],
  26     ["not ok", ["warning 1","warning 2"], ["warning 2", "warning 1"], "more than one warning (different order)"],
  27     [    "ok", [('01' .. '99')], [('01' .. '99')], "many warnings ok"],
  28     ["not ok", [('01' .. '99')], [('01' .. '99'), '100'], "many, but diff. warnings"]
  29 );
  30 use constant SUBTESTS_PER_TESTS  => 32;
  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_like(@$_) foreach TESTS();
  59
  60 sub test_warnings_like {
  61     my ($ok, $msg, $exp_warning, $testname) = @_;
  62     for my $regexes ([map {qr/$_/} @$exp_warning], [map {"/$_/"} @$exp_warning]) {
  63         for my $carp (CARP_LEVELS) {
  64             *_found_msg         = $carp ? *_found_carp_msg : *_found_warn_msg;
  65             *_exp_msg           = $carp ? *_exp_carp_msg   : *_exp_warn_msg;
  66             *_make_warn_or_carp = $carp ? *_make_carp      : *_make_warn;
  67             for my $t (undef, $testname) {
  68                 for my $is_or_are (qw/is are/) {
  69                     test_out "$ok 1" . ($t ? " - $t" : "");
  70                     if ($ok =~ /not/) {
  71                         test_fail +5;
  72                         test_diag  _found_msg(@$msg);
  73                         test_diag  _exp_msg(@$regexes);
  74                     }
  75                     my $ew = _create_exp_warning($carp, $regexes);
  76                     $is_or_are eq 'is' ? warning_like {_make_warn_or_carp(@$msg)} $ew, $t : warnings_like {_make_warn_or_carp(@$msg)} $ew, $t;
  77                     test_test  "$testname (with" . ($t ? "" : "out") . " a testname)";
  78                 }
  79             }
  80         }
  81     }
  82 }
  83
  84 sub _found_warn_msg {
  85     @_ ? map({"found warning: $_ at ". __FILE__ . " line " . WARN_LINE . "." } @_)
  86        : "didn't found a warning";
  87 }
  88
  89 sub _found_carp_msg {
  90     @_ ? map({"found carped warning: $_ at ". __FILE__ . " line " . CARP_LINE} @_)
  91        : "didn't found a warning";
  92 }
  93
  94
  95 sub _exp_warn_msg {
  96     @_ ? map({"expected to find warning: $_" } @_)
  97        : "didn't expect to find a warning";
  98 }
  99
 100 sub _exp_carp_msg {
 101     @_ ? map({"expected to find carped warning: $_" } @_)
 102        : "didn't expect to find a warning";
 103 }