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   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;