summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2007-12-22 11:28:02 +0000
committerNicholas Clark <nick@ccl4.org>2007-12-22 11:28:02 +0000
commit9568a12365eb8ff5d5bc470ce5480d516d924f31 (patch)
tree843d6d93c95bc3aead7041e90c042a1de40010f4 /ext
parent54cea8cc4e7e8225637e8d1e3b66ab04b99f0aee (diff)
downloadperl-9568a12365eb8ff5d5bc470ce5480d516d924f31.tar.gz
Integrate:
[ 32483] Use a new (clean) anonymous hash for each loop, rather than a hash in the pad, as the latter can change internal state sufficiently to confuse matters (even though in all cases it has no keys and from Perl space is "measurably" identical). [ 32500] Get APItest.xs compiling on 5.8.x by making the compilation of the Perl_hv_common() test code conditional on the macro hv_common being defined, and the refcounted_he code conditional on it being 5.9 or later. [ 32501] Hack round the fact that UNITCHECK is nothing special on 5.8.x by conditionally creating a sub UNITCHECK(&); [ 32502] UNITCHECK isn't anything special in 5.8.x, so don't run those tests. [ 32503] Skip the op.t API test as it's not relevant to 5.8.x (%^H propagation). Correct the expectations of hash.t and svsetsv.t for 5.8.x. [ 32507] Test both dMY_CXT and dMY_CXT_INTERP. p4raw-link: @32507 on //depot/blead-maint-fixup/perl: 948cafa0ee2c83e155ea7f64aa3684aa54c83031 p4raw-link: @32503 on //depot/blead-maint-fixup/perl: 0a4679392d1fb21a111f1f0a9e93261b2b2cd4e7 p4raw-link: @32502 on //depot/blead-maint-fixup/perl: cfed56ecfc9c769a0f76147400aa46972ddbb0be p4raw-link: @32501 on //depot/blead-maint-fixup/perl: 8221ebfdedcb3fbfc645196464faaf397ba18800 p4raw-link: @32500 on //depot/blead-maint-fixup/perl: 77ea6e921df11217724b2f5c3c6b6a6ff488ab44 p4raw-link: @32483 on //depot/blead-maint-fixup/perl: 42b4d13769a3b10e7ffb0a3d275d2fdda0245bd5 p4raw-id: //depot/perl@32699 p4raw-integrated: from //depot/blead-maint-fixup/perl@32698 'copy in' ext/XS/APItest/APItest.pm ext/XS/APItest/APItest.xs ext/XS/APItest/t/hash.t ext/XS/APItest/t/my_cxt.t ext/XS/APItest/t/op.t ext/XS/APItest/t/svsetsv.t ext/XS/APItest/t/xs_special_subs.t ext/XS/APItest/t/xs_special_subs_require.t (@32482..) 'merge in' perl.h (@32504..)
Diffstat (limited to 'ext')
-rw-r--r--ext/XS/APItest/APItest.pm10
-rw-r--r--ext/XS/APItest/APItest.xs24
-rw-r--r--ext/XS/APItest/t/hash.t36
-rw-r--r--ext/XS/APItest/t/my_cxt.t19
-rw-r--r--ext/XS/APItest/t/op.t4
-rw-r--r--ext/XS/APItest/t/svsetsv.t9
-rw-r--r--ext/XS/APItest/t/xs_special_subs.t48
-rw-r--r--ext/XS/APItest/t/xs_special_subs_require.t58
8 files changed, 137 insertions, 71 deletions
diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm
index 17e6abb7b3..76db9481ee 100644
--- a/ext/XS/APItest/APItest.pm
+++ b/ext/XS/APItest/APItest.pm
@@ -40,6 +40,14 @@ our $VERSION = '0.12';
use vars '$WARNINGS_ON_BOOTSTRAP';
use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
+BEGIN {
+ # This is arguably a hack, but it disposes of the UNITCHECK block without
+ # needing to preprocess the source code
+ if ($] < 5.009) {
+ eval 'sub UNITCHECK (&) {}; 1' or die $@;
+ }
+}
+
# Do these here to verify that XS code and Perl code get called at the same
# times
BEGIN {
@@ -47,7 +55,7 @@ BEGIN {
}
UNITCHECK {
$UNITCHECK_called_PP++;
-}
+};
{
# Need $W false by default, as some tests run under -w, and under -w we
# can get warnings about "Too late to run CHECK" block (and INIT block)
diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index 5ea6f4f060..4e84816c1d 100644
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -30,14 +30,17 @@ my_cxt_setint_p(pMY_CXT_ int i)
}
SV*
-my_cxt_getsv_interp(void)
+my_cxt_getsv_interp_context(void)
{
-#ifdef PERL_IMPLICIT_CONTEXT
dTHX;
dMY_CXT_INTERP(my_perl);
-#else
+ return MY_CXT.sv;
+}
+
+SV*
+my_cxt_getsv_interp(void)
+{
dMY_CXT;
-#endif
return MY_CXT.sv;
}
@@ -404,6 +407,8 @@ fetch(hash, key_sv)
OUTPUT:
RETVAL
+#if defined (hv_common)
+
SV *
common(params)
INPUT:
@@ -449,6 +454,8 @@ common(params)
OUTPUT:
RETVAL
+#endif
+
void
test_hv_free_ent()
PPCODE:
@@ -479,6 +486,8 @@ test_share_unshare_pvn(input)
OUTPUT:
RETVAL
+#if PERL_VERSION >= 9
+
bool
refcounted_he_exists(key, level=0)
SV *key
@@ -493,7 +502,6 @@ refcounted_he_exists(key, level=0)
OUTPUT:
RETVAL
-
SV *
refcounted_he_fetch(key, level=0)
SV *key
@@ -508,6 +516,7 @@ refcounted_he_fetch(key, level=0)
OUTPUT:
RETVAL
+#endif
=pod
@@ -781,10 +790,11 @@ my_cxt_setint(i)
my_cxt_setint_p(aMY_CXT_ i);
void
-my_cxt_getsv()
+my_cxt_getsv(how)
+ bool how;
PPCODE:
EXTEND(SP, 1);
- ST(0) = my_cxt_getsv_interp();
+ ST(0) = how ? my_cxt_getsv_interp_context() : my_cxt_getsv_interp();
XSRETURN(1);
void
diff --git a/ext/XS/APItest/t/hash.t b/ext/XS/APItest/t/hash.t
index 13bbd9c3ec..1ef99ed430 100644
--- a/ext/XS/APItest/t/hash.t
+++ b/ext/XS/APItest/t/hash.t
@@ -49,13 +49,16 @@ main_tests (\@keys, \@testkeys, ' [utf8 hash]');
{
my %h = (a=>'cheat');
tie %h, 'Tie::StdHash';
- is (XS::APItest::Hash::store(\%h, chr 258, 1), undef);
+ # is bug 36327 fixed?
+ my $result = ($] > 5.009) ? undef : 1;
+
+ is (XS::APItest::Hash::store(\%h, chr 258, 1), $result);
ok (!exists $h{$utf8_for_258},
"hv_store doesn't insert a key with the raw utf8 on a tied hash");
}
-{
+if ($] > 5.009) {
my $strtab = strtab();
is (ref $strtab, 'HASH', "The shared string table quacks like a hash");
my $wibble = "\0";
@@ -382,19 +385,28 @@ sub test_store {
my $class = tied %$hash;
- my %h1 = @$defaults;
- my %h2 = @$defaults;
+ # It's important to do this with nice new hashes created each time round
+ # the loop, rather than hashes in the pad, which get recycled, and may have
+ # xhv_array non-NULL
+ my $h1 = {@$defaults};
+ my $h2 = {@$defaults};
if (defined $class) {
- tie %h1, ref $class;
- tie %h2, ref $class;
- $HV_STORE_IS_CRAZY = undef;
+ tie %$h1, ref $class;
+ tie %$h2, ref $class;
+ if ($] > 5.009) {
+ # bug 36327 is fixed
+ $HV_STORE_IS_CRAZY = undef;
+ } else {
+ # HV store_ent returns 1 if there was already underlying hash storage
+ $HV_STORE_IS_CRAZY = undef unless @$defaults;
+ }
}
- is (XS::APItest::Hash::store_ent(\%h1, $key, 1), $HV_STORE_IS_CRAZY,
- "hv_store_ent$message $printable");
- ok (brute_force_exists (\%h1, $key), "hv_store_ent$message $printable");
- is (XS::APItest::Hash::store(\%h2, $key, 1), $HV_STORE_IS_CRAZY,
+ is (XS::APItest::Hash::store_ent($h1, $key, 1), $HV_STORE_IS_CRAZY,
+ "hv_store_ent$message $printable");
+ ok (brute_force_exists ($h1, $key), "hv_store_ent$message $printable");
+ is (XS::APItest::Hash::store($h2, $key, 1), $HV_STORE_IS_CRAZY,
"hv_store$message $printable");
- ok (brute_force_exists (\%h2, $key), "hv_store$message $printable");
+ ok (brute_force_exists ($h2, $key), "hv_store$message $printable");
}
sub test_fetch_present {
diff --git a/ext/XS/APItest/t/my_cxt.t b/ext/XS/APItest/t/my_cxt.t
index 2c3479467a..beda2d24a0 100644
--- a/ext/XS/APItest/t/my_cxt.t
+++ b/ext/XS/APItest/t/my_cxt.t
@@ -23,35 +23,40 @@ BEGIN {
use warnings;
use strict;
-use Test::More tests => 11;
+use Test::More tests => 16;
BEGIN {
use_ok('XS::APItest');
};
is(my_cxt_getint(), 99, "initial int value");
-is(my_cxt_getsv(), "initial", "initial SV value");
+is(my_cxt_getsv($_), "initial", "initial SV value$_")
+ foreach '', ' (context arg)';
my_cxt_setint(1234);
is(my_cxt_getint(), 1234, "new int value");
my_cxt_setsv("abcd");
-is(my_cxt_getsv(), "abcd", "new SV value");
+is(my_cxt_getsv($_), "abcd", "new SV value$_")
+ foreach '', ' (context arg)';
sub do_thread {
is(my_cxt_getint(), 1234, "initial int value (child)");
my_cxt_setint(4321);
is(my_cxt_getint(), 4321, "new int value (child)");
- is(my_cxt_getsv(), "initial_clone", "initial sv value (child)");
+ is(my_cxt_getsv($_), "initial_clone", "initial sv value (child)$_")
+ foreach '', ' (context arg)';
my_cxt_setsv("dcba");
- is(my_cxt_getsv(), "dcba", "new SV value (child)");
+ is(my_cxt_getsv($_), "dcba", "new SV value (child)$_")
+ foreach '', ' (context arg)';
}
SKIP: {
- skip "No threads", 4 unless $threads;
+ skip "No threads", 6 unless $threads;
threads->create(\&do_thread)->join;
}
is(my_cxt_getint(), 1234, "int value preserved after join");
-is(my_cxt_getsv(), "abcd", "SV value preserved after join");
+is(my_cxt_getsv($_), "abcd", "SV value preserved after join$_")
+ foreach '', ' (context arg)';
diff --git a/ext/XS/APItest/t/op.t b/ext/XS/APItest/t/op.t
index 29a64096df..f541888483 100644
--- a/ext/XS/APItest/t/op.t
+++ b/ext/XS/APItest/t/op.t
@@ -11,6 +11,10 @@ BEGIN {
print "1..0 # Skip: XS::APItest was not built\n";
exit 0;
}
+ if ($] < 5.009) {
+ print "1..0 # Skip: hints hash not present before 5.10.0\n";
+ exit 0;
+ }
}
use strict;
diff --git a/ext/XS/APItest/t/svsetsv.t b/ext/XS/APItest/t/svsetsv.t
index 0d938f8d58..dcf388ab70 100644
--- a/ext/XS/APItest/t/svsetsv.t
+++ b/ext/XS/APItest/t/svsetsv.t
@@ -18,8 +18,13 @@ BEGIN { use_ok('XS::APItest') };
# I can't see a good way to easily get back perl-space diagnostics for these
# I hope that this isn't a problem.
-ok(sv_setsv_cow_hashkey_core,
- "With PERL_CORE sv_setsv does COW for shared hash key scalars");
+if ($] > 5.009) {
+ ok(sv_setsv_cow_hashkey_core,
+ "With PERL_CORE sv_setsv does COW for shared hash key scalars");
+} else {
+ ok(!sv_setsv_cow_hashkey_core,
+ "With PERL_CORE on 5.8.x sv_setsv doesn't COW for shared hash key scalars");
+}
ok(!sv_setsv_cow_hashkey_notcore,
"Without PERL_CORE sv_setsv doesn't COW for shared hash key scalars");
diff --git a/ext/XS/APItest/t/xs_special_subs.t b/ext/XS/APItest/t/xs_special_subs.t
index 9283093ec6..13b0461dd8 100644
--- a/ext/XS/APItest/t/xs_special_subs.t
+++ b/ext/XS/APItest/t/xs_special_subs.t
@@ -16,7 +16,11 @@ BEGIN {
use strict;
use warnings;
-use Test::More tests => 100;
+my $uc;
+BEGIN {
+ $uc = $] > 5.009;
+}
+use Test::More tests => $uc ? 100 : 80;
# Doing this longhand cut&paste makes it clear
# BEGIN and INIT are FIFO, CHECK and END are LIFO
@@ -24,8 +28,10 @@ BEGIN {
print "# First BEGIN\n";
is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
- is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called");
- is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called");
+ is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
+ if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called")
+ if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not yet called");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not yet called");
is($XS::APItest::INIT_called, undef, "INIT not yet called");
@@ -38,8 +44,8 @@ CHECK {
print "# First CHECK\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
- is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
- is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+ is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, 1, "CHECK called");
is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
is($XS::APItest::INIT_called, undef, "INIT not yet called");
@@ -52,8 +58,8 @@ INIT {
print "# First INIT\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
- is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
- is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+ is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, 1, "CHECK called");
is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
is($XS::APItest::INIT_called, undef, "INIT not yet called");
@@ -66,8 +72,8 @@ END {
print "# First END\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
- is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
- is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+ is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, 1, "CHECK called");
is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
is($XS::APItest::INIT_called, 1, "INIT called");
@@ -79,8 +85,8 @@ END {
print "# First body\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
-is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
-is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, 1, "CHECK called");
is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
is($XS::APItest::INIT_called, 1, "INIT called");
@@ -93,8 +99,8 @@ use XS::APItest;
print "# Second body\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
-is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
-is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, 1, "CHECK called");
is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
is($XS::APItest::INIT_called, 1, "INIT called");
@@ -106,8 +112,8 @@ BEGIN {
print "# Second BEGIN\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
- is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
- is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+ is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not yet called");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not yet called");
is($XS::APItest::INIT_called, undef, "INIT not yet called");
@@ -120,8 +126,8 @@ CHECK {
print "# Second CHECK\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
- is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK yet called");
- is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK yet called");
+ is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK yet called") if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK yet called") if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not yet called");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not yet called");
is($XS::APItest::INIT_called, undef, "INIT not yet called");
@@ -134,8 +140,8 @@ INIT {
print "# Second INIT\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
- is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
- is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+ is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, 1, "CHECK called");
is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
is($XS::APItest::INIT_called, 1, "INIT called");
@@ -148,8 +154,8 @@ END {
print "# Second END\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
- is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
- is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+ is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, 1, "CHECK called");
is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
is($XS::APItest::INIT_called, 1, "INIT called");
diff --git a/ext/XS/APItest/t/xs_special_subs_require.t b/ext/XS/APItest/t/xs_special_subs_require.t
index b868f33d91..af957be1e2 100644
--- a/ext/XS/APItest/t/xs_special_subs_require.t
+++ b/ext/XS/APItest/t/xs_special_subs_require.t
@@ -15,7 +15,11 @@ BEGIN {
use strict;
use warnings;
-use Test::More tests => 103;
+my $uc;
+BEGIN {
+ $uc = $] > 5.009;
+}
+use Test::More tests => $uc ? 103 : 83;
# Doing this longhand cut&paste makes it clear
# BEGIN and INIT are FIFO, CHECK and END are LIFO
@@ -23,8 +27,10 @@ BEGIN {
print "# First BEGIN\n";
is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
- is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called");
- is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called");
+ is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
+ if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
+ if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
is($XS::APItest::INIT_called, undef, "INIT not called");
@@ -37,8 +43,10 @@ CHECK {
print "# First CHECK\n";
is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
- is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called");
- is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called");
+ is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
+ if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
+ if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
is($XS::APItest::INIT_called, undef, "INIT not called");
@@ -51,8 +59,10 @@ INIT {
print "# First INIT\n";
is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
- is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called");
- is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called");
+ is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
+ if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
+ if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
is($XS::APItest::INIT_called, undef, "INIT not called");
@@ -65,8 +75,8 @@ END {
print "# First END\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
- is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
- is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+ is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
@@ -78,8 +88,8 @@ END {
print "# First body\n";
is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
-is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called");
-is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called");
+is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called") if $uc;
+is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called") if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
@@ -101,8 +111,8 @@ is($XS::APItest::END_called_PP, undef, "END not yet called");
print "# Second body\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
-is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
-is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
@@ -114,8 +124,10 @@ BEGIN {
print "# Second BEGIN\n";
is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
- is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called");
- is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called");
+ is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
+ if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
+ if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
is($XS::APItest::INIT_called, undef, "INIT not called");
@@ -128,8 +140,10 @@ CHECK {
print "# Second CHECK\n";
is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
- is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called");
- is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called");
+ is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
+ if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called")
+ if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
is($XS::APItest::INIT_called, undef, "INIT not called");
@@ -142,8 +156,10 @@ INIT {
print "# Second INIT\n";
is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
- is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called");
- is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called");
+ is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
+ if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called")
+ if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
@@ -156,8 +172,8 @@ END {
print "# Second END\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
- is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called");
- is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called");
+ is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
+ is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
is($XS::APItest::INIT_called, undef, "INIT not called (too late)");