This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
XS::APItest tests for XS_VERSION_BOOTCHECK.
[perl5.git] / ext / XS-APItest / t / xsub_h.t
CommitLineData
7b20c7cd
NC
1#!perl -w
2use strict;
3
4use Test::More;
5
6BEGIN { use_ok('XS::APItest') };
7
8use vars qw($XS_VERSION $VERSION);
9
10# This is what the code expects
11my $real_version = $XS::APItest::VERSION;
12
13sub default {
14 return ($_[0], undef) if @_;
15 return ($XS_VERSION, 'XS_VERSION') if defined $XS_VERSION;
16 return ($VERSION, 'VERSION');
17}
18
19sub expect_good {
20 my $package = $_[0];
21 my $version = exists $_[1] ? ", $_[1]" : '';
22 local $Test::Builder::Level = $Test::Builder::Level + 1;
23 is_deeply([XS_VERSION_defined(@_)], [],
24 "Is good for $package$version");
25
26 is_deeply([XS_VERSION_undef(@_)], [],
27 "Is good for $package$version with #undef XS_VERSION");
28}
29
30sub expect_bad {
31 my $what = shift;
32 my $package = $_[0];
33 my $desc; # String to use in test descriptions
34
35 if (defined $what) {
36 $what = quotemeta('$' . $package . '::' . $what);
37 } else {
38 $what = 'bootstrap parameter';
39 }
40 if (exists $_[1]) {
41 $desc = "$_[0], $_[1]";
42 } else {
43 $desc = $_[0];
44 }
45
46 is(eval {XS_VERSION_defined(@_); "Oops"}, undef, "Is bad for $desc");
47 like($@,
48 qr/$package object version $real_version does not match $what/,
49 'expected error message');
50
51 is_deeply([XS_VERSION_undef(@_)], [],
52 "but is good for $desc with #undef XS_VERSION");
53}
54
55# With neither $VERSION nor $XS_VERSION defined, no check is made if no version
56# is passed in
57expect_good('dummy_package');
58
59foreach ($real_version, version->new($real_version)) {
60 expect_good('dummy_package', $_);
61}
62
63foreach (3.14, version->new(3.14)) {
64 expect_bad(undef, 'dummy_package', $_);
65}
66
67my @versions = ($real_version, version->new($real_version),
68 3.14, version->new(3.14));
69
70# Package variables
71foreach $XS_VERSION (undef, @versions) {
72 foreach $VERSION (undef, @versions) {
73 my ($expect, $what) = default();
74 if (defined $expect) {
75 if ($expect eq $real_version) {
76 expect_good('main');
77 } else {
78 expect_bad($what, 'main');
79 }
80 }
81 foreach my $param (@versions) {
82 my ($expect, $what) = default($param);
83 if ($expect eq $real_version) {
84 expect_good('main', $param);
85 } else {
86 expect_bad($what, 'main', $param);
87 }
88 }
89 }
90}
91
92done_testing();