BEGIN blocks in XS should work. (Given that CHECK, INIT and END all do)

p4raw-id: //depot/perl@30067

3 files changed, 120 insertions, 3 deletions

diff --git a/ext/XS/APItest/APItest.pm b/ext/XS/APItest/APItest.pm
index 668c7a94ac..7d0b40fa9d 100644
--- a/ext/XS/APItest/APItest.pm
+++ b/ext/XS/APItest/APItest.pm
@@ -35,9 +35,17 @@ sub G_KEEPERR()	{  16 }
 sub G_NODEBUG()	{  32 }
 sub G_METHOD()	{  64 }
 
-our $VERSION = '0.11';
-
-bootstrap XS::APItest $VERSION;
+our $VERSION = '0.12';
+
+use vars '$WARNINGS_ON_BOOTSTRAP';
+if ($WARNINGS_ON_BOOTSTRAP) {
+    bootstrap XS::APItest $VERSION;
+} else {
+    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;
+}
 
 1;
 __END__
diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index 827e362379..923c532802 100644
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -566,3 +566,28 @@ sv_setsv_cow_hashkey_core()
 
 bool
 sv_setsv_cow_hashkey_notcore()
+
+void
+BEGIN()
+    CODE:
+	sv_inc(get_sv("XS::APItest::BEGIN_called", GV_ADD|GV_ADDMULTI));
+
+void
+CHECK()
+    CODE:
+	sv_inc(get_sv("XS::APItest::CHECK_called", GV_ADD|GV_ADDMULTI));
+
+void
+UNITCHECK()
+    CODE:
+	sv_inc(get_sv("XS::APItest::CHECK_called", GV_ADD|GV_ADDMULTI));
+
+void
+INIT()
+    CODE:
+	sv_inc(get_sv("XS::APItest::INIT_called", GV_ADD|GV_ADDMULTI));
+
+void
+END()
+    CODE:
+	sv_inc(get_sv("XS::APItest::END_called", GV_ADD|GV_ADDMULTI));
diff --git a/ext/XS/APItest/t/xs_special_subs.t b/ext/XS/APItest/t/xs_special_subs.t
new file mode 100644
index 0000000000..6c7eba0884
--- /dev/null
+++ b/ext/XS/APItest/t/xs_special_subs.t
@@ -0,0 +1,84 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
+        print "1..0 # Skip: XS::APItest was not built\n";
+        exit 0;
+    }
+}
+
+use strict;
+use warnings;
+use Test::More tests => 40;
+
+# Doing this longhand cut&paste makes it clear
+# BEGIN and INIT are FIFO, CHECK and END are LIFO
+BEGIN {
+    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
+    is($XS::APItest::CHECK_called, undef, "CHECK not yet called");
+    is($XS::APItest::INIT_called, undef, "INIT not yet called");
+    is($XS::APItest::END_called, undef, "END not yet called");
+}
+
+CHECK {
+    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
+    is($XS::APItest::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::INIT_called, undef, "INIT not yet called");
+    is($XS::APItest::END_called, undef, "END not yet called");
+}
+
+INIT {
+    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
+    is($XS::APItest::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::INIT_called, undef, "INIT not yet called");
+    is($XS::APItest::END_called, undef, "END not yet called");
+}
+
+END {
+    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
+    is($XS::APItest::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::INIT_called, 1, "INIT called");
+    is($XS::APItest::END_called, 1, "END called");
+}
+
+is($XS::APItest::BEGIN_called, 1, "BEGIN called");
+is($XS::APItest::CHECK_called, 1, "CHECK called");
+is($XS::APItest::INIT_called, 1, "INIT called");
+is($XS::APItest::END_called, undef, "END not yet called");
+
+use XS::APItest;
+
+is($XS::APItest::BEGIN_called, 1, "BEGIN called");
+is($XS::APItest::CHECK_called, 1, "CHECK called");
+is($XS::APItest::INIT_called, 1, "INIT called");
+is($XS::APItest::END_called, undef, "END not yet called");
+
+BEGIN {
+    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
+    is($XS::APItest::CHECK_called, undef, "CHECK not yet called");
+    is($XS::APItest::INIT_called, undef, "INIT not yet called");
+    is($XS::APItest::END_called, undef, "END not yet called");
+}
+
+CHECK {
+    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
+    is($XS::APItest::CHECK_called, undef, "CHECK not yet called");
+    is($XS::APItest::INIT_called, undef, "INIT not yet called");
+    is($XS::APItest::END_called, undef, "END not yet called");
+}
+
+INIT {
+    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
+    is($XS::APItest::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::INIT_called, 1, "INIT called");
+    is($XS::APItest::END_called, undef, "END not yet called");
+}
+
+END {
+    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
+    is($XS::APItest::CHECK_called, 1, "CHECK called");
+    is($XS::APItest::INIT_called, 1, "INIT called");
+    is($XS::APItest::END_called, undef, "END not yet called");
+}