Change 30720 by [EMAIL PROTECTED] on 2007/03/23 13:35:25
Integrate:
[ 30067]
BEGIN blocks in XS should work. (Given that CHECK, INIT and END all do)
[ 30072]
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.
[ 30076]
Also check BEGIN/UNITCHECK/CHECK/INIT/END for require.
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#354 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/APItest.pm#14 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/APItest.xs#19 integrate
... //depot/maint-5.8/perl/ext/XS/APItest/t/xs_special_subs.t#1 add
... //depot/maint-5.8/perl/ext/XS/APItest/t/xs_special_subs_require.t#1 add
... //depot/maint-5.8/perl/op.c#210 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#354 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#353~30719~ 2007-03-23 05:54:47.000000000 -0700
+++ perl/MANIFEST 2007-03-23 06:35:25.000000000 -0700
@@ -1038,6 +1038,8 @@
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
==== //depot/maint-5.8/perl/ext/XS/APItest/APItest.pm#14 (text) ====
Index: perl/ext/XS/APItest/APItest.pm
--- perl/ext/XS/APItest/APItest.pm#13~30719~ 2007-03-23 05:54:47.000000000
-0700
+++ perl/ext/XS/APItest/APItest.pm 2007-03-23 06:35:25.000000000 -0700
@@ -36,9 +36,38 @@
sub G_NODEBUG() { 32 }
sub G_METHOD() { 64 }
-our $VERSION = '0.11';
+our $VERSION = '0.12';
-bootstrap XS::APItest $VERSION;
+use vars '$WARNINGS_ON_BOOTSTRAP';
+use vars map "\$${_}_called_PP", qw(BEGIN CHECK INIT END);
+
+# Do these here to verify that XS code and Perl code get called at the same
+# times
+BEGIN {
+ $BEGIN_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;
+ bootstrap XS::APItest $VERSION;
+}
1;
__END__
==== //depot/maint-5.8/perl/ext/XS/APItest/APItest.xs#19 (text) ====
Index: perl/ext/XS/APItest/APItest.xs
--- perl/ext/XS/APItest/APItest.xs#18~30719~ 2007-03-23 05:54:47.000000000
-0700
+++ perl/ext/XS/APItest/APItest.xs 2007-03-23 06:35:25.000000000 -0700
@@ -523,3 +523,28 @@
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::UNITCHECK_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));
==== //depot/maint-5.8/perl/ext/XS/APItest/t/xs_special_subs.t#1 (text) ====
Index: perl/ext/XS/APItest/t/xs_special_subs.t
--- /dev/null 2007-03-19 09:41:43.516454971 -0700
+++ perl/ext/XS/APItest/t/xs_special_subs.t 2007-03-23 06:35:25.000000000
-0700
@@ -0,0 +1,139 @@
+#!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 => 80;
+
+# 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::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::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::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::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::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::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::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::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::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::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");
+}
==== //depot/maint-5.8/perl/ext/XS/APItest/t/xs_special_subs_require.t#1 (text)
====
Index: perl/ext/XS/APItest/t/xs_special_subs_require.t
--- /dev/null 2007-03-19 09:41:43.516454971 -0700
+++ perl/ext/XS/APItest/t/xs_special_subs_require.t 2007-03-23
06:35:25.000000000 -0700
@@ -0,0 +1,147 @@
+#!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 => 83;
+
+# 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::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::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::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::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::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::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::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::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::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::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");
+}
==== //depot/maint-5.8/perl/op.c#210 (text) ====
Index: perl/op.c
--- perl/op.c#209~30717~ 2007-03-23 04:58:22.000000000 -0700
+++ perl/op.c 2007-03-23 06:35:25.000000000 -0700
@@ -4901,8 +4901,18 @@
goto done;
if (strEQ(s, "BEGIN")) {
+ const I32 oldscope = PL_scopestack_ix;
+ ENTER;
+ SAVECOPFILE(&PL_compiling);
+ SAVECOPLINE(&PL_compiling);
+
Perl_av_create_and_push(aTHX_ &PL_beginav, (SV*)cv);
GvCV(gv) = 0; /* cv has been hijacked */
+ call_list(oldscope, PL_beginav);
+
+ PL_curcop = &PL_compiling;
+ CopHINTS_set(&PL_compiling, PL_hints);
+ LEAVE;
}
else if (strEQ(s, "END")) {
Perl_av_create_and_unshift_one(aTHX_ &PL_endav, (SV*)cv);
End of Patch.
