line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Requires::Git; |
2
|
|
|
|
|
|
|
$Test::Requires::Git::VERSION = '1.006'; |
3
|
14
|
|
|
14
|
|
193142
|
use strict; |
|
14
|
|
|
|
|
20
|
|
|
14
|
|
|
|
|
336
|
|
4
|
14
|
|
|
14
|
|
44
|
use warnings; |
|
14
|
|
|
|
|
15
|
|
|
14
|
|
|
|
|
275
|
|
5
|
|
|
|
|
|
|
|
6
|
14
|
|
|
14
|
|
40
|
use Carp; |
|
14
|
|
|
|
|
16
|
|
|
14
|
|
|
|
|
865
|
|
7
|
14
|
|
|
14
|
|
6322
|
use Git::Version::Compare (); |
|
14
|
|
|
|
|
191897
|
|
|
14
|
|
|
|
|
348
|
|
8
|
|
|
|
|
|
|
|
9
|
14
|
|
|
14
|
|
85
|
use base 'Test::Builder::Module'; |
|
14
|
|
|
|
|
17
|
|
|
14
|
|
|
|
|
2225
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $GIT = 'git'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my %check = ( |
14
|
|
|
|
|
|
|
version_eq => \&Git::Version::Compare::eq_git, |
15
|
|
|
|
|
|
|
version_ne => \&Git::Version::Compare::ne_git, |
16
|
|
|
|
|
|
|
version_gt => \&Git::Version::Compare::gt_git, |
17
|
|
|
|
|
|
|
version_le => \&Git::Version::Compare::le_git, |
18
|
|
|
|
|
|
|
version_lt => \&Git::Version::Compare::lt_git, |
19
|
|
|
|
|
|
|
version_ge => \&Git::Version::Compare::ge_git, |
20
|
|
|
|
|
|
|
); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# aliases |
23
|
|
|
|
|
|
|
$check{'=='} = $check{eq} = $check{version} = $check{version_eq}; |
24
|
|
|
|
|
|
|
$check{'!='} = $check{ne} = $check{version_ne}; |
25
|
|
|
|
|
|
|
$check{'>'} = $check{gt} = $check{version_gt}; |
26
|
|
|
|
|
|
|
$check{'<='} = $check{le} = $check{version_le}; |
27
|
|
|
|
|
|
|
$check{'<'} = $check{lt} = $check{version_lt}; |
28
|
|
|
|
|
|
|
$check{'>='} = $check{ge} = $check{version_ge}; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub import { |
31
|
15
|
|
|
15
|
|
3290
|
my $class = shift; |
32
|
15
|
|
|
|
|
25
|
my $caller = caller(0); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# export methods |
35
|
|
|
|
|
|
|
{ |
36
|
14
|
|
|
14
|
|
68
|
no strict 'refs'; |
|
14
|
|
|
|
|
18
|
|
|
14
|
|
|
|
|
4298
|
|
|
15
|
|
|
|
|
16
|
|
37
|
15
|
|
|
|
|
23
|
*{"$caller\::test_requires_git"} = \&test_requires_git; |
|
15
|
|
|
|
|
1621
|
|
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
15
|
100
|
100
|
|
|
8915
|
return if @_ == 1 && $_[0] eq '-nocheck'; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# reset the global $GIT value |
43
|
10
|
|
|
|
|
714
|
my $args = _extract_arguments(@_); |
44
|
10
|
100
|
|
|
|
25
|
$GIT = $args->{git} if exists $args->{git}; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# test arguments |
47
|
10
|
|
|
|
|
21
|
test_requires_git(@_); |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub _extract_arguments { |
51
|
296
|
|
|
296
|
|
1339
|
my (@args) = @_; |
52
|
|
|
|
|
|
|
|
53
|
296
|
|
|
|
|
878
|
my ( %args, @spec ); |
54
|
296
|
|
|
|
|
1545
|
while (@args) { |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# assume a lone parameter is a minimum git version |
57
|
538
|
100
|
|
|
|
951
|
unshift @args, 'version_ge' if @args == 1; |
58
|
|
|
|
|
|
|
|
59
|
538
|
|
|
|
|
750
|
my ( $key, $val ) = splice @args, 0, 2; |
60
|
538
|
100
|
|
|
|
1729
|
if ( $key =~ /^(?:git|skip)/ ) { |
|
|
100
|
|
|
|
|
|
61
|
258
|
100
|
|
|
|
486
|
croak "Duplicate '$key' argument" if exists $args{$key}; |
62
|
257
|
|
|
|
|
760
|
$args{$key} = $val; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
elsif ( !exists $check{$key} ) { |
65
|
2
|
100
|
|
|
|
28
|
if ( @args % 2 ) { # odd number of arguments (see above) |
66
|
1
|
|
|
|
|
3
|
unshift @args, version_ge => $key, $val; |
67
|
1
|
|
|
|
|
1
|
redo; |
68
|
|
|
|
|
|
|
} |
69
|
1
|
|
|
|
|
104
|
croak "Unknown git specification '$key'"; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
else { |
72
|
278
|
|
|
|
|
675
|
push @spec, $key, $val; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
294
|
100
|
|
|
|
1635
|
return wantarray ? ( \%args, @spec ) : \%args; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
5
|
|
|
5
|
|
9325
|
sub _git_version { qx{$GIT --version} } |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub test_requires_git { |
81
|
286
|
|
|
286
|
1
|
51775
|
my ( $args, @spec ) = _extract_arguments(@_); |
82
|
284
|
|
|
|
|
388
|
my $skip = $args->{skip}; |
83
|
284
|
100
|
|
|
|
437
|
local $GIT = $args->{git} if exists $args->{git}; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# get the git version |
86
|
284
|
|
|
|
|
232
|
my ($version) = do { |
87
|
14
|
|
|
14
|
|
66
|
no warnings 'uninitialized'; |
|
14
|
|
|
|
|
21
|
|
|
14
|
|
|
|
|
2291
|
|
88
|
284
|
|
|
|
|
673
|
__PACKAGE__->_git_version(); # tests may override this |
89
|
|
|
|
|
|
|
}; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# perform the check |
92
|
284
|
|
|
|
|
1144
|
my ( $ok, $why ) = ( 1, '' ); |
93
|
284
|
100
|
100
|
|
|
951
|
if ( defined $version && Git::Version::Compare::looks_like_git($version) ) { |
94
|
279
|
|
|
|
|
3051
|
while ( my ( $spec, $arg ) = splice @spec, 0, 2 ) { |
95
|
274
|
100
|
|
|
|
7031
|
if ( !$check{$spec}->( $version, $arg ) ) { |
96
|
150
|
|
|
|
|
1903
|
$ok = 0; |
97
|
150
|
|
|
|
|
797
|
$version =~ s/^git version|[\012\015]+$//g; |
98
|
150
|
|
|
|
|
327
|
$why = "$version $spec $arg"; |
99
|
150
|
|
|
|
|
236
|
last; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
else { |
104
|
5
|
|
|
|
|
66
|
$ok = 0; |
105
|
5
|
|
|
|
|
66
|
$why = "`$GIT` binary not available or broken"; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# skip if needed |
109
|
282
|
100
|
|
|
|
12648
|
if ( !$ok ) { |
110
|
155
|
|
|
|
|
523
|
my $builder = __PACKAGE__->builder; |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# skip a specified number of tests |
113
|
155
|
100
|
|
|
|
1222
|
if ( $skip ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
114
|
146
|
|
|
|
|
498
|
$builder->skip($why) for 1 .. $skip; |
115
|
14
|
|
|
14
|
|
68
|
no warnings 'exiting'; |
|
14
|
|
|
|
|
17
|
|
|
14
|
|
|
|
|
2471
|
|
116
|
146
|
|
|
|
|
16374
|
last SKIP; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# no plan declared yet |
120
|
|
|
|
|
|
|
elsif ( !defined $builder->has_plan ) { |
121
|
3
|
100
|
|
|
|
38
|
if ( $builder->summary ) { |
122
|
1
|
|
|
|
|
11
|
$builder->skip($why); |
123
|
1
|
|
|
|
|
230
|
$builder->done_testing; |
124
|
1
|
|
|
|
|
209
|
exit 0; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
else { |
127
|
2
|
|
|
|
|
26
|
$builder->skip_all($why); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# the plan is no_plan |
132
|
|
|
|
|
|
|
elsif ( $builder->has_plan eq 'no_plan' ) { |
133
|
1
|
|
|
|
|
13
|
$builder->skip($why); |
134
|
1
|
|
|
|
|
434
|
exit 0; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# some plan was declared, skip all tests one by one |
138
|
|
|
|
|
|
|
else { |
139
|
5
|
|
|
|
|
78
|
$builder->skip($why) for 1 + $builder->summary .. $builder->has_plan; |
140
|
5
|
|
|
|
|
1921
|
exit 0; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
'git'; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
__END__ |