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..)

diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm
index 17e6abb..76db948 100644 (file)
--- 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 5ea6f4f..4e84816 100644 (file)
--- 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 13bbd9c..1ef99ed 100644 (file)
--- 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 2c34794..beda2d2 100644 (file)
--- 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 29a6409..f541888 100644 (file)
--- 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 0d938f8..dcf388a 100644 (file)
--- 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 9283093..13b0461 100644 (file)
--- 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 b868f33..af957be 100644 (file)
--- 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)");

diff --git a/perl.h b/perl.h
index 854a8c9..e379cc3 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5561,6 +5561,7 @@ typedef struct am_table_short AMTS;
 #define START_MY_CXT   static my_cxt_t my_cxt;
 #define dMY_CXT_SV     dNOOP
 #define dMY_CXT                dNOOP
+#define dMY_CXT_INTERP(my_perl)        dNOOP
 #define MY_CXT_INIT    NOOP
 #define MY_CXT_CLONE   NOOP
 #define MY_CXT         my_cxt