X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Fi386%2Flibtest-warn-perl%2Flibtest-warn-perl-0.11%2Ft%2Fwarnings_are.t;fp=dev%2Fi386%2Flibtest-warn-perl%2Flibtest-warn-perl-0.11%2Ft%2Fwarnings_are.t;h=f46432789352a9ecbd71da7a71af8ac21d79826c;hp=0000000000000000000000000000000000000000;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hpb=df794b845212301ea0d267c919232538bfef356a diff --git a/dev/i386/libtest-warn-perl/libtest-warn-perl-0.11/t/warnings_are.t b/dev/i386/libtest-warn-perl/libtest-warn-perl-0.11/t/warnings_are.t new file mode 100644 index 0000000..f464327 --- /dev/null +++ b/dev/i386/libtest-warn-perl/libtest-warn-perl-0.11/t/warnings_are.t @@ -0,0 +1,101 @@ +#!/usr/bin/perl + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../blib/lib'; +} + +use strict; +use warnings; + +use Carp; + +use constant SUBTESTS_PER_TESTS => 16; + +use constant TESTS =>( + [ "ok", ["my warning"], ["my warning"], "standard warning to find"], + ["not ok", ["my warning"], ["another warning"], "another warning instead of my warning"], + ["not ok", ["warning general not"], ["warning general"], "quite only a sub warning"], + ["not ok", [], ["a warning"], "no warning, but expected one"], + ["not ok", ["a warning"], [], "warning, but didn't expect one"], + [ "ok", [], [], "no warning"], + [ "ok", ['$!"%&/()='], ['$!"%&/()='], "warning with crazy letters"], + ["not ok", ["warning 1","warning 2"], ["warning 1"], "more than one warning (1)"], + ["not ok", ["warning 1","warning 2"], ["warning 2"], "more than one warning (2)"], + [ "ok", ["warning 1","warning 2"], ["warning 1", "warning 2"], "more than one warning (standard ok)"], + [ "ok", ["warning 1","warning 1"], ["warning 1", "warning 1"], "more than one warning (two similar warnings)"], + ["not ok", ["warning 1","warning 2"], ["warning 2", "warning 1"], "more than one warning (different order)"], + [ "ok", [('01' .. '99')], [('01' .. '99')], "many warnings ok"], + ["not ok", [('01' .. '99')], [('01' .. '99'), '100'], "many, but diff. warnings"] +); + +use Test::Builder::Tester tests => TESTS() * SUBTESTS_PER_TESTS; +use Test::Warn; + +Test::Builder::Tester::color 'on'; + +use constant WARN_LINE => line_num +2; +sub _make_warn { + warn $_ for @_; +} + +use constant CARP_LINE => line_num +2; +sub _make_carp { + carp $_ for @_; +} + +use constant CARP_LEVELS => (0 .. 3); +sub _create_exp_warning { + my ($carplevel, $warning) = @_; + # ['x', 'y', 'z'] + return $warning if $carplevel == 0; + return [map { {carped => $_} } @$warning] if $carplevel == 1; + return {carped => $warning} if $carplevel == 2; + return [{carped => $warning}] if $carplevel == 3; +} + +my $i = 0; +test_warnings_are(@$_) foreach TESTS(); + +sub test_warnings_are { + my ($ok, $msg, $exp_warning, $testname) = @_; + for my $carp (CARP_LEVELS) { + *_found_msg = $carp ? *_found_carp_msg : *_found_warn_msg; + *_exp_msg = $carp ? *_exp_carp_msg : *_exp_warn_msg; + *_make_warn_or_carp = $carp ? *_make_carp : *_make_warn; + for my $t (undef, $testname) { + for my $is_or_are (qw/is are/) { + test_out "$ok 1" . ($t ? " - $t" : ""); + if ($ok =~ /not/) { + test_fail +5; + test_diag _found_msg(@$msg); + test_diag _exp_msg(@$exp_warning); + } + my $ew = _create_exp_warning($carp, $exp_warning); + $is_or_are eq 'is' ? warning_is {_make_warn_or_carp(@$msg)} $ew, $t : warnings_are {_make_warn_or_carp(@$msg)} $ew, $t; + test_test "$testname (with" . ($_ ? "" : "out") . " a testname)"; + } + } + } +} + +sub _found_warn_msg { + @_ ? map({"found warning: $_ at ". __FILE__ . " line " . WARN_LINE . "." } @_) + : "didn't found a warning"; +} + +sub _found_carp_msg { + @_ ? map({"found carped warning: $_ at ". __FILE__ . " line " . CARP_LINE} @_) + : "didn't found a warning"; +} + + +sub _exp_warn_msg { + @_ ? map({"expected to find warning: $_" } @_) + : "didn't expect to find a warning"; +} + +sub _exp_carp_msg { + @_ ? map({"expected to find carped warning: $_" } @_) + : "didn't expect to find a warning"; +}