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
|
#!perl -w
use strict;
use Test::More;
BEGIN { use_ok('XS::APItest') };
use vars qw($XS_VERSION $VERSION);
# This is what the code expects
my $real_version = $XS::APItest::VERSION;
sub default {
return ($_[0], undef) if @_;
return ($XS_VERSION, 'XS_VERSION') if defined $XS_VERSION;
return ($VERSION, 'VERSION');
}
sub expect_good {
my $package = $_[0];
my $version = exists $_[1] ? ", $_[1]" : '';
local $Test::Builder::Level = $Test::Builder::Level + 1;
is_deeply([XS_VERSION_defined(@_)], [],
"Is good for $package$version");
is_deeply([XS_VERSION_undef(@_)], [],
"Is good for $package$version with #undef XS_VERSION");
}
sub expect_bad {
my $what = shift;
my $package = $_[0];
my $desc; # String to use in test descriptions
if (defined $what) {
$what = quotemeta('$' . $package . '::' . $what);
} else {
$what = 'bootstrap parameter';
}
if (exists $_[1]) {
$desc = "$_[0], $_[1]";
} else {
$desc = $_[0];
}
is(eval {XS_VERSION_defined(@_); "Oops"}, undef, "Is bad for $desc");
like($@,
qr/$package object version $real_version does not match $what/,
'expected error message');
is_deeply([XS_VERSION_undef(@_)], [],
"but is good for $desc with #undef XS_VERSION");
}
# With neither $VERSION nor $XS_VERSION defined, no check is made if no version
# is passed in
expect_good('dummy_package');
foreach ($real_version, version->new($real_version)) {
expect_good('dummy_package', $_);
}
foreach (3.14, version->new(3.14)) {
expect_bad(undef, 'dummy_package', $_);
}
my @versions = ($real_version, version->new($real_version),
3.14, version->new(3.14));
# Package variables
foreach $XS_VERSION (undef, @versions) {
foreach $VERSION (undef, @versions) {
my ($expect, $what) = default();
if (defined $expect) {
if ($expect eq $real_version) {
expect_good('main');
} else {
expect_bad($what, 'main');
}
}
foreach my $param (@versions) {
my ($expect, $what) = default($param);
if ($expect eq $real_version) {
expect_good('main', $param);
} else {
expect_bad($what, 'main', $param);
}
}
}
}
done_testing();
|