UNITCHECK for XS code. Turned out to be harder that expected.

We need to get the XS BOOT section to run any UNITCHECK blocks for us.

p4raw-id: //depot/perl@30072

3 files changed, 99 insertions, 4 deletions

diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm
index 7d0b40fa9d..e230eb2694 100644
--- a/ext/XS/APItest/APItest.pm
+++ b/ext/XS/APItest/APItest.pm
@@ -38,12 +38,36 @@ sub G_METHOD()	{  64 }
 our $VERSION = '0.12';
 
 use vars '$WARNINGS_ON_BOOTSTRAP';
+use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END);
+
+# Do these here to verify that XS code and Perl code get called at the same
+# times
+BEGIN {
+    $BEGIN_called_PP++;
+}
+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)
+    no warnings 'void';
+    CHECK {
+	$CHECK_called_PP++;
+    }
+    INIT {
+	$INIT_called_PP++;
+    }
+}
+END {
+    $END_called_PP++;
+}
+
 if ($WARNINGS_ON_BOOTSTRAP) {
     bootstrap XS::APItest $VERSION;
 } else {
+    # More CHECK and INIT blocks that could warn:
     local $^W;
-    # 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)
     bootstrap XS::APItest $VERSION;
 }
 
diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index 923c532802..9d56365f5c 100644
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -580,7 +580,7 @@ CHECK()
 void
 UNITCHECK()
     CODE:
-	sv_inc(get_sv("XS::APItest::CHECK_called", GV_ADD|GV_ADDMULTI));
+	sv_inc(get_sv("XS::APItest::UNITCHECK_called", GV_ADD|GV_ADDMULTI));
 
 void
 INIT()
diff --git a/ext/XS/APItest/t/xs_special_subs.t b/ext/XS/APItest/t/xs_special_subs.t
index 6c7eba0884..bc9912294f 100644
--- a/ext/XS/APItest/t/xs_special_subs.t
+++ b/ext/XS/APItest/t/xs_special_subs.t
@@ -7,78 +7,149 @@ BEGIN {
         print "1..0 # Skip: XS::APItest was not built\n";
         exit 0;
     }
+    $XS::APItest::WARNINGS_ON_BOOTSTRAP++;
 }
 
 use strict;
 use warnings;
-use Test::More tests => 40;
+use Test::More tests => 100;
 
 # Doing this longhand cut&paste makes it clear
 # BEGIN and INIT are FIFO, CHECK and END are LIFO
 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::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");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not yet called");
     is($XS::APItest::END_called, undef, "END not yet called");
+    is($XS::APItest::END_called_PP, undef, "END not yet called");
 }
 
 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::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
     is($XS::APItest::INIT_called, undef, "INIT not yet called");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not yet called");
     is($XS::APItest::END_called, undef, "END not yet called");
+    is($XS::APItest::END_called_PP, undef, "END not yet called");
 }
 
 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::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
     is($XS::APItest::INIT_called, undef, "INIT not yet called");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not yet called");
     is($XS::APItest::END_called, undef, "END not yet called");
+    is($XS::APItest::END_called_PP, undef, "END not yet called");
 }
 
 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::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
     is($XS::APItest::INIT_called, 1, "INIT called");
+    is($XS::APItest::INIT_called_PP, 1, "INIT called");
     is($XS::APItest::END_called, 1, "END called");
+    is($XS::APItest::END_called_PP, 1, "END called");
 }
 
+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::CHECK_called, 1, "CHECK called");
+is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
 is($XS::APItest::INIT_called, 1, "INIT called");
+is($XS::APItest::INIT_called_PP, 1, "INIT called");
 is($XS::APItest::END_called, undef, "END not yet called");
+is($XS::APItest::END_called_PP, undef, "END not yet called");
 
 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::CHECK_called, 1, "CHECK called");
+is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
 is($XS::APItest::INIT_called, 1, "INIT called");
+is($XS::APItest::INIT_called_PP, 1, "INIT called");
 is($XS::APItest::END_called, undef, "END not yet called");
+is($XS::APItest::END_called_PP, undef, "END not yet called");
 
 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::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");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not yet called");
     is($XS::APItest::END_called, undef, "END not yet called");
+    is($XS::APItest::END_called_PP, undef, "END not yet called");
 }
 
 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::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");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not yet called");
     is($XS::APItest::END_called, undef, "END not yet called");
+    is($XS::APItest::END_called_PP, undef, "END not yet called");
 }
 
 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::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
     is($XS::APItest::INIT_called, 1, "INIT called");
+    is($XS::APItest::INIT_called_PP, 1, "INIT called");
     is($XS::APItest::END_called, undef, "END not yet called");
+    is($XS::APItest::END_called_PP, undef, "END not yet called");
 }
 
 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::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::CHECK_called_PP, 1, "CHECK called");
     is($XS::APItest::INIT_called, 1, "INIT called");
+    is($XS::APItest::INIT_called_PP, 1, "INIT called");
     is($XS::APItest::END_called, undef, "END not yet called");
+    is($XS::APItest::END_called_PP, undef, "END not yet called");
 }