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