Commit | Line | Data |
---|---|---|
2a09a23f JK |
1 | #!/usr/bin/perl |
2 | use strict; | |
3 | use warnings; | |
361d4be6 | 4 | $| = 1; |
2a09a23f | 5 | use Test::More tests => 7; |
9219b114 S |
6 | use File::Spec; |
7 | use lib (-d 't' ? File::Spec->catdir(qw(t lib)) : 'lib'); | |
5a784a65 | 8 | use ExtUtils::ParseXS; |
2a09a23f JK |
9 | use ExtUtils::ParseXS::Utilities qw( |
10 | Warn | |
11 | blurt | |
12 | death | |
13 | ); | |
361d4be6 | 14 | use PrimitiveCapture; |
2a09a23f | 15 | |
83cf97c6 | 16 | my $self = ExtUtils::ParseXS->new; |
2a09a23f JK |
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 | ||
361d4be6 | 32 | my $stderr = PrimitiveCapture::capture_stderr(sub { |
2a09a23f | 33 | Warn( $self, $message); |
361d4be6 | 34 | }); |
2a09a23f JK |
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'; | |
361d4be6 | 53 | my $stderr = PrimitiveCapture::capture_stderr(sub { |
2a09a23f | 54 | Warn( $self, $message); |
361d4be6 | 55 | }); |
2a09a23f JK |
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'; | |
361d4be6 | 73 | my $stderr = PrimitiveCapture::capture_stderr(sub { |
2a09a23f | 74 | Warn( $self, $message); |
361d4be6 | 75 | }); |
2a09a23f JK |
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'; | |
361d4be6 | 95 | my $stderr = PrimitiveCapture::capture_stderr(sub { |
2a09a23f | 96 | blurt( $self, $message); |
361d4be6 | 97 | }); |
2a09a23f JK |
98 | like( $stderr, |
99 | qr/$message in $self->{filename}, line 20/, | |
100 | "Got expected blurt output", | |
101 | ); | |
83cf97c6 | 102 | is( $self->report_error_count, 1, "Error count incremented correctly" ); |
2a09a23f JK |
103 | } |
104 | ||
105 | SKIP: { | |
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 { | |
361d4be6 | 119 | my $stderr = PrimitiveCapture::capture_stderr(sub { |
2a09a23f | 120 | death( $self, $message); |
361d4be6 | 121 | }); |
2a09a23f JK |
122 | like( $stderr, |
123 | qr/$message in $self->{filename}, line 20/, | |
124 | "Got expected death output", | |
125 | ); | |
126 | }; | |
127 | } | |
128 | ||
129 | pass("Passed all tests in $0"); |