From e28fa28983a967ea9ee93e91157df5c85f016913 Mon Sep 17 00:00:00 2001 From: "[Thomas Green]" Date: Tue, 19 Sep 2023 16:40:40 +0200 Subject: [PATCH] Cleanup in Syntax test module - Remove internal helper function '_get_name()' - Correct return value in Syntax08 - Correct POD typo in link for Syntax04 --- lib/Zonemaster/Engine/Test/Syntax.pm | 87 +++++++++------------------- t/Test-syntax.t | 84 +++++++++++---------------- t/old-bugs.t | 2 +- 3 files changed, 63 insertions(+), 110 deletions(-) diff --git a/lib/Zonemaster/Engine/Test/Syntax.pm b/lib/Zonemaster/Engine/Test/Syntax.pm index 66e2f5d28..cb74e0fa8 100644 --- a/lib/Zonemaster/Engine/Test/Syntax.pm +++ b/lib/Zonemaster/Engine/Test/Syntax.pm @@ -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} ); } @@ -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 object. Used as an helper function for Test Cases L to L. - -Takes a string (name), or a L object, or a L object. - -Returns a L 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 and L. Used as an helper function for Test Cases L, L and L. -Takes a string (label prefix) and either a string (name), a L object, or a L object. +Takes a string (label prefix) and either a string (name) or a L object. -Returns a list of L objects. +Returns a list of L objects. =back @@ -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, @@ -665,11 +632,11 @@ sub _check_name_syntax { =item syntax01() - my @logentry_array = syntax01( $item ); + my @logentry_array = syntax01( $zone ); Runs the L. -Takes either a string (name), a L object or a L object. +Takes a L object. Returns a list of L objects. @@ -678,10 +645,10 @@ Returns a list of L 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, @@ -707,11 +674,11 @@ sub syntax01 { =item syntax02() - my @logentry_array = syntax02( $item ); + my @logentry_array = syntax02( $zone ); Runs the L. -Takes either a string (name), a L object or a L object. +Takes a L object. Returns a list of L objects. @@ -720,10 +687,10 @@ Returns a list of L 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 ) ) { @@ -762,11 +729,11 @@ sub syntax02 { =item syntax03() - my @logentry_array = syntax03( $item ); + my @logentry_array = syntax03( $zone ); Runs the L. -Takes either a string (name), a L object or a L object. +Takes a L object. Returns a list of L objects. @@ -775,10 +742,10 @@ Returns a list of L 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 ) ) { @@ -808,11 +775,11 @@ sub syntax03 { =item syntax04() - my @logentry_array = syntax04( $item ); + my @logentry_array = syntax04( $zone ); -Runs the L. +Runs the L. -Takes either a string (name), a L object or a L object. +Takes a L object. Returns a list of L objects. @@ -821,10 +788,10 @@ Returns a list of L 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 ); @@ -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; diff --git a/t/Test-syntax.t b/t/Test-syntax.t index 9a1fe2f9c..f2b2dd93d 100644 --- a/t/Test-syntax.t +++ b/t/Test-syntax.t @@ -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 ) = @_; @@ -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; diff --git a/t/old-bugs.t b/t/old-bugs.t index 8ea347dde..c9c7d584e 100644 --- a/t/old-bugs.t +++ b/t/old-bugs.t @@ -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' );