| Subject: | Additional syntax checks (code included) |
I've added checks for most of the version dependencies I tend to care about.
Add to %CHECKS
_four_arg_substr => version->new('5.005'),
_negative_splice_length => version->new('5.005'),
_three_arg_open => version->new('5.006'),
_autovivified_filehandles => version->new('5.006'),
_exists_sub => version->new('5.006'),
_exists_delete_array => version->new('5.006'),
_binary_printf_format => version->new('5.006'),
_sortsub_coderef => version->new('5.006'),
_CHECK_blocks => version->new('5.006'),
_in_memory_file => version->new('5.008'),
_anonymous_temp_file => version->new('5.008'),
_UNTIE_method => version->new('5.008'),
_SCALAR_method => version->new('5.008.003'),
Subroutines:
sub _four_arg_substr {
shift->Document->find_any(sub {
$_[1]->isa('PPI::Token::Word') and
$_[1]->content eq 'substr' and
$_[1]->snext_sibling->child(0)->schildren > 5;
});
}
sub _negative_splice_length {
shift->Document->find_any(sub {
return 0 unless ($_[1]->isa('PPI::Token::Word') and $_[1]->content eq
'splice');
my $expr = $_[1]->snext_sibling->child(0)->schild(4);
return $expr ? $expr->content < 0 : 0;
});
}
sub _three_arg_open {
shift->Document->find_any(sub {
return 0 unless $_[1]->isa('PPI::Token::Word') and $_[1]->content eq
'open';
my $n = grep {
$_->isa('PPI::Token::Operator') &&
( $_->content eq ',' || $_->content eq '=>')
} $_[1]->snext_sibling->child(0)->schildren;
return $n > 1;
});
}
sub _autovivified_filehandles {
# TODO: figure out how (and if) this is applicable to socketpair, socket,
# and accept
shift->Document->find_any(sub {
$_[1]->isa('PPI::Token::Word') and
$_[1]->content =~ /^(?:open|opendir|sysopen)$/ and
$_[1]->snext_sibling->schild(0)->isa('PPI::Statement::Variable');
});
}
sub _exists_sub {
shift->Document->find_any(sub {
$_[1]->isa('PPI::Token::Word') and
$_[1]->content eq 'exists' and
$_[1]->snext_sibling->find_first('PPI::Token::Symbol')->symbol_type
eq '&';
});
}
sub _exists_delete_array {
shift->Document->find_any(sub {
return 0 unless $_[1]->isa('PPI::Token::Word') and
($_[1]->content eq 'exists' or $_[1]->content eq 'delete');
my $expr = $_[1]->snext_sibling->find_first('PPI::Structure::Subscript');
return $expr ? $expr->start->content eq '[' : 0;
});
}
# This might be overzealous. It looks for binary formats in *any* string to
# catch cases like this:
# my $fmt = "%b";
# printf($fmt, 10);
# But it's possible that C<$fmt> is never used as a s?printf() format
string.
sub _binary_printf_format {
shift->Document->find_any(sub {
$_[1]->isa('PPI::Token::Quote') and
$_[1]->content =~ /%-?(?:\d|.\d)\d*(?:\.\d*)?b/;
});
}
sub _sortsub_coderef {
shift->Document->find_any(sub {
$_[1]->isa('PPI::Token::Word') and
$_[1]->content eq 'sort' and
$_[1]->snext_sibling->isa('PPI::Token::Symbol');
});
}
sub _CHECK_blocks {
shift->Document->find_any( sub {
$_[1]->isa('PPI::Statement::Scheduled') and
$_[1]->type eq 'CHECK'
} );
}
sub _in_memory_file {
shift->Document->find_any(sub {
$_[1]->isa('PPI::Token::Word') and
$_[1]->content eq 'open' and
$_[1]->snext_sibling->find_any('PPI::Token::Cast');
});
}
sub _anonymous_temp_file {
shift->Document->find_any(sub {
return 0 unless $_[1]->isa('PPI::Token::Word') and $_[1]->content eq
'open';
my $token = $_[1]->snext_sibling->find_first('PPI::Token::Word');
return $token ? $token->content eq 'undef' : 0;
});
}
sub _UNTIE_method {
shift->Document->find_any(sub {
$_[1]->isa('PPI::Token::Word') and
$_[1]->content eq 'UNTIE';
});
}
sub _SCALAR_method {
shift->Document->find_any(sub {
$_[1]->isa('PPI::Token::Word') and
$_[1]->content eq 'SCALAR';
});
}