Skip to content

Commit b536acf

Browse files
mattias-pmattias-p
committed
Expression language for specifying tests to run
1 parent 1f40cae commit b536acf

File tree

6 files changed

+581
-121
lines changed

6 files changed

+581
-121
lines changed

‎MANIFEST‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ inc/Module/Install/Share.pm
1212
inc/Module/Install/Win32.pm
1313
inc/Module/Install/WriteAll.pm
1414
lib/Zonemaster/CLI.pm
15+
lib/Zonemaster/CLI/TestCaseSet.pm
1516
LICENSE
1617
Makefile.PL
1718
MANIFEST This list of files
@@ -28,6 +29,7 @@ share/locale/nb/LC_MESSAGES/Zonemaster-CLI.mo
2829
share/locale/sv/LC_MESSAGES/Zonemaster-CLI.mo
2930
t/00-load.t
3031
t/pod.t
32+
t/test_case_set.t
3133
t/usage.fake-data.data
3234
t/usage.fake-root.data
3335
t/usage.hints

‎lib/Zonemaster/CLI.pm‎

Lines changed: 28 additions & 108 deletions
Original file line numberDiff line numberDiff line change
@@ -27,14 +27,16 @@ use POSIX qw[setlocale LC_MESSAGES LC_CTYPE];
2727
use Readonly;
2828
use Scalar::Util qw[blessed];
2929
use Try::Tiny;
30-
use Zonemaster::LDNS;
31-
use Zonemaster::Engine;
3230
use Zonemaster::Engine::Exception;
33-
use Zonemaster::Engine::Normalization qw[normalize_name];
3431
use Zonemaster::Engine::Logger::Entry;
32+
use Zonemaster::Engine::Normalization qw[normalize_name];
3533
use Zonemaster::Engine::Translator;
3634
use Zonemaster::Engine::Util qw[parse_hints];
3735
use Zonemaster::Engine::Validation qw[validate_ipv4 validate_ipv6];
36+
use Zonemaster::Engine;
37+
use Zonemaster::LDNS;
38+
39+
use Zonemaster::CLI::TestCaseSet;
3840

