git.maemo.org Git - pkg-perl/blob - deb-src/libtest-warn-perl/libtest-warn-perl-0.11/t/carped.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp;
   7
   8 use Test::Builder::Tester tests => 6;
   9 Test::Builder::Tester::color 'on';
  10 use Test::Warn;
  11
  12 sub foo {
  13     warn "Warning 1";
  14     carp "Carping 2";
  15     carp "Carping 3";
  16     warn "Warning 4";
  17 }
  18
  19 use File::Spec;
  20 my $tcarped = File::Spec->catfile('t','carped.t');
  21 $tcarped =~ s/\\/\//g if $^O eq 'MSWin32';
  22
  23 test_out "ok 1";
  24 warnings_like {foo()} [map {qr/$_/} (1 .. 4)];
  25 test_test "Warnings and Carpings mixed, asked only for like warnings";
  26
  27 test_out "not ok 1";
  28 test_fail +10;
  29 test_diag
  30 "found warning: Warning 1 at $tcarped line 13.",
  31 "found carped warning: Carping 2 at $tcarped line 14",
  32 "found carped warning: Carping 3 at $tcarped line 15",
  33 "found warning: Warning 4 at $tcarped line 16.",
  34 "expected to find carped warning: (?-xism:1)",
  35 "expected to find carped warning: (?-xism:2)",
  36 "expected to find carped warning: (?-xism:3)",
  37 "expected to find carped warning: (?-xism:4)";
  38 warnings_like {foo()} [{carped => [map {qr/$_/} (1 .. 4)]}];
  39 test_test "Warnings and Carpings mixed, asked only for like carpings";
  40
  41 test_out "ok 1";
  42 warnings_like {foo()} [qr/1/, {carped => [qr/2/, qr/3/]}, qr/4/];
  43 test_test "Warnings and Carpings mixed, asked for the right likes";
  44
  45 my @msg = ("Warning 1", "Carping 2", "Carping 3", "Warning 4");
  46 test_out "ok 1";
  47 warnings_are {foo()} \@msg;
  48 test_test "Warnings and Carpings mixed, asked only for warnings";
  49
  50 test_out "not ok 1";
  51 test_fail +10;
  52 test_diag
  53 "found warning: Warning 1 at $tcarped line 13.",
  54 "found carped warning: Carping 2 at $tcarped line 14",
  55 "found carped warning: Carping 3 at $tcarped line 15",
  56 "found warning: Warning 4 at $tcarped line 16.",
  57 "expected to find carped warning: Warning 1",
  58 "expected to find carped warning: Carping 2",
  59 "expected to find carped warning: Carping 3",
  60 "expected to find carped warning: Warning 4";
  61 warnings_are {foo()} {carped => \@msg};
  62 test_test "Warnings and Carpings mixed, asked only for carpings";
  63
  64 test_out "ok 1";
  65 warnings_are {foo()} [$msg[0], {carped => [@msg[1..2]]}, $msg[3]];
  66 test_test "Warnings and Carpings mixed, asked for the right ones";