cpan/Log-Message-Simple/t/03_functions.t

   1 use Test::More 'no_plan';
   2 use strict;
   3
   4 my $Class   = 'Log::Message::Simple';
   5 my @Carp    = qw[carp croak cluck confess];
   6 my @Msg     = qw[msg debug error];
   7 my $Text    = 'text';
   8 my $Pkg     = 'Test::A';
   9
  10 use_ok( $Class );
  11
  12 {   package Test::A;
  13
  14     ### set up local equivalents to exported functions
  15     ### so we can print to closed FH without having to worry
  16     ### about warnings
  17     ### close stderr/warnings for that same purpose, as carp
  18     ### & friends will print there
  19     for my $name (@Carp, @Msg) {
  20         no strict 'refs';
  21         *$name = sub {
  22                     local $^W;
  23
  24                     ### do the block twice to avoid 'used only once'
  25                     ### warnings
  26                     local $Log::Message::Simple::ERROR_FH;
  27                     local $Log::Message::Simple::DEBUG_FH;
  28                     local $Log::Message::Simple::MSG_FH;
  29
  30                     local $Log::Message::Simple::ERROR_FH;
  31                     local $Log::Message::Simple::DEBUG_FH;
  32                     local $Log::Message::Simple::MSG_FH;
  33
  34
  35
  36
  37                     local *STDERR;
  38                     local $SIG{__WARN__} = sub { };
  39
  40                     my $ref = $Class->can( $name );
  41
  42
  43                     $ref->( @_ );
  44                 };
  45     }
  46 }
  47
  48 for my $name (@Carp, @Msg) {
  49
  50     my $ref = $Pkg->can( $name );
  51     ok( $ref,                   "Found function for '$name'" );
  52
  53     ### start with an empty stack?
  54     cmp_ok( scalar @{[$Class->stack]}, '==', 0,
  55                                 "   Starting with empty stack" );
  56     ok(!$Class->stack_as_string,"   Stringified stack empty" );
  57
  58     ### call the func... no output should appear
  59     ### eval this -- the croak/confess functions die
  60     eval { $ref->( $Text ); };
  61
  62     my @stack = $Class->stack;
  63     cmp_ok( scalar(@stack), '==', 1,
  64                                 "   Text logged to stack" );
  65
  66     for my $re ( $Text, quotemeta '['.uc($name).']' ) {
  67         like( $Class->stack_as_string, qr/$re/,
  68                                 "   Text as expected" );
  69     }
  70
  71     ### empty stack again ###
  72     ok( $Class->flush,          "   Stack flushed" );
  73     cmp_ok( scalar @{[$Class->stack]}, '==', 0,
  74                                 "   Starting with empty stack" );
  75     ok(!$Class->stack_as_string,"   Stringified stack empty" );
  76 }