1use strict; 2use warnings; 3 4use CPAN::Meta::Requirements; 5use version; 6 7use Test::More 0.88; 8 9my %DATA = ( 10 'Foo::Bar' => [ 10, 10 ], 11 'Foo::Baz' => [ 'invalid_version', 42 ], 12 'Foo::Qux' => [ 'version', 42 ], 13); 14my %input = map { ($_ => $DATA{$_}->[0]) } keys %DATA; 15my %expected = map { ($_ => $DATA{$_}->[1]) } keys %DATA; 16 17sub dies_ok (&@) { 18 my ($code, $qr, $comment) = @_; 19 20 no warnings 'redefine'; 21 local *Regexp::CARP_TRACE = sub { "<regexp>" }; 22 my $lived = eval { $code->(); 1 }; 23 24 if ($lived) { 25 fail("$comment: did not die"); 26 } else { 27 like($@, $qr, $comment); 28 } 29} 30 31my $hook_text; 32sub _fixit { my ($v, $m) = @_; $hook_text .= $m; return version->new(42) } 33 34{ 35 my $req = CPAN::Meta::Requirements->new( {bad_version_hook => \&_fixit} ); 36 37 my ($k, $v); 38 while (($k, $v) = each %input) { 39 note "adding minimum requirement: $k => $v"; 40 eval { $req->add_minimum($k => $v) }; 41 is( $@, '', "adding minimum '$k' for $v" ); 42 } 43 like( $hook_text, qr/Foo::Baz/, 'hook stored module name' ); 44 45 is_deeply( 46 $req->as_string_hash, 47 \%expected, 48 "hook fixes invalid version", 49 ); 50} 51 52{ 53 my $req = CPAN::Meta::Requirements->new( {bad_version_hook => sub { 0 }} ); 54 55 dies_ok { $req->add_minimum('Foo::Baz' => 'invalid_version') } 56 qr/Invalid version/, 57 "dies if hook doesn't return version object"; 58 59} 60 61 62done_testing; 63