File Coverage

blib/lib/Test/JSV/Suite.pm
Criterion Covered Total %
statement 52 55 94.5
branch 8 10 80.0
condition 3 3 100.0
subroutine 13 14 92.8
pod 0 4 0.0
total 76 86 88.3


line stmt bran cond sub pod time code
1             package Test::JSV::Suite;
2              
3 41     41   557843 use strict;
  41         57  
  41         991  
4 41     41   130 use warnings;
  41         45  
  41         804  
5              
6 41     41   123 use Carp;
  41         42  
  41         2368  
7 41     41   146 use File::Basename;
  41         43  
  41         2201  
8 41     41   133 use File::Spec;
  41         40  
  41         680  
9 41     41   16762 use FindBin;
  41         31204  
  41         1564  
10 41     41   23061 use JSON;
  41         424094  
  41         145  
11 41     41   3938 use Test::More;
  41         43  
  41         239  
12              
13             sub run {
14 77     77 0 54426 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         840 skip_test_cases => {},
25             verbose => 0,
26             %opts
27             );
28              
29 77         340 my $self = bless \%opts => $class;
30 77         231 my $test_suite = $self->load_test_suite;
31              
32 77         180 for my $test_cases (@$test_suite) {
33 209         92614 $self->run_test_cases($test_cases, $opts{skip_test_cases});
34             }
35              
36 77         51533 done_testing;
37             }
38              
39             sub run_test_cases {
40 209     209 0 302 my ($self, $test_cases, $skip_test_cases) = @_;
41              
42 209         422 my ($desc, $schema, $tests) = @$test_cases{qw/description schema tests/};
43              
44             subtest $desc => sub {
45             SKIP: {
46 209     209   73704 for my $test_case (@$tests) {
  209         458  
47 722 100 100     121361 if (defined $test_case->{description} && exists $skip_test_cases->{$test_case->{description}}) {
48 2         9 skip $test_case->{description} => 1;
49             }
50 720         1303 $self->run_test_case($schema, $test_case);
51             }
52             }
53 209         1145 };
54             }
55              
56             sub run_test_case {
57 720     720 0 771 my ($self, $schema, $test_case) = @_;
58 720         1188 my ($desc, $data, $expect) = @$test_case{qw/description data valid/};
59              
60             is(
61 720 100       1593 $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 117 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       1150 $self->{suite} . ".json"
72             );
73              
74 77         310 note $test_suite_file;
75              
76 77 50       8183 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       2435 open(my $fh, "<", $test_suite_file) or croak $!;
81 77         118 my $test_suite = decode_json(do { local $/; <$fh> });
  77         260  
  77         3931  
82 77         1711 close $fh;
83 77         309 return $test_suite;
84             }
85              
86             1;