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