From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 29 Jan 2007 23:36:02 +0000 (+0000)
Subject: Also check BEGIN/UNITCHECK/CHECK/INIT/END for require.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a6ea7cf34722a779b9808bb114d537198b1a1d0d;p=p5sagit%2Fp5-mst-13.2.git

Also check BEGIN/UNITCHECK/CHECK/INIT/END for require.

p4raw-id: //depot/perl@30076
---

diff --git a/MANIFEST b/MANIFEST
index 7069e83..de0fe88 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1231,6 +1231,7 @@ ext/XS/APItest/t/printf.t	XS::APItest extension
 ext/XS/APItest/t/push.t		XS::APItest extension
 ext/XS/APItest/t/svsetsv.t	Test behaviour of sv_setsv with/without PERL_CORE
 ext/XS/APItest/t/xs_special_subs.t	Test that XS BEGIN/CHECK/INIT/END work
+ext/XS/APItest/t/xs_special_subs_require.t	for require too
 ext/XS/Typemap/Makefile.PL	XS::Typemap extension
 ext/XS/Typemap/README		XS::Typemap extension
 ext/XS/Typemap/stdio.c		XS::Typemap extension
diff --git a/ext/XS/APItest/t/xs_special_subs.t b/ext/XS/APItest/t/xs_special_subs.t
index bc99122..9283093 100644
--- a/ext/XS/APItest/t/xs_special_subs.t
+++ b/ext/XS/APItest/t/xs_special_subs.t
@@ -1,3 +1,5 @@
+#!perl -w
+
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
@@ -7,7 +9,9 @@ BEGIN {
         print "1..0 # Skip: XS::APItest was not built\n";
         exit 0;
     }
-    $XS::APItest::WARNINGS_ON_BOOTSTRAP++;
+    # Hush the used only once warning.
+    $XS::APItest::WARNINGS_ON_BOOTSTRAP = $MacPerl::Architecture;
+    $XS::APItest::WARNINGS_ON_BOOTSTRAP = 1;
 }
 
 use strict;
diff --git a/ext/XS/APItest/t/xs_special_subs_require.t b/ext/XS/APItest/t/xs_special_subs_require.t
new file mode 100644
index 0000000..b868f33
--- /dev/null
+++ b/ext/XS/APItest/t/xs_special_subs_require.t
@@ -0,0 +1,167 @@
+#!perl -w
+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;
+    }
+    # Hush the used only once warning.
+    $XS::APItest::WARNINGS_ON_BOOTSTRAP = $MacPerl::Architecture;
+    $XS::APItest::WARNINGS_ON_BOOTSTRAP = 1;
+}
+
+use strict;
+use warnings;
+use Test::More tests => 103;
+
+# 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 called");
+    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");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not 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, 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::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");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not 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, 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::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");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not 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, 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)");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
+    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, 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::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)");
+is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
+is($XS::APItest::END_called, undef, "END not yet called");
+is($XS::APItest::END_called_PP, undef, "END not yet called");
+
+{
+    my @trap;
+    local $SIG{__WARN__} = sub { push @trap, join "!", @_ };
+    require XS::APItest;
+
+    @trap = sort @trap;
+    is(scalar @trap, 2, "There were 2 warnings");
+    is($trap[0], "Too late to run CHECK block.\n");
+    is($trap[1], "Too late to run INIT block.\n");
+}
+
+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, 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)");
+is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
+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, 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::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");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not 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, 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 called");
+    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
+    is($XS::APItest::INIT_called, undef, "INIT not called");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not 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, 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 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)");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
+    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, 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)");
+    is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
+    is($XS::APItest::END_called, 1, "END called");
+    is($XS::APItest::END_called_PP, 1, "END called");
+}