#!perl
use
5.006001;
our
$VERSION
=
'1.101_003'
;
my
@color_severity_params
;
'Term::ANSIColor is not available'
;
$skip_color_severity
or
@color_severity_params
=
qw<
color-severity-highest
color-severity-high
color-severity-medium
color-severity-low
color-severity-lowest
>
;
plan
tests
=> 13 +
scalar
@color_severity_params
;
Readonly::Scalar
my
$PROFILE
=>
't/01_bad_perlcriticrc'
;
Readonly::Scalar
my
$NO_ENABLED_POLICIES_MESSAGE
=>
q<There are no enabled policies.>
;
Readonly::Scalar
my
$INVALID_PARAMETER_MESSAGE
=>
q<The BuiltinFunctions::RequireBlockGrep policy doesn't take a "no_such_parameter" option.>
;
Readonly::Scalar
my
$REQUIRE_POD_SECTIONS_SOURCE_MESSAGE_PREFIX
=>
q<The value for the Documentation::RequirePodSections "source" option ("Zen_and_the_Art_of_Motorcycle_Maintenance") is not one of the allowed values: >
;
eval
{
my
$critic
= Perl::Critic->new(
'-profile'
=>
$PROFILE
);
};
my
$test_passed
;
my
$eval_result
=
$EVAL_ERROR
;
$test_passed
=
ok(
$eval_result
,
'should get an exception when using a bad rc file'
);
die
"No point in continuing.\n"
if
not
$test_passed
;
$test_passed
=
isa_ok(
$eval_result
,
'Perl::Critic::Exception::AggregateConfiguration'
,
'$EVAL_ERROR'
,
);
if
( not
$test_passed
) {
diag(
$eval_result
);
die
"No point in continuing.\n"
;
}
my
@exceptions
= @{
$eval_result
->exceptions() };
my
@parameters
= (
qw<
exclude
include
profile-strictness
severity
single-policy
theme
top
verbose
>
,
@color_severity_params
,
);
my
%expected_regexes
=
map
{
$_
=> generate_global_message_regex(
$_
,
$PROFILE
) }
@parameters
;
my
$expected_exceptions
= 1 +
scalar
@parameters
;
is(
scalar
@exceptions
,
$expected_exceptions
,
'should have received the correct number of exceptions'
);
if
(
@exceptions
!=
$expected_exceptions
) {
foreach
my
$exception
(
@exceptions
) {
diag
"Exception: $exception"
;
}
}
while
(
my
(
$parameter
,
$regex
) =
each
%expected_regexes
) {
is(
(
scalar
grep
{ m/
$regex
/xms }
@exceptions
),
1,
"should have received one and only one exception for $parameter"
,
);
}
is(
(
scalar
grep
{
$INVALID_PARAMETER_MESSAGE
eq
$_
}
@exceptions
),
0,
'should not have received an extra-parameter exception'
,
);
is(
(
scalar
grep
{ is_require_pod_sections_source_exception(
$_
) }
@exceptions
),
1,
'should have received an invalid source exception for RequirePodSections'
,
);
sub
generate_global_message_regex {
my
(
$parameter
,
$file
) =
@_
;
return
qr<
\A
The [ ] value [ ] for [ ] the [ ] global [ ]
"$parameter"
.*
found [ ] in [ ] "$file"
>
xms;
}
sub
is_require_pod_sections_source_exception {
my
(
$exception
) =
@_
;
my
$prefix
=
substr
$exception
,
0,
length
$REQUIRE_POD_SECTIONS_SOURCE_MESSAGE_PREFIX
;
return
$prefix
eq
$REQUIRE_POD_SECTIONS_SOURCE_MESSAGE_PREFIX
;
}
1;