assign_func_args
print_preprocessor_statements
set_cond
+ Warn
+ blurt
+ death
+ check_conditional_preprocessor_statements
);
-# check_conditional_preprocessor_statements
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
if $self->{scope_in_this_xsub}++;
trim_whitespace($_);
- death ("Error: SCOPE: ENABLE/DISABLE")
+ death("Error: SCOPE: ENABLE/DISABLE")
unless /^(ENABLE|DISABLE)\b/i;
$self->{ScopeThisXSUB} = ( uc($1) eq 'ENABLE' );
}
trim_whitespace($_);
# check for ENABLE/DISABLE
- death ("Error: PROTOTYPES: ENABLE/DISABLE")
+ death("Error: PROTOTYPES: ENABLE/DISABLE")
unless /^(ENABLE|DISABLE)/i;
$self->{WantPrototypes} = 1 if $1 eq 'ENABLE';
return 1;
}
-sub check_conditional_preprocessor_statements {
- my ($self) = @_;
- my @cpp = grep(/^\#\s*(?:if|e\w+)/, @{ $self->{line} });
- if (@cpp) {
- my $cpplevel;
- for my $cpp (@cpp) {
- if ($cpp =~ /^\#\s*if/) {
- $cpplevel++;
- }
- elsif (!$cpplevel) {
- Warn( $self, "Warning: #else/elif/endif without #if in this function");
- print STDERR " (precede it with a blank line if the matching #if is outside the function)\n"
- if $self->{XSStack}->[-1]{type} eq 'if';
- return;
- }
- elsif ($cpp =~ /^\#\s*endif/) {
- $cpplevel--;
- }
- }
- Warn( $self, "Warning: #if without #endif in this function") if $cpplevel;
- }
-}
-
sub Q {
my($text) = @_;
$text =~ s/^#//gm;
# Read next xsub into @{ $self->{line} } from ($lastline, <$FH>).
sub fetch_para {
# parse paragraph
- death ("Error: Unterminated `#if/#ifdef/#ifndef'")
+ death("Error: Unterminated `#if/#ifdef/#ifndef'")
if !defined $self->{lastline} && $self->{XSStack}->[-1]{type} eq 'if';
@{ $self->{line} } = ();
@{ $self->{line_no} } = ();
while ($self->{lastline} = <$FH>) {
last if ($self->{lastline} =~ /^=cut\s*$/);
}
- death ("Error: Unterminated pod") unless $self->{lastline};
+ death("Error: Unterminated pod") unless $self->{lastline};
$self->{lastline} = <$FH>;
chomp $self->{lastline};
$self->{lastline} =~ s/^\s+$//;
}
}
-sub Warn {
- my $self = shift;
- # work out the line number
- my $warn_line_number = $self->{line_no}->[@{ $self->{line_no} } - @{ $self->{line} } -1];
-
- print STDERR "@_ in $self->{filename}, line $warn_line_number\n";
-}
-
-sub blurt {
- my $self = shift;
- Warn($self, @_);
- $self->{errors}++
-}
-
-sub death {
- my $self = shift;
- Warn($self, @_);
- exit 1;
-}
-
1;
# vim: ts=2 sw=2 et:
use Cwd;
use File::Spec;
use File::Temp qw( tempdir );
-use Test::More qw(no_plan); # tests => 7;
+use Capture::Tiny qw( capture );
+use Test::More tests => 13;
use lib qw( lib );
use ExtUtils::ParseXS::Utilities qw(
+ check_conditional_preprocessor_statements
);
-# check_conditional_preprocessor_statements
my $self = {};
$self->{line} = [];
$self->{XSStack} = [];
$self->{XSStack}->[0] = {};
-my @capture = ();
-sub capture { push @capture, $_[0] };
-#{
-# $self->{line} = [
-# "#if this_is_an_if_statement",
-# "Alpha this is not an if/elif/elsif/endif",
-# "#elif this_is_an_elif_statement",
-# "Beta this is not an if/elif/elsif/endif",
-# "#else this_is_an_else_statement",
-# "Gamma this is not an if/elif/elsif/endif",
-# "#endif this_is_an_endif_statement",
-# ];
-# $self->{XSStack}->[-1]{type} = 'if';
-#
-# @capture = ();
-# local $SIG{__WARN__} = \&capture;
-# is( check_conditional_preprocessor_statements($self), 0,
-# "basic case: returned 0: all ifs resolved" );
-# ok( ! @capture, "No warnings captured, as expected" );
-#}
-#
-#{
-# $self->{line} = [
-# "#if this_is_an_if_statement",
-# "Alpha this is not an if/elif/elsif/endif",
-# "#if this_is_a_different_if_statement",
-# "Beta this is not an if/elif/elsif/endif",
-# "#endif this_is_a_different_endif_statement",
-# "Gamma this is not an if/elif/elsif/endif",
-# "#endif this_is_an_endif_statement",
-# ];
-# $self->{XSStack}->[-1]{type} = 'if';
-#
-# @capture = ();
-# local $SIG{__WARN__} = \&capture;
-# is( check_conditional_preprocessor_statements($self), 0,
-# "one nested if case: returned 0: all ifs resolved" );
-# ok( ! @capture, "No warnings captured, as expected" );
-#}
-#
-#{
-# $self->{line} = [
-# "Alpha this is not an if/elif/elsif/endif",
-# "#elif this_is_an_elif_statement",
-# "Beta this is not an if/elif/elsif/endif",
-# "#else this_is_an_else_statement",
-# "Gamma this is not an if/elif/elsif/endif",
-# "#endif this_is_an_endif_statement",
-# ];
-# $self->{XSStack}->[-1]{type} = 'if';
-#
-# @capture = ();
-# local $SIG{__WARN__} = \&capture;
-# is( check_conditional_preprocessor_statements($self), undef,
-# "missing 'if' case: returned undef: all ifs resolved" );
-# ok( @capture, "Warning captured, as expected" );
-#}
+{
+ $self->{line} = [
+ "#if this_is_an_if_statement",
+ "Alpha this is not an if/elif/elsif/endif",
+ "#elif this_is_an_elif_statement",
+ "Beta this is not an if/elif/elsif/endif",
+ "#else this_is_an_else_statement",
+ "Gamma this is not an if/elif/elsif/endif",
+ "#endif this_is_an_endif_statement",
+ ];
+ $self->{line_no} = [ 17 .. 23 ];
+ $self->{XSStack}->[-1]{type} = 'if';
+ $self->{filename} = 'myfile1';
+ my ($stdout, $stderr, $rv);
+ ($stdout, $stderr) = capture {
+ $rv = check_conditional_preprocessor_statements($self);
+ };
+
+ is( $rv, 0, "Basic case: returned 0: all ifs resolved" );
+ ok( ! $stderr, "No warnings captured, as expected" );
+}
+
+{
+ $self->{line} = [
+ "#if this_is_an_if_statement",
+ "Alpha this is not an if/elif/elsif/endif",
+ "#if this_is_a_different_if_statement",
+ "Beta this is not an if/elif/elsif/endif",
+ "#endif this_is_a_different_endif_statement",
+ "Gamma this is not an if/elif/elsif/endif",
+ "#endif this_is_an_endif_statement",
+ ];
+ $self->{line_no} = [ 17 .. 23 ];
+ $self->{XSStack}->[-1]{type} = 'if';
+ $self->{filename} = 'myfile1';
+
+ my ($stdout, $stderr, $rv);
+ ($stdout, $stderr) = capture {
+ $rv = check_conditional_preprocessor_statements($self);
+ };
+ is( $rv, 0, "One nested if case: returned 0: all ifs resolved" );
+ ok( ! $stderr, "No warnings captured, as expected" );
+}
+
+{
+ $self->{line} = [
+ "Alpha this is not an if/elif/elsif/endif",
+ "#elif this_is_an_elif_statement",
+ "Beta this is not an if/elif/elsif/endif",
+ "#else this_is_an_else_statement",
+ "Gamma this is not an if/elif/elsif/endif",
+ "#endif this_is_an_endif_statement",
+ ];
+ $self->{line_no} = [ 17 .. 22 ];
+ $self->{XSStack}->[-1]{type} = 'if';
+ $self->{filename} = 'myfile1';
+
+ my ($stdout, $stderr, $rv);
+ ($stdout, $stderr) = capture {
+ $rv = check_conditional_preprocessor_statements($self);
+ };
+ is( $rv, undef,
+ "Missing 'if' case: returned undef: all ifs resolved" );
+ like( $stderr,
+ qr/Warning: #else\/elif\/endif without #if in this function/,
+ "Got expected warning: lack of #if"
+ );
+ like( $stderr,
+ qr/precede it with a blank line/s,
+ "Got expected warning: advice re blank line"
+ );
+}
+
+{
+ $self->{line} = [
+ "Alpha this is not an if/elif/elsif/endif",
+ "#elif this_is_an_elif_statement",
+ "Beta this is not an if/elif/elsif/endif",
+ "#else this_is_an_else_statement",
+ "Gamma this is not an if/elif/elsif/endif",
+ "#endif this_is_an_endif_statement",
+ ];
+ $self->{line_no} = [ 17 .. 22 ];
+ $self->{XSStack}->[-1]{type} = 'file';
+ $self->{filename} = 'myfile1';
+
+ my ($stdout, $stderr, $rv);
+ ($stdout, $stderr) = capture {
+ $rv = check_conditional_preprocessor_statements($self);
+ };
+ is( $rv, undef,
+ "Missing 'if' case: returned undef: all ifs resolved" );
+ like( $stderr,
+ qr/Warning: #else\/elif\/endif without #if in this function/,
+ "Got expected warning: lack of #if"
+ );
+ unlike( $stderr,
+ qr/precede it with a blank line/s,
+ "Did not get unexpected stderr"
+ );
+}
+
+{
+ $self->{line} = [
+ "#if this_is_an_if_statement",
+ "Alpha this is not an if/elif/elsif/endif",
+ "#elif this_is_an_elif_statement",
+ "Beta this is not an if/elif/elsif/endif",
+ "#else this_is_an_else_statement",
+ "Gamma this is not an if/elif/elsif/endif",
+ ];
+ $self->{line_no} = [ 17 .. 22 ];
+ $self->{XSStack}->[-1]{type} = 'if';
+ $self->{filename} = 'myfile1';
+
+ my ($stdout, $stderr, $rv);
+ ($stdout, $stderr) = capture {
+ $rv = check_conditional_preprocessor_statements($self);
+ };
+ isnt( $rv, 0,
+ "Missing 'endif' case: returned non-zero as expected" );
+ like( $stderr,
+ qr/Warning: #if without #endif in this function/s,
+ "Got expected warning: lack of #endif"
+ );
+}
pass("Passed all tests in $0");
--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Carp;
+use Cwd;
+use File::Spec;
+use File::Temp qw( tempdir );
+use Capture::Tiny qw( capture );
+use Test::More tests => 7;
+use lib qw( lib );
+use ExtUtils::ParseXS::Utilities qw(
+ Warn
+ blurt
+ death
+);
+
+my $self = {};
+$self->{line} = [];
+$self->{line_no} = [];
+
+{
+ $self->{line} = [
+ 'Alpha',
+ 'Beta',
+ 'Gamma',
+ 'Delta',
+ ];
+ $self->{line_no} = [ 17 .. 20 ];
+ $self->{filename} = 'myfile1';
+
+ my $message = 'Warning: Ignoring duplicate alias';
+
+ my ($stdout, $stderr) = capture {
+ Warn( $self, $message);
+ };
+ like( $stderr,
+ qr/$message in $self->{filename}, line 20/,
+ "Got expected Warn output",
+ );
+}
+
+{
+ $self->{line} = [
+ 'Alpha',
+ 'Beta',
+ 'Gamma',
+ 'Delta',
+ 'Epsilon',
+ ];
+ $self->{line_no} = [ 17 .. 20 ];
+ $self->{filename} = 'myfile2';
+
+ my $message = 'Warning: Ignoring duplicate alias';
+ my ($stdout, $stderr) = capture {
+ Warn( $self, $message);
+ };
+ like( $stderr,
+ qr/$message in $self->{filename}, line 19/,
+ "Got expected Warn output",
+ );
+}
+
+{
+ $self->{line} = [
+ 'Alpha',
+ 'Beta',
+ 'Gamma',
+ 'Delta',
+ ];
+ $self->{line_no} = [ 17 .. 21 ];
+ $self->{filename} = 'myfile1';
+
+ my $message = 'Warning: Ignoring duplicate alias';
+ my ($stdout, $stderr) = capture {
+ Warn( $self, $message);
+ };
+ like( $stderr,
+ qr/$message in $self->{filename}, line 17/,
+ "Got expected Warn output",
+ );
+}
+
+{
+ $self->{line} = [
+ 'Alpha',
+ 'Beta',
+ 'Gamma',
+ 'Delta',
+ ];
+ $self->{line_no} = [ 17 .. 20 ];
+ $self->{filename} = 'myfile1';
+ $self->{errors} = 0;
+
+
+ my $message = 'Error: Cannot parse function definition';
+ my ($stdout, $stderr) = capture {
+ blurt( $self, $message);
+ };
+ like( $stderr,
+ qr/$message in $self->{filename}, line 20/,
+ "Got expected blurt output",
+ );
+ is( $self->{errors}, 1, "Error count incremented correctly" );
+}
+
+SKIP: {
+ skip "death() not testable as long as it contains hard-coded 'exit'", 1;
+
+ $self->{line} = [
+ 'Alpha',
+ 'Beta',
+ 'Gamma',
+ 'Delta',
+ ];
+ $self->{line_no} = [ 17 .. 20 ];
+ $self->{filename} = 'myfile1';
+
+ my $message = "Code is not inside a function";
+ eval {
+ my ($stdout, $stderr) = capture {
+ death( $self, $message);
+ };
+ like( $stderr,
+ qr/$message in $self->{filename}, line 20/,
+ "Got expected death output",
+ );
+ };
+}
+
+pass("Passed all tests in $0");
projects / platform / upstream / perl.git / commitdiff