Added support for official tests

package-url/purl-spec#514

Author: giterlizzi

MANIFEST

@@ -14,7 +14,7 @@ lib/URI/VersionRange/Constraint.pm
 lib/URI/VersionRange/Version.pm
 LICENSE
 Makefile.PL
-MANIFEST			This list of files
+MANIFEST
 README.md
 t/00-load.t
 t/10-encode.t
@@ -24,8 +24,11 @@ t/40-cli.t
 t/50-version-range.t
 t/90-cpan-distname-info.t
 t/99-official-purl-test-suite.t
+t/99-official-purl-tests.t
 t/manifest.t
+t/official-tests/specification-test.json
 t/pod-coverage.t
 t/pod.t
 t/sync-purl-test-suite-data.sh
+t/sync-purl-tests.sh
 t/test-suite-data.json

lib/URI/PackageURL.pm

@@ -13,7 +13,7 @@ use constant DEBUG => $ENV{PURL_DEBUG};
 
 use overload '""' => 'to_string', fallback => 1;
 
-our $VERSION = '2.23';
+our $VERSION = '2.23_1';
 our @EXPORT  = qw(encode_purl decode_purl);
 
 my $PURL_REGEXP = qr{^pkg:[A-Za-z\\.\\-\\+][A-Za-z0-9\\.\\-\\+]*/.+};

lib/URI/PackageURL/App.pm

@@ -13,7 +13,7 @@ use Data::Dumper ();
 
 use URI::PackageURL ();
 
-our $VERSION = '2.23';
+our $VERSION = '2.23_1';
 
 sub cli_error {
     my ($error) = @_;

lib/URI/PackageURL/Util.pm

@@ -7,7 +7,7 @@ use warnings;
 
 use Exporter qw(import);
 
-our $VERSION = '2.23';
+our $VERSION = '2.23_1';
 our @EXPORT  = qw(purl_to_urls purl_components_normalize);
 
 sub purl_components_normalize {

lib/URI/VersionRange.pm

@@ -18,7 +18,7 @@ use constant FALSE => !!0;
 
 use overload '""' => 'to_string', fallback => 1;
 
-our $VERSION = '2.23';
+our $VERSION = '2.23_1';
 our @EXPORT  = qw(encode_vers decode_vers);
 
 my $VERS_REGEXP = qr{^vers:[a-z\\.\\-\\+][a-z0-9\\.\\-\\+]*/.+};

lib/URI/VersionRange/App.pm

@@ -13,7 +13,7 @@ use Data::Dumper ();
 
 use URI::VersionRange ();
 
-our $VERSION = '2.23';
+our $VERSION = '2.23_1';
 
 sub cli_error {
     my ($error) = @_;

lib/URI/VersionRange/Constraint.pm

@@ -12,7 +12,7 @@ use overload '""' => 'to_string', fallback => 1;
 
 use URI::VersionRange::Version;
 
-our $VERSION = '2.23';
+our $VERSION = '2.23_1';
 
 our %COMPARATOR = (
     '='  => 'equal',

t/99-official-purl-tests.t

@@ -0,0 +1,134 @@
+#!perl
+
+use JSON::PP;
+use Test::More;
+use File::Spec;
+
+require_ok('URI::PackageURL');
+
+my $purl_tests_dir = File::Spec->catdir('t', 'official-tests');
+
+BAIL_OUT('"official-tests" directory not found') if (!-d $purl_tests_dir);
+
+opendir(my $dh, $purl_tests_dir) or Carp::croak "Can't open directory: $!";
+
+while (my $file = readdir $dh) {
+
+    next if ($file eq '.' or $file eq '..');
+    next unless ($file =~ /(specification|cpan)/);
+
+    my $test_file = File::Spec->catfile('t', 'official-tests', $file);
+
+    subtest $test_file => sub {
+        execute_test($test_file);
+    }
+
+}
+
+closedir $dh;
+
+sub execute_test {
+
+    my $test_file = shift;
+
+    open my $fh, '<', $test_file or Carp::croak "Can't open file: $!";
+
+    my $test_content = do { local $/; <$fh> };
+    my $test_data    = JSON::PP::decode_json($test_content);
+
+    foreach my $test (@{$test_data->{tests}}) {
+
+        diag $test->{description};
+
+    TODO: {
+            execute_parse_test($test)     if $test->{test_type} eq 'parse';
+            execute_build_test($test)     if $test->{test_type} eq 'build';
+            execute_roundtrip_test($test) if $test->{test_type} eq 'roundtrip';
+        }
+
+    }
+
+}
+
+sub execute_build_test {
+
+    my $test = shift;
+
+    my $test_description = $test->{description};
+
+    my $purl = eval { URI::PackageURL->new(%{$test->{input}}); };
+
+    local $TODO = 'DUBIOUS MAVEN TEST' if $test_description =~ /invalid encoded colon : between scheme and type/i;
+    local $TODO = 'DUBIOUS CONAN TEST' if $@ =~ /Conan 'channel' qualifier does not exist for namespace/i;
+
+    if ($test->{expected_failure}) {
+        like($@, qr/Invalid Package URL/i, "ENCODE: $test_description");
+        return;
+    }
+
+    if (!$test->{expected_failure} && $@) {
+        fail("DECODE: $test_description ($@)");
+        return;
+    }
+
+    is($purl->to_string, $test->{expected_output}, "ENCODE: $test_description");
+
+}
+
+sub execute_parse_test {
+
+    my $test = shift;
+
+    my $test_description = $test->{description};
+    my $purl_string      = $test->{input};
+
+    diag $purl_string;
+
+    my $purl = eval { URI::PackageURL->from_string($purl_string) };
+
+    local $TODO = 'DUBIOUS NPM TEST'   if $purl_string =~ /pkg\:npm\/@/;
+    local $TODO = 'DUBIOUS CONAN TEST' if $@           =~ /Conan 'channel' qualifier does not exist for namespace/i;
+
+    if ($test->{expected_failure}) {
+        like($@, qr/(Invalid|Malformed) Package URL/i, "DECODE $purl_string: $test_description");
+        return;
+    }
+
+    if (!$test->{expected_failure} && $@) {
+        fail("DECODE: $test_description ($@)");
+        return;
+    }
+
+    my @components = qw(type namespace name version subpath);
+
+    foreach my $component (@components) {
+        is(
+            $purl->$component,
+            $test->{expected_output}->{$component},
+            "DECODE: Compare '$test_description' $component component"
+        );
+    }
+
+}
+
+sub execute_roundtrip_test {
+
+    my $test = shift;
+
+    my $test_description = $test->{description};
+    my $purl_string      = $test->{input};
+
+    diag $purl_string;
+
+    my $purl = eval { URI::PackageURL->from_string($purl_string) };
+
+    if ($@) {
+        fail("DECODE: $test_description ($@)");
+        return;
+    }
+
+    is($purl->to_string, $test->{expected_output}, "ENCODE: $test_description");
+
+}
+
+done_testing();