| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Test::JSV::Suite; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 41 |  |  | 41 |  | 971773 | use strict; | 
|  | 41 |  |  |  |  | 107 |  | 
|  | 41 |  |  |  |  | 1235 |  | 
| 4 | 41 |  |  | 41 |  | 222 | use warnings; | 
|  | 41 |  |  |  |  | 88 |  | 
|  | 41 |  |  |  |  | 1382 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 41 |  |  | 41 |  | 256 | use Carp; | 
|  | 41 |  |  |  |  | 86 |  | 
|  | 41 |  |  |  |  | 3549 |  | 
| 7 | 41 |  |  | 41 |  | 246 | use File::Basename; | 
|  | 41 |  |  |  |  | 81 |  | 
|  | 41 |  |  |  |  | 3781 |  | 
| 8 | 41 |  |  | 41 |  | 228 | use File::Spec; | 
|  | 41 |  |  |  |  | 84 |  | 
|  | 41 |  |  |  |  | 1012 |  | 
| 9 | 41 |  |  | 41 |  | 35050 | use FindBin; | 
|  | 41 |  |  |  |  | 52860 |  | 
|  | 41 |  |  |  |  | 2237 |  | 
| 10 | 41 |  |  | 41 |  | 46290 | use JSON; | 
|  | 41 |  |  |  |  | 737541 |  | 
|  | 41 |  |  |  |  | 221 |  | 
| 11 | 41 |  |  | 41 |  | 6359 | use Test::More; | 
|  | 41 |  |  |  |  | 73 |  | 
|  | 41 |  |  |  |  | 428 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | sub run { | 
| 14 | 77 |  |  | 77 | 0 | 84886 | my ($class, %opts) = @_; | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | %opts = ( | 
| 17 |  |  |  |  |  |  | base_dir  => $opts{base_dir}, | 
| 18 |  |  |  |  |  |  | version   => "", | 
| 19 |  |  |  |  |  |  | suite     => "type", | 
| 20 |  |  |  |  |  |  | cb        => sub { | 
| 21 | 0 |  |  | 0 |  | 0 | my ($schema, $instance, $expect) = @_; | 
| 22 | 0 |  |  |  |  | 0 | return 1; | 
| 23 |  |  |  |  |  |  | }, | 
| 24 | 77 |  |  |  |  | 1241 | skip_test_cases => {}, | 
| 25 |  |  |  |  |  |  | verbose   => 0, | 
| 26 |  |  |  |  |  |  | %opts | 
| 27 |  |  |  |  |  |  | ); | 
| 28 |  |  |  |  |  |  |  | 
| 29 | 77 |  |  |  |  | 552 | my $self = bless \%opts => $class; | 
| 30 | 77 |  |  |  |  | 363 | my $test_suite = $self->load_test_suite; | 
| 31 |  |  |  |  |  |  |  | 
| 32 | 77 |  |  |  |  | 370 | for my $test_cases (@$test_suite) { | 
| 33 | 209 |  |  |  |  | 148895 | $self->run_test_cases($test_cases, $opts{skip_test_cases}); | 
| 34 |  |  |  |  |  |  | } | 
| 35 |  |  |  |  |  |  |  | 
| 36 | 77 |  |  |  |  | 85186 | done_testing; | 
| 37 |  |  |  |  |  |  | } | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | sub run_test_cases { | 
| 40 | 209 |  |  | 209 | 0 | 575 | my ($self, $test_cases, $skip_test_cases) = @_; | 
| 41 |  |  |  |  |  |  |  | 
| 42 | 209 |  |  |  |  | 822 | my ($desc, $schema, $tests) = @$test_cases{qw/description schema tests/}; | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | subtest $desc => sub { | 
| 45 |  |  |  |  |  |  | SKIP: { | 
| 46 | 209 |  |  | 209 |  | 139004 | for my $test_case (@$tests) { | 
|  | 209 |  |  |  |  | 655 |  | 
| 47 | 722 | 100 | 100 |  |  | 205117 | if (defined $test_case->{description} && exists $skip_test_cases->{$test_case->{description}}) { | 
| 48 | 2 |  |  |  |  | 10 | skip $test_case->{description} => 1; | 
| 49 |  |  |  |  |  |  | } | 
| 50 | 720 |  |  |  |  | 2218 | $self->run_test_case($schema, $test_case); | 
| 51 |  |  |  |  |  |  | } | 
| 52 |  |  |  |  |  |  | } | 
| 53 | 209 |  |  |  |  | 1983 | }; | 
| 54 |  |  |  |  |  |  | } | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | sub run_test_case { | 
| 57 | 720 |  |  | 720 | 0 | 1376 | my ($self, $schema, $test_case) = @_; | 
| 58 | 720 |  |  |  |  | 1998 | my ($desc, $data, $expect) = @$test_case{qw/description data valid/}; | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | is( | 
| 61 | 720 | 100 |  |  |  | 2685 | $self->{cb}->($schema, $data, $expect, $test_case), | 
| 62 |  |  |  |  |  |  | $expect ? 1 : 0, | 
| 63 |  |  |  |  |  |  | $desc, | 
| 64 |  |  |  |  |  |  | ); | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | sub load_test_suite { | 
| 68 | 77 |  |  | 77 | 0 | 178 | my $self = shift; | 
| 69 |  |  |  |  |  |  | my $test_suite_file = File::Spec->catfile( | 
| 70 |  |  |  |  |  |  | $self->{version} ? ( $self->{base_dir}, $self->{version} ) : ( $self->{base_dir} ), | 
| 71 | 77 | 100 |  |  |  | 1599 | $self->{suite} . ".json" | 
| 72 |  |  |  |  |  |  | ); | 
| 73 |  |  |  |  |  |  |  | 
| 74 | 77 |  |  |  |  | 567 | note $test_suite_file; | 
| 75 |  |  |  |  |  |  |  | 
| 76 | 77 | 50 |  |  |  | 11256 | unless (-f $test_suite_file) { | 
| 77 | 0 |  |  |  |  | 0 | croak sprintf("Not exists test suite (base_dir: %s, version: %s, suite: %s)", @$self{qw/base_dir version suite/}); | 
| 78 |  |  |  |  |  |  | } | 
| 79 |  |  |  |  |  |  |  | 
| 80 | 77 | 50 |  |  |  | 3775 | open(my $fh, "<", $test_suite_file) or croak $!; | 
| 81 | 77 |  |  |  |  | 174 | my $test_suite = decode_json(do { local $/; <$fh> }); | 
|  | 77 |  |  |  |  | 371 |  | 
|  | 77 |  |  |  |  | 13620037 |  | 
| 82 | 77 |  |  |  |  | 2576 | close $fh; | 
| 83 | 77 |  |  |  |  | 643 | return $test_suite; | 
| 84 |  |  |  |  |  |  | } | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | 1; |