line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Requires::Git; |
2
|
|
|
|
|
|
|
$Test::Requires::Git::VERSION = '1.007'; |
3
|
14
|
|
|
14
|
|
200812
|
use strict; |
|
14
|
|
|
|
|
22
|
|
|
14
|
|
|
|
|
331
|
|
4
|
14
|
|
|
14
|
|
61
|
use warnings; |
|
14
|
|
|
|
|
18
|
|
|
14
|
|
|
|
|
323
|
|
5
|
|
|
|
|
|
|
|
6
|
14
|
|
|
14
|
|
52
|
use Carp; |
|
14
|
|
|
|
|
17
|
|
|
14
|
|
|
|
|
1021
|
|
7
|
14
|
|
|
14
|
|
6356
|
use Git::Version::Compare (); |
|
14
|
|
|
|
|
18169
|
|
|
14
|
|
|
|
|
408
|
|
8
|
|
|
|
|
|
|
|
9
|
14
|
|
|
14
|
|
66
|
use base 'Test::Builder::Module'; |
|
14
|
|
|
|
|
19
|
|
|
14
|
|
|
|
|
3021
|
|
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
|
|
|
|
|
|
|
my $quiet = 0; |
31
|
|
|
|
|
|
|
my $lock = '.test.requires.git.lock'; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub import { |
34
|
15
|
|
|
15
|
|
3327
|
my $class = shift; |
35
|
15
|
|
|
|
|
31
|
my $caller = caller(0); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# export methods |
38
|
|
|
|
|
|
|
{ |
39
|
14
|
|
|
14
|
|
65
|
no strict 'refs'; |
|
14
|
|
|
|
|
18
|
|
|
14
|
|
|
|
|
4837
|
|
|
15
|
|
|
|
|
17
|
|
40
|
15
|
|
|
|
|
21
|
*{"$caller\::test_requires_git"} = \&test_requires_git; |
|
15
|
|
|
|
|
73
|
|
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
15
|
100
|
100
|
|
|
5918
|
return if @_ == 1 && $_[0] eq '-nocheck'; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# reset the global $GIT value |
46
|
10
|
|
|
|
|
59
|
my $args = _extract_arguments(@_); |
47
|
10
|
100
|
|
|
|
27
|
$GIT = $args->{git} if exists $args->{git}; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# test arguments |
50
|
10
|
|
|
|
|
24
|
test_requires_git(@_); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub _extract_arguments { |
54
|
312
|
|
|
312
|
|
515
|
my (@args) = @_; |
55
|
|
|
|
|
|
|
|
56
|
312
|
|
|
|
|
256
|
my ( %args, @spec ); |
57
|
312
|
|
|
|
|
678
|
while (@args) { |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# assume a lone parameter is a minimum git version |
60
|
570
|
100
|
|
|
|
901
|
unshift @args, 'version_ge' if @args == 1; |
61
|
|
|
|
|
|
|
|
62
|
570
|
|
|
|
|
674
|
my ( $key, $val ) = splice @args, 0, 2; |
63
|
570
|
100
|
|
|
|
1673
|
if ( $key =~ /^(?:git|skip)/ ) { |
|
|
100
|
|
|
|
|
|
64
|
274
|
100
|
|
|
|
535
|
croak "Duplicate '$key' argument" if exists $args{$key}; |
65
|
273
|
|
|
|
|
733
|
$args{$key} = $val; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
elsif ( !exists $check{$key} ) { |
68
|
2
|
100
|
|
|
|
10
|
if ( @args % 2 ) { # odd number of arguments (see above) |
69
|
1
|
|
|
|
|
2
|
unshift @args, version_ge => $key, $val; |
70
|
1
|
|
|
|
|
2
|
redo; |
71
|
|
|
|
|
|
|
} |
72
|
1
|
|
|
|
|
168
|
croak "Unknown git specification '$key'"; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
else { |
75
|
294
|
|
|
|
|
626
|
push @spec, $key, $val; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
} |
78
|
310
|
100
|
|
|
|
940
|
return wantarray ? ( \%args, @spec ) : \%args; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
5
|
|
|
5
|
|
10166
|
sub _git_version { qx{$GIT --version} } |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub test_requires_git { |
84
|
302
|
|
|
302
|
1
|
75665
|
my ( $args, @spec ) = _extract_arguments(@_); |
85
|
300
|
|
|
|
|
400
|
my $skip = $args->{skip}; |
86
|
300
|
100
|
|
|
|
505
|
local $GIT = $args->{git} if exists $args->{git}; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# get the git version |
89
|
300
|
|
|
|
|
228
|
my ($version) = do { |
90
|
14
|
|
|
14
|
|
71
|
no warnings 'uninitialized'; |
|
14
|
|
|
|
|
24
|
|
|
14
|
|
|
|
|
3369
|
|
91
|
300
|
|
|
|
|
663
|
__PACKAGE__->_git_version(); # tests may override this |
92
|
|
|
|
|
|
|
}; |
93
|
|
|
|
|
|
|
|
94
|
300
|
|
|
|
|
1381
|
my $builder = __PACKAGE__->builder; |
95
|
300
|
100
|
100
|
|
|
6176
|
if ( !$quiet && time - ( ( stat $lock )[9] || 0 ) > 60 ) { |
|
|
|
100
|
|
|
|
|
96
|
1
|
|
|
|
|
39
|
$builder->diag($version); |
97
|
1
|
|
|
|
|
155
|
$quiet++; |
98
|
1
|
50
|
|
|
|
117
|
open my $fh, '>', $lock if !-e $lock; |
99
|
1
|
|
|
|
|
46
|
utime( undef, undef, $lock ); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# perform the check |
103
|
300
|
|
|
|
|
471
|
my ( $ok, $why ) = ( 1, '' ); |
104
|
300
|
100
|
100
|
|
|
878
|
if ( defined $version && Git::Version::Compare::looks_like_git($version) ) { |
105
|
295
|
|
|
|
|
3038
|
while ( my ( $spec, $arg ) = splice @spec, 0, 2 ) { |
106
|
290
|
100
|
|
|
|
6783
|
if ( !$check{$spec}->( $version, $arg ) ) { |
107
|
160
|
|
|
|
|
1787
|
$ok = 0; |
108
|
160
|
|
|
|
|
670
|
$version =~ s/^git version|[\012\015]+$//g; |
109
|
160
|
|
|
|
|
282
|
$why = "$version $spec $arg"; |
110
|
160
|
|
|
|
|
202
|
last; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
else { |
115
|
5
|
|
|
|
|
28
|
$ok = 0; |
116
|
5
|
|
|
|
|
26
|
$why = "`$GIT` binary not available or broken"; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# skip if needed |
120
|
298
|
100
|
|
|
|
14085
|
if ( !$ok ) { |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# skip a specified number of tests |
123
|
165
|
100
|
|
|
|
274
|
if ( $skip ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
124
|
156
|
|
|
|
|
526
|
$builder->skip($why) for 1 .. $skip; |
125
|
14
|
|
|
14
|
|
73
|
no warnings 'exiting'; |
|
14
|
|
|
|
|
17
|
|
|
14
|
|
|
|
|
2231
|
|
126
|
156
|
|
|
|
|
31899
|
last SKIP; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# no plan declared yet |
130
|
|
|
|
|
|
|
elsif ( !defined $builder->has_plan ) { |
131
|
3
|
100
|
|
|
|
37
|
if ( $builder->summary ) { |
132
|
1
|
|
|
|
|
16
|
$builder->skip($why); |
133
|
1
|
|
|
|
|
347
|
$builder->done_testing; |
134
|
1
|
|
|
|
|
338
|
exit 0; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
else { |
137
|
2
|
|
|
|
|
19
|
$builder->skip_all($why); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# the plan is no_plan |
142
|
|
|
|
|
|
|
elsif ( $builder->has_plan eq 'no_plan' ) { |
143
|
1
|
|
|
|
|
16
|
$builder->skip($why); |
144
|
1
|
|
|
|
|
572
|
exit 0; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# some plan was declared, skip all tests one by one |
148
|
|
|
|
|
|
|
else { |
149
|
5
|
|
|
|
|
106
|
$builder->skip($why) for 1 + $builder->summary .. $builder->has_plan; |
150
|
5
|
|
|
|
|
1632
|
exit 0; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
'git'; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
__END__ |