1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
use strict;
BEGIN{ if (not $] < 5.006) { require warnings; warnings->import } }
use Test::More;
use Config;
use File::Copy qw/copy/;
use File::Path qw/mkpath/;
use File::Spec::Functions qw/catdir catfile rel2abs/;
use File::Temp qw/tempdir/;
use lib 't/lib';
use Frontend;
use MockHomeDir;
#plan 'no_plan';
plan tests => $Config{taint_disabled} ? 23 : 22;
#--------------------------------------------------------------------------#
# Fixtures
#--------------------------------------------------------------------------#
my $config_dir = catdir( MockHomeDir::home_dir, ".cpanreporter" );
my $config_file = catfile( $config_dir, "config.ini" );
my $history_file = catfile( $config_dir, "reports-sent.db" );
my $sample_history_file = catfile(qw/t history reports-sent-longer.db/);
my @fake_results = (
{ dist_name => 'Baz-Bam-3.14', phase => 'test', grade => 'pass' },
{ dist_name => 'Foo-Bar-1.23', phase => 'PL', grade => 'fail' },
{ dist_name => 'Foo-Bar-1.23', phase => 'test', grade => 'fail' },
{ dist_name => 'Foo-Bar-1.23', phase => 'test', grade => 'pass' },
{ dist_name => 'Wibble-42', phase => 'test', grade => 'pass' },
{ dist_name => 'Wobble-23', phase => 'PL', grade => 'na' },
{ dist_name => 'Inline-0.44', phase => 'test', grade => 'pass' },
{ dist_name => 'Crappy-0.01', phase => 'PL', grade => 'discard' },
);
#--------------------------------------------------------------------------##
# begin testing
#--------------------------------------------------------------------------#
my @aoh;
mkpath( $config_dir );
ok( -d $config_dir, "temporary config dir created" );
# If old history exists, convert it
copy( $sample_history_file, $history_file);
ok( -f $history_file, "copied sample old history file to config directory");
# make it writeable
chmod 0644, $history_file;
ok( -w $history_file, "history file is writeable" );
# load CPAN::Reporter::History and import have_tested for convenience
require_ok( 'CPAN::Reporter::History' );
CPAN::Reporter::History->import( 'have_tested' );
# put in some data for current perl/arch/osname
CPAN::Reporter::History::_record_history($_) for @fake_results;
# one parameter should die
eval { have_tested( 'Wibble-42' ) };
ok ( $@, "have_tested() dies with odd number of arguments" );
# unknown parameter shoudl die
eval { have_tested( distname => 'Wibble-42' ) };
ok ( $@, "have_tested() dies with unknown parameter" );
# have_tested without any parameters should return everything on this platform
@aoh = have_tested();
is( scalar @aoh, scalar @fake_results,
"have_tested() with no args gives everything on this platform"
);
# have_tested a dist that was only tested once - return AoH with only one hash
@aoh = have_tested( dist => 'Wibble-42');
is( scalar @aoh, 1,
"asking for a unique dist"
);
is( ref $aoh[0], 'HASH',
"returned an AoH"
);
# we don't use _format_archname here because the test is checking both that
# _format_archname is used correctly in the code and that it *works* correctly
my $expected_archname =
!$Config{taint_disabled} ? $Config{archname} :
$Config{taint_disabled} eq 'silent' ? "$Config{archname}-silent-no-taint-support" :
"$Config{archname}-no-taint-support";
is_deeply( $aoh[0],
{
phase => 'test',
grade => 'PASS',
dist => 'Wibble-42',
perl => CPAN::Reporter::History::_format_perl_version(),
archname => $expected_archname,
osvers => $Config{osvers},
},
"hash fields as expected"
);
if($Config{taint_disabled}) {
like($aoh[0]->{archname}, qr/no-taint-support/, "taint is unsupported, and the history file agrees");
if($Config{taint_disabled} eq 'silent') {
like($aoh[0]->{archname}, qr/silent-no-taint-support/, "... silently!");
} else {
unlike($aoh[0]->{archname}, qr/silent-no-taint-support/, "... noisily!");
}
} else {
unlike($aoh[0]->{archname}, qr/no-taint-support/, "taint is supported, and the history file agrees");
}
# just dist returns all reports for that dist on current platform
@aoh = have_tested( dist => 'Foo-Bar-1.23' );
is( scalar @aoh, 3,
"asking for multiple dist reports (only on this platform)"
);
# just dist doesn't return reports from other platforms
@aoh = have_tested( dist => 'ExtUtils-ParseXS-2.18' );
is( scalar @aoh, 0,
"asking for multiple dist reports (with none on this platform)"
);
# just phase returns all reports for that dist on current platform
@aoh = have_tested( phase => 'test' );
is( scalar @aoh, 5,
"asking for all test phase reports (defaults to this platform)"
);
# just grade returns all reports of that grade on current platform
@aoh = have_tested( grade => 'na' );
is( scalar @aoh, 1,
"asking for all na grade reports (defaults to this platform)"
);
# just grade returns all reports of that grade on current platform
@aoh = have_tested( grade => 'NA' );
is( scalar @aoh, 1,
"asking for all NA grade reports (defaults to this platform)"
);
# just grade returns all reports of that grade on current platform
@aoh = have_tested( grade => 'DISCARD' );
is( scalar @aoh, 1,
"asking for all DISCARD grade reports (defaults to this platform)"
);
# restrict to just a particular dist and phase
@aoh = have_tested( dist => 'Foo-Bar-1.23', phase => 'test' );
is( scalar @aoh, 2,
"asking for dist in test phase (defaults to this platform)"
);
# dist reports on any platform
@aoh = have_tested(
dist => 'Inline-0.44', perl => q{}, archname => q{}, osvers => q{}
);
is( scalar @aoh, 2,
"asking for dist across any perl/archname/osvers"
);
# restrict to a platform
@aoh = have_tested(
archname => 'not-a-real-archname', perl => q{}, osvers => q{}
);
is( scalar @aoh, 12,
"asking for all results from an archname"
);
# restrict to a perl
@aoh = have_tested(
perl => '9.10.0', archname => q{}, osvers => q{}
);
is( scalar @aoh, 9,
"asking for all results from a perl version"
);
# restrict to an osver
@aoh = have_tested(
perl => q{}, archname => q{}, osvers => q{another-fake-version}
);
is( scalar @aoh, 3,
"asking for all results from an OS version"
);
|
