/t/carped.t
Perl | 71 lines | 55 code | 11 blank | 5 comment | 8 complexity | c7b9f7739f6c78619e7dbeb8d3be4857 MD5 | raw file
1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Carp; 7 8use Test::Builder::Tester tests => 6; 9Test::Builder::Tester::color 'on'; 10use Test::Warn; 11 12sub 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#also will not work on VMS 23my $tcarped = $0; #'t/carped.t'; 24 25test_out "ok 1"; 26warnings_like {foo()} [map {qr/$_/} (1 .. 4)]; 27test_test "Warnings and Carpings mixed, asked only for like warnings"; 28 29test_out "not ok 1"; 30my @test_diag = ( 31"found warning: Warning 1 at $tcarped line 13.", 32"found carped warning: Carping 2 at $tcarped line 14".($Carp::VERSION gt "1.24"?".":""), 33"found carped warning: Carping 3 at $tcarped line 15".($Carp::VERSION gt "1.24"?".":""), 34"found warning: Warning 4 at $tcarped line 16.", 35"expected to find carped warning: (?-xism:1)", 36"expected to find carped warning: (?-xism:2)", 37"expected to find carped warning: (?-xism:3)", 38"expected to find carped warning: (?-xism:4)", 39); 40if (qr/x/ =~ /\(\?\^/){ s/-xism/^/ for @test_diag } 41test_fail +2; 42test_diag @test_diag; 43warnings_like {foo()} [{carped => [map {qr/$_/} (1 .. 4)]}]; 44test_test "Warnings and Carpings mixed, asked only for like carpings"; 45 46test_out "ok 1"; 47warnings_like {foo()} [qr/1/, {carped => [qr/2/, qr/3/]}, qr/4/]; 48test_test "Warnings and Carpings mixed, asked for the right likes"; 49 50my @msg = ("Warning 1", "Carping 2", "Carping 3", "Warning 4"); 51test_out "ok 1"; 52warnings_are {foo()} \@msg; 53test_test "Warnings and Carpings mixed, asked only for warnings"; 54 55test_out "not ok 1"; 56test_fail +10; 57test_diag 58"found warning: Warning 1 at $tcarped line 13.", 59"found carped warning: Carping 2 at $tcarped line 14".($Carp::VERSION gt "1.24"?".":""), 60"found carped warning: Carping 3 at $tcarped line 15".($Carp::VERSION gt "1.24"?".":""), 61"found warning: Warning 4 at $tcarped line 16.", 62"expected to find carped warning: Warning 1", 63"expected to find carped warning: Carping 2", 64"expected to find carped warning: Carping 3", 65"expected to find carped warning: Warning 4"; 66warnings_are {foo()} {carped => \@msg}; 67test_test "Warnings and Carpings mixed, asked only for carpings"; 68 69test_out "ok 1"; 70warnings_are {foo()} [$msg[0], {carped => [@msg[1..2]]}, $msg[3]]; 71test_test "Warnings and Carpings mixed, asked for the right ones";