File Coverage

lib/DR/Tnt/Test.pm
Criterion Covered Total %
statement 43 58 74.1
branch 5 20 25.0
condition 1 2 50.0
subroutine 11 13 84.6
pod 0 4 0.0
total 60 97 61.8


line stmt bran cond sub pod time code
1 31     31   527204 use utf8;
  31         104  
  31         164  
2 31     31   753 use strict;
  31         43  
  31         468  
3 31     31   165 use warnings;
  31         40  
  31         752  
4              
5 31     31   161 use feature 'state';
  31         41  
  31         2809  
6             package DR::Tnt::Test;
7 31     31   8983 use DR::Tnt::Test::TntInstance;
  31         84  
  31         881  
8 31     31   184 use IO::Socket::INET;
  31         48  
  31         193  
9 31     31   11165 use Test::More;
  31         58  
  31         336  
10 31     31   7526 use base qw(Exporter);
  31         56  
  31         19014  
11             our @EXPORT = qw(
12             free_port
13             tarantool_version
14             tarantool_version_check
15             start_tarantool
16             );
17              
18              
19             sub tarantool_version() {
20              
21 30     0 0 224 local $SIG{__WARN__} = sub { };
        30      
22 30 50       69084 if (open my $fh, '-|', 'tarantool', '-V') {
23 0         0 my $v = <$fh>;
24 0 0       0 return undef unless $v =~ /^Tarantool\s+(\S+)/;
25 0         0 return $1;
26             }
27 30         2506 return undef;
28             }
29              
30              
31             sub tarantool_version_check($) {
32 29     29 0 93230 my ($version) = @_;
33 29   50     106 $version ||= '1.6';
34              
35 29         65 my $v = tarantool_version;
36              
37 29 50       422 goto FAIL unless $v;
38 0         0 my @p = split /\./, $version;
39 0         0 $v =~ s/-.*//;
40 0         0 my @v = split /\./, $v;
41              
42 0         0 for (my $i = 0; $i < @p; $i++) {
43 0 0       0 last unless $i < @v;
44 0 0       0 goto OK if $v[$i] > $p[$i];
45 0 0       0 goto FAIL unless $v[$i] >= $p[$i];
46             }
47              
48 0 0       0 goto FAIL unless @v >= @p;
49              
50 0         0 OK:
51             return;
52              
53             FAIL: {
54 29         252 my $tb = Test::More->builder;
  29         1040  
55 29         1335 my @passed = $tb->details;
56 29         11915 for (my $i = @passed; $i < $tb->expected_tests; $i++) {
57 1243         486429 $tb->skip("tarantool $version is not found");
58             }
59 29         64348 exit;
60             }
61              
62             }
63              
64              
65              
66             sub free_port() {
67 2     2 0 61 state $busy_ports = {};
68 2         4 while( 1 ) {
69 2         28 my $port = 10000 + int rand 30000;
70 2 50       8 next if exists $busy_ports->{ $port };
71 2 50       21 next unless IO::Socket::INET->new(
    50          
72             Listen => 5,
73             LocalAddr => '127.0.0.1',
74             LocalPort => $port,
75             Proto => 'tcp',
76             (($^O eq 'MSWin32') ? () : (ReuseAddr => 1)),
77             );
78 2         722 return $busy_ports->{ $port } = $port;
79             }
80             }
81              
82             sub start_tarantool {
83 0     0 0   my %opts = @_;
84 0           $opts{-port} = free_port;
85 0           DR::Tnt::Test::TntInstance->new(%opts);
86             }
87              
88             1;