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   807047 use utf8;
  31         109  
  31         181  
2 31     31   809 use strict;
  31         47  
  31         550  
3 31     31   166 use warnings;
  31         42  
  31         1070  
4              
5 31     31   162 use feature 'state';
  31         40  
  31         2949  
6             package DR::Tnt::Test;
7 31     31   14050 use DR::Tnt::Test::TntInstance;
  31         91  
  31         1723  
8 31     31   212 use IO::Socket::INET;
  31         55  
  31         226  
9 31     31   14754 use Test::More;
  31         58  
  31         351  
10 31     31   14626 use base qw(Exporter);
  31         64  
  31         22731  
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 247 local $SIG{__WARN__} = sub { };
        30      
22 30 50       106220 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         3948 return undef;
28             }
29              
30              
31             sub tarantool_version_check($) {
32 29     29 0 109496 my ($version) = @_;
33 29   50     130 $version ||= '1.6';
34              
35 29         81 my $v = tarantool_version;
36              
37 29 50       771 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         257 my $tb = Test::More->builder;
  29         1417  
55 29         2005 my @passed = $tb->details;
56 29         16838 for (my $i = @passed; $i < $tb->expected_tests; $i++) {
57 1243         672724 $tb->skip("tarantool $version is not found");
58             }
59 29         107804 exit;
60             }
61              
62             }
63              
64              
65              
66             sub free_port() {
67 2     2 0 71 state $busy_ports = {};
68 2         2 while( 1 ) {
69 2         31 my $port = 10000 + int rand 30000;
70 2 50       8 next if exists $busy_ports->{ $port };
71 2 50       18 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         625 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;