Skip to content

Commit

Permalink
Merge pull request #1293 from tgreenx/cleanup-syntax
Browse files Browse the repository at this point in the history 
Cleanup in Syntax test module
  • Loading branch information
@tgreenx
tgreenx authored Oct 10, 2023
2 parents 2ac99ca + e28fa28 commit 5fd6423
Show file tree
Hide file tree
Showing 3 changed files with 63 additions and 110 deletions.
87 changes: 27 additions & 60 deletions lib/Zonemaster/Engine/Test/Syntax.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,16 +54,16 @@ sub all {
my ( $class, $zone ) = @_;
my @results;

push @results, $class->syntax01( $zone->name ) if Zonemaster::Engine::Util::should_run_test( q{syntax01} );
push @results, $class->syntax02( $zone->name ) if Zonemaster::Engine::Util::should_run_test( q{syntax02} );
push @results, $class->syntax03( $zone->name ) if Zonemaster::Engine::Util::should_run_test( q{syntax03} );
push @results, $class->syntax01( $zone ) if Zonemaster::Engine::Util::should_run_test( q{syntax01} );
push @results, $class->syntax02( $zone ) if Zonemaster::Engine::Util::should_run_test( q{syntax02} );
push @results, $class->syntax03( $zone ) if Zonemaster::Engine::Util::should_run_test( q{syntax03} );

if ( any { $_->tag eq q{ONLY_ALLOWED_CHARS} } @results ) {

foreach my $local_nsname ( uniq map { $_->string } @{ Zonemaster::Engine::TestMethods->method2( $zone ) },
foreach my $local_nsname ( uniq map { $_ } @{ Zonemaster::Engine::TestMethods->method2( $zone ) },
@{ Zonemaster::Engine::TestMethods->method3( $zone ) } )
{
push @results, $class->syntax04( $local_nsname )
push @results, $class->syntax04( Zonemaster::Engine->zone( $local_nsname ) )
if Zonemaster::Engine::Util::should_run_test( q{syntax04} );
}

Expand Down Expand Up @@ -554,49 +554,16 @@ sub _label_not_ace_has_double_hyphen_in_position_3_and_4 {

=over
=item _get_name()
my $name = _get_name( $item );
Converts a given argument to a L<Zonemaster::Engine::DNSName> object. Used as an helper function for Test Cases L<Syntax01|/syntax01()> to L<Syntax04|/syntax04()>.
Takes a string (name), or a L<Zonemaster::Engine::DNSName> object, or a L<Zonemaster::Engine::Zone> object.
Returns a L<Zonemaster::Engine::DNSName> object.
=back
=cut

sub _get_name {
my ( $item ) = @_;
my $name;

if ( not ref $item ) {
$name = name( $item );
}
elsif ( ref( $item ) eq q{Zonemaster::Engine::Zone} ) {
$name = $item->name;
}
elsif ( ref( $item ) eq q{Zonemaster::Engine::DNSName} ) {
$name = $item;
}

return $name;
}

=over
=item _check_name_syntax()
my @logentry_array = _check_name_syntax( $label_prefix_string, $item );
my @logentry_array = _check_name_syntax( $label_prefix_string, $name );
Checks the syntax of a given name. Makes use of L</_name_has_only_legal_characters()> and L</_label_not_ace_has_double_hyphen_in_position_3_and_4()>.
Used as an helper function for Test Cases L<Syntax04|/syntax04()>, L<Syntax07|/syntax07()> and L<Syntax08|/syntax08()>.
Takes a string (label prefix) and either a string (name), a L<Zonemaster::Engine::DNSName> object, or a L<Zonemaster::Engine::Zone> object.
Takes a string (label prefix) and either a string (name) or a L<Zonemaster::Engine::DNSName> object.
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
=back
Expand All @@ -606,7 +573,7 @@ sub _check_name_syntax {
my ( $info_label_prefix, $name ) = @_;
my @results;

$name = _get_name( $name );
$name = Zonemaster::Engine::Util::name( $name );

if ( not _name_has_only_legal_characters( $name ) ) {
push @results,
Expand Down Expand Up @@ -665,11 +632,11 @@ sub _check_name_syntax {
=item syntax01()
my @logentry_array = syntax01( $item );
my @logentry_array = syntax01( $zone );
Runs the L<Syntax01 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Syntax-TP/syntax01.md>.
Takes either a string (name), a L<Zonemaster::Engine::DNSName> object or a L<Zonemaster::Engine::Zone> object.
Takes a L<Zonemaster::Engine::Zone> object.
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
Expand All @@ -678,10 +645,10 @@ Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
=cut

sub syntax01 {
my ( $class, $item ) = @_;
my ( $class, $zone ) = @_;
push my @results, info( TEST_CASE_START => { testcase => (split /::/, (caller(0))[3])[-1] } );

my $name = _get_name( $item );
my $name = $zone->name;

if ( _name_has_only_legal_characters( $name ) ) {
push @results,
Expand All @@ -707,11 +674,11 @@ sub syntax01 {
=item syntax02()
my @logentry_array = syntax02( $item );
my @logentry_array = syntax02( $zone );
Runs the L<Syntax02 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Syntax-TP/syntax02.md>.
Takes either a string (name), a L<Zonemaster::Engine::DNSName> object or a L<Zonemaster::Engine::Zone> object.
Takes a L<Zonemaster::Engine::Zone> object.
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
Expand All @@ -720,10 +687,10 @@ Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
=cut

sub syntax02 {
my ( $class, $item ) = @_;
my ( $class, $zone ) = @_;
push my @results, info( TEST_CASE_START => { testcase => (split /::/, (caller(0))[3])[-1] } );

my $name = _get_name( $item );
my $name = $zone->name;

foreach my $local_label ( @{ $name->labels } ) {
if ( _label_starts_with_hyphen( $local_label ) ) {
Expand Down Expand Up @@ -762,11 +729,11 @@ sub syntax02 {
=item syntax03()
my @logentry_array = syntax03( $item );
my @logentry_array = syntax03( $zone );
Runs the L<Syntax03 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Syntax-TP/syntax03.md>.
Takes either a string (name), a L<Zonemaster::Engine::DNSName> object or a L<Zonemaster::Engine::Zone> object.
Takes a L<Zonemaster::Engine::Zone> object.
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
Expand All @@ -775,10 +742,10 @@ Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
=cut

sub syntax03 {
my ( $class, $item ) = @_;
my ( $class, $zone ) = @_;
push my @results, info( TEST_CASE_START => { testcase => (split /::/, (caller(0))[3])[-1] } );

my $name = _get_name( $item );
my $name = $zone->name;

foreach my $local_label ( @{ $name->labels } ) {
if ( _label_not_ace_has_double_hyphen_in_position_3_and_4( $local_label ) ) {
Expand Down Expand Up @@ -808,11 +775,11 @@ sub syntax03 {
=item syntax04()
my @logentry_array = syntax04( $item );
my @logentry_array = syntax04( $zone );
Runs the L<Syntax04 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Syntax-TP/syntax01.md>.
Runs the L<Syntax04 Test Case|https://github.com/zonemaster/zonemaster/blob/master/docs/public/specifications/tests/Syntax-TP/syntax04.md>.
Takes either a string (name), a L<Zonemaster::Engine::DNSName> object or a L<Zonemaster::Engine::Zone> object.
Takes a L<Zonemaster::Engine::Zone> object.
Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
Expand All @@ -821,10 +788,10 @@ Returns a list of L<Zonemaster::Engine::Logger::Entry> objects.
=cut

sub syntax04 {
my ( $class, $item ) = @_;
my ( $class, $zone ) = @_;
push my @results, info( TEST_CASE_START => { testcase => (split /::/, (caller(0))[3])[-1] } );

my $name = _get_name( $item );
my $name = $zone->name;

push @results, _check_name_syntax( q{NAMESERVER}, $name );

Expand Down Expand Up @@ -1100,7 +1067,7 @@ sub syntax08 {
push @results, info( NO_RESPONSE_MX_QUERY => {} );
}

return @results;
return ( @results, info( TEST_CASE_END => { testcase => (split /::/, (caller(0))[3])[-1] } ) );
}

1;
84 changes: 35 additions & 49 deletions t/Test-syntax.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,20 +11,6 @@ BEGIN {
use_ok( q{Zonemaster::Engine::Test::Syntax} );
}

sub name_gives {
my ( $test, $name, $gives ) = @_;

my @res = Zonemaster::Engine->test_method( q{Syntax}, $test, $name );
ok( ( grep { $_->tag eq $gives } @res ), "$name gives $gives" );
}

sub name_gives_not {
my ( $test, $name, $gives ) = @_;

my @res = Zonemaster::Engine->test_method( q{Syntax}, $test, $name );
ok( !( grep { $_->tag eq $gives } @res ), "$name does not give $gives" );
}

sub zone_gives {
my ( $test, $zone, $gives ) = @_;

Expand Down Expand Up @@ -67,41 +53,41 @@ $json = read_file( 't/profiles/Test-syntax-all.json' );
$profile_test = Zonemaster::Engine::Profile->from_json( $json );
Zonemaster::Engine::Profile->effective->merge( $profile_test );

my $ns_ok = Zonemaster::Engine::DNSName->new( q{ns1.nic.fr} );
my $dn_ok = Zonemaster::Engine::DNSName->new( q{www.nic.se} );
my $dn_ko = Zonemaster::Engine::DNSName->new( q{www.nic&nac.se} );
name_gives( q{syntax01}, $dn_ok, q{ONLY_ALLOWED_CHARS} );
name_gives_not( q{syntax01}, $dn_ko, q{ONLY_ALLOWED_CHARS} );
name_gives( q{syntax01}, $dn_ko, q{NON_ALLOWED_CHARS} );
name_gives_not( q{syntax01}, $dn_ok, q{NON_ALLOWED_CHARS} );

$dn_ko = Zonemaster::Engine::DNSName->new( q{www.-nic.se} );
name_gives( q{syntax02}, $dn_ko, q{INITIAL_HYPHEN} );
name_gives_not( q{syntax02}, $dn_ko, q{NO_ENDING_HYPHENS} );
name_gives_not( q{syntax02}, $dn_ok, q{INITIAL_HYPHEN} );
name_gives( q{syntax02}, $dn_ok, q{NO_ENDING_HYPHENS} );

$dn_ko = Zonemaster::Engine::DNSName->new( q{www.nic-.se} );
name_gives( q{syntax02}, $dn_ko, q{TERMINAL_HYPHEN} );
name_gives_not( q{syntax02}, $dn_ko, q{NO_ENDING_HYPHENS} );
name_gives_not( q{syntax02}, $dn_ok, q{TERMINAL_HYPHEN} );

my $dn_idn_ok = Zonemaster::Engine::DNSName->new( q{www.xn--nic.se} );
$dn_ko = Zonemaster::Engine::DNSName->new( q{www.ni--c.se} );
name_gives( q{syntax03}, $dn_ko, q{DISCOURAGED_DOUBLE_DASH} );
name_gives_not( q{syntax03}, $dn_ko, q{NO_DOUBLE_DASH} );
name_gives_not( q{syntax03}, $dn_ok, q{DISCOURAGED_DOUBLE_DASH} );
name_gives_not( q{syntax03}, $dn_idn_ok, q{DISCOURAGED_DOUBLE_DASH} );
name_gives( q{syntax03}, $dn_ok, q{NO_DOUBLE_DASH} );
name_gives( q{syntax03}, $dn_idn_ok, q{NO_DOUBLE_DASH} );

my $ns_double_dash = Zonemaster::Engine::DNSName->new( q{ns1.ns--nic.fr} );
name_gives( q{syntax04}, $ns_double_dash, q{NAMESERVER_DISCOURAGED_DOUBLE_DASH} );
name_gives_not( q{syntax04}, $ns_ok, q{NAMESERVER_DISCOURAGED_DOUBLE_DASH} );

my $ns_num_tld = Zonemaster::Engine::DNSName->new( q{ns1.nic.47} );
name_gives( q{syntax04}, $ns_num_tld, q{NAMESERVER_NUMERIC_TLD} );
name_gives_not( q{syntax04}, $ns_ok, q{NAMESERVER_NUMERIC_TLD} );
my $ns_ok = Zonemaster::Engine->zone( q{ns1.nic.fr} );
my $dn_ok = Zonemaster::Engine->zone( q{www.nic.se} );
my $dn_ko = Zonemaster::Engine->zone( q{www.nic&nac.se} );
zone_gives( q{syntax01}, $dn_ok, q{ONLY_ALLOWED_CHARS} );
zone_gives_not( q{syntax01}, $dn_ko, q{ONLY_ALLOWED_CHARS} );
zone_gives( q{syntax01}, $dn_ko, q{NON_ALLOWED_CHARS} );
zone_gives_not( q{syntax01}, $dn_ok, q{NON_ALLOWED_CHARS} );

$dn_ko = Zonemaster::Engine->zone( q{www.-nic.se} );
zone_gives( q{syntax02}, $dn_ko, q{INITIAL_HYPHEN} );
zone_gives_not( q{syntax02}, $dn_ko, q{NO_ENDING_HYPHENS} );
zone_gives_not( q{syntax02}, $dn_ok, q{INITIAL_HYPHEN} );
zone_gives( q{syntax02}, $dn_ok, q{NO_ENDING_HYPHENS} );

$dn_ko = Zonemaster::Engine->zone( q{www.nic-.se} );
zone_gives( q{syntax02}, $dn_ko, q{TERMINAL_HYPHEN} );
zone_gives_not( q{syntax02}, $dn_ko, q{NO_ENDING_HYPHENS} );
zone_gives_not( q{syntax02}, $dn_ok, q{TERMINAL_HYPHEN} );

my $dn_idn_ok = Zonemaster::Engine->zone( q{www.xn--nic.se} );
$dn_ko = Zonemaster::Engine->zone( q{www.ni--c.se} );
zone_gives( q{syntax03}, $dn_ko, q{DISCOURAGED_DOUBLE_DASH} );
zone_gives_not( q{syntax03}, $dn_ko, q{NO_DOUBLE_DASH} );
zone_gives_not( q{syntax03}, $dn_ok, q{DISCOURAGED_DOUBLE_DASH} );
zone_gives_not( q{syntax03}, $dn_idn_ok, q{DISCOURAGED_DOUBLE_DASH} );
zone_gives( q{syntax03}, $dn_ok, q{NO_DOUBLE_DASH} );
zone_gives( q{syntax03}, $dn_idn_ok, q{NO_DOUBLE_DASH} );

my $ns_double_dash = Zonemaster::Engine->zone( q{ns1.ns--nic.fr} );
zone_gives( q{syntax04}, $ns_double_dash, q{NAMESERVER_DISCOURAGED_DOUBLE_DASH} );
zone_gives_not( q{syntax04}, $ns_ok, q{NAMESERVER_DISCOURAGED_DOUBLE_DASH} );

my $ns_num_tld = Zonemaster::Engine->zone( q{ns1.nic.47} );
zone_gives( q{syntax04}, $ns_num_tld, q{NAMESERVER_NUMERIC_TLD} );
zone_gives_not( q{syntax04}, $ns_ok, q{NAMESERVER_NUMERIC_TLD} );

my %res;
my $zone;
Expand Down
2 changes: 1 addition & 1 deletion t/old-bugs.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ if ( not $ENV{ZONEMASTER_RECORD} ) {
Zonemaster::Engine::Profile->effective->set( q{no_network}, 1 );
}

my @res = Zonemaster::Engine->test_method( 'Syntax', 'syntax03', 'XN--MGBERP4A5D4AR' );
my @res = Zonemaster::Engine->test_method( 'Syntax', 'syntax03', Zonemaster::Engine->zone( 'XN--MGBERP4A5D4AR' ) );
is( $res[3]->tag, q{NO_DOUBLE_DASH}, 'No complaint for XN--MGBERP4A5D4AR' );

my $zft_zone = Zonemaster::Engine->zone( 'zft.rd.nic.fr' );
Expand Down

0 comments on commit 5fd6423

Please sign in to comment.