view release on metacpan or  search on metacpan

t/perl/critic/policy/references/prohibitrefchecks.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use Perl::Critic;
use Perl::Critic::Policy::References::ProhibitRefChecks;
use PPI;
use Ref::Util;

use Test::More tests=>12;

my $failure=qr/Do not perform manual ref/;

subtest 'decompose'=>sub {
	plan tests=>33;
	my $decompose=sub {
		my ($code)=@_;
		my $doc=PPI::Document->new(\$code);
		my $node=$doc->find_first('PPI::Token::Word');
		return Perl::Critic::Policy::References::ProhibitRefChecks::decompose($node);
	};
	my %tests=(
		'lc ref($x) eq "array"'          => ['eq','array'],
		'ref $$aref[0] !~ /ARRAY/'       => ['!~','/ARRAY/'],
		'ref $$aref[0] && $x=~/\d/'      => [undef],
		'ref $$aref[0] =~ /CODE/'        => ['=~','/CODE/'],
		'ref $$aref[0] eq "CODE" && 1'   => ['eq','code'],
		'ref $$aref[0] eq "CODE"'        => ['eq','code'],
		'ref $$aref[0] eq ref $y'        => ['eq','ref'],
		'ref $$aref[0] ne "CODE"?1:0'    => ['ne','code'],
		'ref $$aref[0]'                  => [undef],
		'ref $href->{k} !~ /ARRAY/'      => ['!~','/ARRAY/'],
		'ref $href->{k} && $x=~/\d/'     => [undef],
		'ref $href->{k} =~ /CODE/'       => ['=~','/CODE/'],
		'ref $href->{k} eq "CODE" && 1'  => ['eq','code'],
		'ref $href->{k} eq "CODE"'       => ['eq','code'],
		'ref $href->{k} eq ref $y'       => ['eq','ref'],
		'ref $href->{k} ne "CODE"?1:0'   => ['ne','code'],
		'ref $href->{k}'                 => [undef],
		'ref($$aref[0]) !~ /ARRAY/'      => ['!~','/ARRAY/'],
		'ref($$aref[0]) && $x=~/\d/'     => [undef],
		'ref($$aref[0]) =~ /CODE/'       => ['=~','/CODE/'],
		'ref($$aref[0]) eq "CODE" && 1'  => ['eq','code'],
		'ref($$aref[0]) eq "CODE"'       => ['eq','code'],
		'ref($$aref[0]) eq ref $y'       => ['eq','ref'],
		'ref($$aref[0]) ne "CODE"?1:0'   => ['ne','code'],
		'ref($$aref[0])'                 => [undef],
		'ref($href->{k}) !~ /ARRAY/'     => ['!~','/ARRAY/'],
		'ref($href->{k}) && $x=~/\d/'    => [undef],
		'ref($href->{k}) =~ /CODE/'      => ['=~','/CODE/'],
		'ref($href->{k}) eq "CODE" && 1' => ['eq','code'],
		'ref($href->{k}) eq "CODE"'      => ['eq','code'],
		'ref($href->{k}) eq ref $y'      => ['eq','ref'],
		'ref($href->{k}) ne "CODE"?1:0'  => ['ne','code'],
		'ref($href->{k})'                => [undef],
	);
	while(my ($code,$expect)=each %tests) { is_deeply([&$decompose($code)],$expect,"decompose:  $code") }
};

subtest 'Valid Ref::Util'=>sub {
	plan tests=>384;
	my $critic=Perl::Critic->new(-profile=>'NONE',-only=>1,-severity=>1);
	$critic->add_policy(-policy=>'Perl::Critic::Policy::References::ProhibitRefChecks');
	foreach my $whitespace ('',' ') {
	foreach my $parens (0,1) {
	foreach my $var ('$var','$array[0]','$hash{key}','$$sref','$$aref[0]','$$href{key}','$aref->[0]','$href->{key}') {
	foreach my $op (' ','!') {
	foreach my $type (qw/is_arrayref is_hashref is_scalarref is_coderef is_globref is_formatref/) {
		my $code=sprintf('%s%s%s%s%s%s'
			,$op
			,$type
			,$whitespace
			,($parens?'(':($whitespace||' ')) # )
			,$var # ( for next line
			,($parens?')':'')
			);
		my $label=sprintf('%14s %s %12s %s%s'
			,lc($type)
			,$op
			,$var
			,($whitespace?'w':'')
			,($parens?'p':'')
			);
		is_deeply([$critic->critique(\$code)],[],$code);
	} } } } }
};

subtest 'Default eq/ne/regexp/bare'=>sub {
	plan tests=>1409;
	#
	# Verify the fast-failure scenario first.
	my $critic=Perl::Critic->new(-profile=>'NONE',-only=>1,-severity=>1);
	$critic->add_policy(-policy=>'Perl::Critic::Policy::References::ProhibitRefChecks');
	like(($critic->critique(\'if(ref $x)'))[0],$failure,'fast failure if(ref $x)');
	#
	$critic=Perl::Critic->new(-profile=>'NONE',-only=>1,-severity=>1);
	$critic->add_policy(-policy=>'Perl::Critic::Policy::References::ProhibitRefChecks',-params=>{eq=>'nothing'});
	#
	# eq/ne
	foreach my $whitespace ('',' ') {
	foreach my $parens (0,1) {
	foreach my $var ('$var','$array[0]','$hash{key}','$$sref','$$aref[0]','$$href{key}','$aref->[0]','$href->{key}') {
	foreach my $op (qw/eq ne/) {
	foreach my $quote ("'",'"') {
	foreach my $type (qw/ARRAY HASH SCALAR CODE GLOB FORMAT/) {
		my $code=sprintf('ref%s%s%s%s %s %s%s%s'
			,$whitespace
			,($parens?'(':($whitespace||' ')) # )
			,$var # ( for next line
			,($parens?')':'')
			,$op
			,$quote
			,$type
			,$quote);
		like(($critic->critique(\$code))[0],$failure,$code);
	} } } } } }
	#
	# regexp
	foreach my $whitespace ('',' ') {
	foreach my $parens (0,1) {