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
|
use strict;
use warnings;
use CPAN::Meta::Requirements;
use version;
use Test::More 0.88;
my %DATA = (
'Foo::Bar' => [ 10, 10 ],
'Foo::Baz' => [ 'invalid_version', 42 ],
'Foo::Qux' => [ 'version', 42 ],
);
my %input = map { ($_ => $DATA{$_}->[0]) } keys %DATA;
my %expected = map { ($_ => $DATA{$_}->[1]) } keys %DATA;
sub dies_ok (&@) {
my ($code, $qr, $comment) = @_;
no warnings 'redefine';
local *Regexp::CARP_TRACE = sub { "<regexp>" };
my $lived = eval { $code->(); 1 };
if ($lived) {
fail("$comment: did not die");
} else {
like($@, $qr, $comment);
}
}
my $hook_text;
sub _fixit { my ($v, $m) = @_; $hook_text .= $m; return version->new(42) }
{
my $req = CPAN::Meta::Requirements->new( {bad_version_hook => \&_fixit} );
my ($k, $v);
while (($k, $v) = each %input) {
note "adding minimum requirement: $k => $v";
eval { $req->add_minimum($k => $v) };
is( $@, '', "adding minimum '$k' for $v" );
}
like( $hook_text, qr/Foo::Baz/, 'hook stored module name' );
is_deeply(
$req->as_string_hash,
\%expected,
"hook fixes invalid version",
);
}
{
my $req = CPAN::Meta::Requirements->new( {bad_version_hook => sub { 0 }} );
dies_ok { $req->add_minimum('Foo::Baz' => 'invalid_version') }
qr/Invalid version/,
"dies if hook doesn't return version object";
}
done_testing;
|