3941
our %numeric = Zonemaster::Engine::Logger::Entry->levels;
4042
our $JSON = JSON::XS->new->allow_blessed->convert_blessed->canonical;
@@ -93,7 +95,7 @@ sub run {
9395
my $opt_sourceaddr4;
9496
my $opt_sourceaddr6;
9597
my $opt_stop_level = '';
96-
my @opt_test = ();
98+
my $opt_test = '';
9799
my $opt_time = 1;
98100
my $opt_version = 0;
99101

@@ -138,7 +140,7 @@ sub run {
138140
'sourceaddr6=s' => \$opt_sourceaddr6,
139141
'stop-level=s' => \$opt_stop_level,
140142
'stop_level=s' => \$opt_stop_level,
141-
'test=s' => \@opt_test,
143+
'test=s' => \$opt_test,
142144
'time!' => \$opt_time,
143145
'version!' => \$opt_version,
144146
) or do {
@@ -251,92 +253,24 @@ sub run {
251253
};
252254
}
253255

254-
my @testing_suite;
255-
if ( @opt_test ) {
256-
my %existing_tests = Zonemaster::Engine->all_methods;
257-
my @existing_test_modules = keys %existing_tests;
258-
my @existing_test_cases = map { @{ $existing_tests{$_} } } @existing_test_modules;
259-
260-
foreach my $t ( @opt_test ) {
261-
# There should be at most one slash character
262-
if ( $t =~ tr/\/// > 1 ) {
263-
say STDERR __( "Error: Invalid input '$t' in --test. There must be at most one slash ('/') character.");
264-
return $EXIT_USAGE_ERROR;
265-
}
266-
267-
# The case does not matter
268-
$t = lc( $t );
269-
270-
my ( $module, $method );
271-
# Fully qualified module and test case (e.g. Example/example12), or just a test case (e.g. example12). Note the different capturing order.
272-
if ( ( ($module, $method) = $t =~ m#^ ( [a-z]+ ) / ( [a-z]+[0-9]{2} ) $#ix )
273-
or
274-
( ($method, $module) = $t =~ m#^ ( ( [a-z]+ ) [0-9]{2} ) $#ix ) )
275-
{
276-
# Check that test module exists
277-
if ( grep( /^$module$/, map { lc($_) } @existing_test_modules ) ) {
278-
# Check that test case exists
279-
if ( grep( /^$method$/, @existing_test_cases ) ) {
280-
push @testing_suite, "$module/$method";
281-
}
282-
else {
283-
say STDERR __( "Error: Unrecognized test case '$method' in --test. Use --list-tests for a list of valid choices." );
284-
return $EXIT_USAGE_ERROR;
285-
}
286-
}
287-
else {
288-
say STDERR __( "Error: Unrecognized test module '$module' in --test. Use --list-tests for a list of valid choices." );
289-
return $EXIT_USAGE_ERROR;
290-
}
291-
}
292-
# Just a module name (e.g. Example) or something invalid.
293-
else {
294-
$t =~ s{/$}{};
295-
# Check that test module exists
296-
if ( grep( /^$t$/, map { lc($_) } @existing_test_modules ) ) {
297-
push @testing_suite, $t;
298-
}
299-
else {
300-
say STDERR __( "Error: Invalid input '$t' in --test." );
301-
return $EXIT_USAGE_ERROR;
302-
}
303-
}
304-
}
305-
306-
# Start with all profile-enabled test cases
307-
my @actual_test_cases = @{ Zonemaster::Engine::Profile->effective->get( 'test_cases' ) };
256+
{
257+
my $cases = Zonemaster::CLI::TestCaseSet->new(
258+
Zonemaster::Engine::Profile->effective->get( q{test_cases} ),
259+
Zonemaster::Engine->all_methods,
260+
);
308261

309-
# Derive test module from each profile-enabled test case
310-
my %actual_test_modules;
311-
foreach my $t ( @actual_test_cases ) {
312-
my ( $module ) = $t =~ m#^ ( [a-z]+ ) [0-9]{2} $#ix;
313-
$actual_test_modules{$module} = 1;
314-
}
262+
my @modifiers = Zonemaster::CLI::TestCaseSet->parse_modifier_expr( $opt_test );
263+
while ( @modifiers ) {
264+
my $op = shift @modifiers;
265+
my $term = shift @modifiers;
315266

316-
# Check if more test cases need to be included in the profile
317-
foreach my $t ( @testing_suite ) {
318-
# Either a module/method, or just a module
319-
my ( $module, $method ) = split('/', $t);
320-
if ( $method ) {
321-
# Test case in not already in the profile, we add it explicitly and notify the user
322-
if ( not grep( /^$method$/, @actual_test_cases ) ) {
323-
say $fh_diag __x( "Notice: Engine does not have test case '$method' enabled in the profile. Forcing...");
324-
push @actual_test_cases, $method;
325-
}
326-
}
327-
else {
328-
# No test case from this module is already in the profile, we can add them all
329-
if ( not grep( /^$module$/, keys %actual_test_modules ) ) {
330-
# Get the test module with the right case
331-
( $module ) = grep { lc( $module ) eq lc( $_ ) } @existing_test_modules;
332-
# No need to bother to check for duplicates here
333-
push @actual_test_cases, @{ $existing_tests{$module} };
334-
}
267+
if ( !$cases->apply_modifier( $op, $term ) ) {
268+
say STDERR __x( "Error: Unrecognized term '$term' in --test.\n" );
269+
return $EXIT_USAGE_ERROR;
335270
}
336271
}
337272

338-
# Configure Engine to include all of the required test cases in the profile
339-
Zonemaster::Engine::Profile->effective->set( 'test_cases', [ uniq sort @actual_test_cases ] );
273+
Zonemaster::Engine::Profile->effective->set( q{test_cases}, [$cases->to_list] ),
340274
}
341275

342276
# These two must come after any profile from command line has been loaded
@@ -559,7 +493,7 @@ sub run {
559493
}
560494
}
561495

562-
if ( $opt_profile or @opt_test ) {
496+
if ( $opt_profile or $opt_test ne '' ) {
563497
# Separate initialization from main output in human readable output mode
564498
print "\n" if $fh_diag eq *STDOUT;
565499
}
@@ -608,29 +542,9 @@ sub run {
608542

609543
# Actually run tests!
610544
eval {
611-
if ( @opt_test ) {
612-
foreach my $t ( @testing_suite ) {
613-
# Either a module/method, or just a module
614-
my ( $module, $method ) = split('/', $t);
615-
if ( $method ) {
616-
Zonemaster::Engine->test_method( $module, $method, $domain );
617-
}
618-
else {
619-
Zonemaster::Engine->test_module( $module, $domain );
620-
}
621-
}
622-
}
623-
else {
624-
Zonemaster::Engine->test_zone( $domain );
625-
}
545+
Zonemaster::Engine->test_zone( $domain );
626546
};
627547

628-
if ( not $opt_raw and not $opt_json ) {
629-
if ( not $printed_something ) {
630-
say __( "Looks OK." );
631-
}
632-
}
633-
634548
if ( $@ ) {
635549
my $err = $@;
636550
if ( blessed $err and $err->isa( "Zonemaster::Engine::Exception::NormalExit" ) ) {
@@ -641,6 +555,12 @@ sub run {
641555
}
642556
}
643557

558+
if ( not $opt_raw and not $opt_json ) {
559+
if ( not $printed_something ) {
560+
say __( "Looks OK." );
561+
}
562+
}
563+
644564
my $json_output = {};
645565

646566
if ( $opt_count ) {

0 commit comments

Comments
 (0)