/t/carped.t

http://github.com/chorny/test-warn · Perl · 71 lines · 55 code · 11 blank · 5 comment · 2 complexity · c7b9f7739f6c78619e7dbeb8d3be4857 MD5 · raw file 

    

  1. #!/usr/bin/perl
    2. 

  2. 

  3. use strict;
    4. 

  4. use warnings;
    5. 

  5. 

  6. use Carp;
    7. 

  7. 

  8. use Test::Builder::Tester tests => 6;
    9. 

  9. Test::Builder::Tester::color 'on';
    10. 

  10. use Test::Warn;
    11. 

  11. 

  12. sub foo {
    13. 

  13.     warn "Warning 1";
    14. 

  14.     carp "Carping 2";
    15. 

  15.     carp "Carping 3";
    16. 

  16.     warn "Warning 4";
    17. 

  17. }
    18. 

  18. 

  19. #use File::Spec;
    20. 

  20. #my $tcarped = File::Spec->catfile('t','carped.t');
    21. 

  21. #$tcarped =~ s/\\/\//g if $^O eq 'MSWin32';
    22. 

  22. #also will not work on VMS
    23. 

  23. my $tcarped = $0; #'t/carped.t';
    24. 

  24. 

  25. test_out "ok 1";
    26. 

  26. warnings_like {foo()} [map {qr/$_/} (1 .. 4)];
    27. 

  27. test_test "Warnings and Carpings mixed, asked only for like warnings";
    28. 

  28. 

  29. test_out "not ok 1";
    30. 

  30. my @test_diag = (
    31. 

  31. "found warning: Warning 1 at $tcarped line 13.",
    32. 

  32. "found carped warning: Carping 2 at $tcarped line 14".($Carp::VERSION gt "1.24"?".":""),
    33. 

  33. "found carped warning: Carping 3 at $tcarped line 15".($Carp::VERSION gt "1.24"?".":""),
    34. 

  34. "found warning: Warning 4 at $tcarped line 16.",
    35. 

  35. "expected to find carped warning: (?-xism:1)",
    36. 

  36. "expected to find carped warning: (?-xism:2)",
    37. 

  37. "expected to find carped warning: (?-xism:3)",
    38. 

  38. "expected to find carped warning: (?-xism:4)",
    39. 

  39. );
    40. 

  40. if (qr/x/ =~ /\(\?\^/){ s/-xism/^/ for @test_diag }
    41. 

  41. test_fail +2;
    42. 

  42. test_diag @test_diag;
    43. 

  43. warnings_like {foo()} [{carped => [map {qr/$_/} (1 .. 4)]}];
    44. 

  44. test_test "Warnings and Carpings mixed, asked only for like carpings";
    45. 

  45. 

  46. test_out "ok 1";
    47. 

  47. warnings_like {foo()} [qr/1/, {carped => [qr/2/, qr/3/]}, qr/4/];
    48. 

  48. test_test "Warnings and Carpings mixed, asked for the right likes";
    49. 

  49. 

  50. my @msg = ("Warning 1", "Carping 2", "Carping 3", "Warning 4");
    51. 

  51. test_out "ok 1";
    52. 

  52. warnings_are {foo()} \@msg;
    53. 

  53. test_test "Warnings and Carpings mixed, asked only for warnings";
    54. 

  54. 

  55. test_out "not ok 1";
    56. 

  56. test_fail +10;
    57. 

  57. test_diag 
    58. 

  58. "found warning: Warning 1 at $tcarped line 13.",
    59. 

  59. "found carped warning: Carping 2 at $tcarped line 14".($Carp::VERSION gt "1.24"?".":""),
    60. 

  60. "found carped warning: Carping 3 at $tcarped line 15".($Carp::VERSION gt "1.24"?".":""),
    61. 

  61. "found warning: Warning 4 at $tcarped line 16.",
    62. 

  62. "expected to find carped warning: Warning 1",
    63. 

  63. "expected to find carped warning: Carping 2",
    64. 

  64. "expected to find carped warning: Carping 3",
    65. 

  65. "expected to find carped warning: Warning 4";
    66. 

  66. warnings_are {foo()} {carped => \@msg};
    67. 

  67. test_test "Warnings and Carpings mixed, asked only for carpings";
    68. 

  68. 

  69. test_out "ok 1";
    70. 

  70. warnings_are {foo()} [$msg[0], {carped => [@msg[1..2]]}, $msg[3]];
    71. 

  71. test_test "Warnings and Carpings mixed, asked for the right ones";
    72.