Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Cleanup in Syntax test module #1293

Merged
merged 1 commit into from
Oct 10, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
87 changes: 27 additions & 60 deletions lib/Zonemaster/Engine/Test/Syntax.pm
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
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
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
Loading