dist/ExtUtils-ParseXS/t/114-blurt_death_Warn.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 $| = 1;
   5 use Carp;
   6 use Cwd;
   7 use File::Spec;
   8 use File::Temp qw( tempdir );
   9 use Test::More tests =>  7;
  10 use lib qw( lib t/lib );
  11 use ExtUtils::ParseXS;
  12 use ExtUtils::ParseXS::Utilities qw(
  13     Warn
  14     blurt
  15     death
  16 );
  17 use PrimitiveCapture;
  18
  19 my $self = bless({} => 'ExtUtils::ParseXS');
  20 $self->{line} = [];
  21 $self->{line_no} = [];
  22
  23 {
  24     $self->{line} = [
  25         'Alpha',
  26         'Beta',
  27         'Gamma',
  28         'Delta',
  29     ];
  30     $self->{line_no} = [ 17 .. 20 ];
  31     $self->{filename} = 'myfile1';
  32
  33     my $message = 'Warning: Ignoring duplicate alias';
  34
  35     my $stderr = PrimitiveCapture::capture_stderr(sub {
  36         Warn( $self, $message);
  37     });
  38     like( $stderr,
  39         qr/$message in $self->{filename}, line 20/,
  40         "Got expected Warn output",
  41     );
  42 }
  43
  44 {
  45     $self->{line} = [
  46         'Alpha',
  47         'Beta',
  48         'Gamma',
  49         'Delta',
  50         'Epsilon',
  51     ];
  52     $self->{line_no} = [ 17 .. 20 ];
  53     $self->{filename} = 'myfile2';
  54
  55     my $message = 'Warning: Ignoring duplicate alias';
  56     my $stderr = PrimitiveCapture::capture_stderr(sub {
  57         Warn( $self, $message);
  58     });
  59     like( $stderr,
  60         qr/$message in $self->{filename}, line 19/,
  61         "Got expected Warn output",
  62     );
  63 }
  64
  65 {
  66     $self->{line} = [
  67         'Alpha',
  68         'Beta',
  69         'Gamma',
  70         'Delta',
  71     ];
  72     $self->{line_no} = [ 17 .. 21 ];
  73     $self->{filename} = 'myfile1';
  74
  75     my $message = 'Warning: Ignoring duplicate alias';
  76     my $stderr = PrimitiveCapture::capture_stderr(sub {
  77         Warn( $self, $message);
  78     });
  79     like( $stderr,
  80         qr/$message in $self->{filename}, line 17/,
  81         "Got expected Warn output",
  82     );
  83 }
  84
  85 {
  86     $self->{line} = [
  87         'Alpha',
  88         'Beta',
  89         'Gamma',
  90         'Delta',
  91     ];
  92     $self->{line_no} = [ 17 .. 20 ];
  93     $self->{filename} = 'myfile1';
  94     $self->{errors} = 0;
  95
  96
  97     my $message = 'Error: Cannot parse function definition';
  98     my $stderr = PrimitiveCapture::capture_stderr(sub {
  99         blurt( $self, $message);
 100     });
 101     like( $stderr,
 102         qr/$message in $self->{filename}, line 20/,
 103         "Got expected blurt output",
 104     );
 105     is( $self->{errors}, 1, "Error count incremented correctly" );
 106 }
 107
 108 SKIP: {
 109     skip "death() not testable as long as it contains hard-coded 'exit'", 1;
 110
 111     $self->{line} = [
 112         'Alpha',
 113         'Beta',
 114         'Gamma',
 115         'Delta',
 116     ];
 117     $self->{line_no} = [ 17 .. 20 ];
 118     $self->{filename} = 'myfile1';
 119
 120     my $message = "Code is not inside a function";
 121     eval {
 122         my $stderr = PrimitiveCapture::capture_stderr(sub {
 123             death( $self, $message);
 124         });
 125         like( $stderr,
 126             qr/$message in $self->{filename}, line 20/,
 127             "Got expected death output",
 128         );
 129     };
 130 }
 131
 132 pass("Passed all tests in $0");