This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Avoid needless use of deprecated exists on array elements
[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];
5e5bb7c4 21 my $version = @_ >= 2 ? ", $_[1]" : '';
7b20c7cd
NC
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 }
5e5bb7c4 40 if (@_ >= 2) {
7b20c7cd
NC
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
f9cc56fa
NC
92{
93 my $count = 0;
94 {
95 package Counter;
96 our @ISA = 'version';
97 sub new {
98 ++$count;
99 return version::new(@_);
100 }
101
102 sub DESTROY {
103 --$count;
104 }
105 }
106
107 {
108 my $var = Counter->new();
109 is ($count, 1, "1 object exists");
110 is (eval {XS_VERSION_empty('main', $var); 1}, undef);
111 like ($@, qr/Invalid version format \(version required\)/);
112 }
113
114 is ($count, 0, "no objects exist");
115}
116
88c4b02d
NC
117is_deeply([XS_APIVERSION_valid("Pie")], [], "XS_APIVERSION_BOOTCHECK passes");
118is(eval {XS_APIVERSION_invalid("Pie"); 1}, undef,
119 "XS_APIVERSION_BOOTCHECK croaks for an invalid version");
120like($@, qr/Perl API version v1.0.16 of Pie does not match v5\.\d+\.\d+/,
121 "expected error");
122
7b20c7cd 123done_testing();