Front page | perl.perl5.porters |
Postings from July 2011
[perl #94048] [PATCH] Add a test for perl_clone with CLONEf_COPY_STACKS to XS-APItest.
Thread Previous
|
Thread Next
From:
Gerard Goossen
Date:
July 4, 2011 23:28
Subject:
[perl #94048] [PATCH] Add a test for perl_clone with CLONEf_COPY_STACKS to XS-APItest.
Message ID:
rt-3.6.HEAD-16080-1309811977-524.94048-75-0@perl.org
# New Ticket Created by Gerard Goossen
# Please include the string: [perl #94048]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=94048 >
This is a bug report for perl from gerard@ggoossen.net,
generated with the help of perlbug 1.39 running under perl 5.15.0.
>From 574e9f2fc10acc30232601c704604a1ce046c912 Mon Sep 17 00:00:00 2001
From: Gerard Goossen <gerard@ggoossen.net>
Date: Sat, 6 Nov 2010 12:22:29 +0100
Subject: [PATCH] Add a test for perl_clone with CLONEf_COPY_STACKS to
XS-APItest.
CLONEf_COPY_STACKS is only used by the windows pseudo-fork.
This test allows testing/debugging of CLONEf_COPY_STACK without needing threads or Windows.
---
MANIFEST | 1 +
ext/XS-APItest/APItest.xs | 55 +++++++++++++++++++++++++++++++++++
ext/XS-APItest/t/clone-with-stack.t | 53 +++++++++++++++++++++++++++++++++
3 files changed, 109 insertions(+), 0 deletions(-)
create mode 100644 ext/XS-APItest/t/clone-with-stack.t
diff --git a/MANIFEST b/MANIFEST
index 48a3987..0725658 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3657,6 +3657,7 @@ ext/XS-APItest/t/call_checker.t test call checker plugin API
ext/XS-APItest/t/caller.t XS::APItest: tests for caller_cx
ext/XS-APItest/t/call.t XS::APItest extension
ext/XS-APItest/t/cleanup.t test stack behaviour on unwinding
+ext/XS-APItest/t/clone-with-stack.t test clone with CLONEf_COPY_STACKS works
ext/XS-APItest/t/cophh.t test COPHH API
ext/XS-APItest/t/copyhints.t test hv_copy_hints_hv() API
ext/XS-APItest/t/customop.t XS::APItest: tests for custom ops
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 21f417d..acd1b5e 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2682,6 +2682,61 @@ CODE:
XSRETURN_UNDEF;
}
+#ifdef USE_ITHREADS
+
+void
+clone_with_stack()
+CODE:
+{
+ PerlInterpreter *interp = aTHX; /* The original interpreter */
+ PerlInterpreter *interp_dup; /* The duplicate interpreter */
+ int oldscope = 1; /* We are responsible for all scopes */
+
+ interp_dup = perl_clone(interp, CLONEf_COPY_STACKS | CLONEf_CLONE_HOST );
+
+ /* destroy old perl */
+ PERL_SET_CONTEXT(interp);
+
+ POPSTACK_TO(PL_mainstack);
+ dounwind(-1);
+ LEAVE_SCOPE(0);
+
+ while (interp->Iscopestack_ix > 1)
+ LEAVE;
+ FREETMPS;
+
+ perl_destruct(interp);
+ perl_free(interp);
+
+ /* switch to new perl */
+ PERL_SET_CONTEXT(interp_dup);
+
+ /* continue after 'clone_with_stack' */
+ interp_dup->Iop = interp_dup->Iop->op_next;
+
+ /* run with new perl */
+ Perl_runops_standard(interp_dup);
+
+ /* We may have additional unclosed scopes if fork() was called
+ * from within a BEGIN block. See perlfork.pod for more details.
+ * We cannot clean up these other scopes because they belong to a
+ * different interpreter, but we also cannot leave PL_scopestack_ix
+ * dangling because that can trigger an assertion in perl_destruct().
+ */
+ if (PL_scopestack_ix > oldscope) {
+ PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
+ PL_scopestack_ix = oldscope;
+ }
+
+ perl_destruct(interp_dup);
+ perl_free(interp_dup);
+
+ /* call the real 'exit' not PerlProc_exit */
+#undef exit
+ exit(0);
+}
+
+#endif /* USE_ITHREDS */
SV*
take_svref(SVREF sv)
diff --git a/ext/XS-APItest/t/clone-with-stack.t b/ext/XS-APItest/t/clone-with-stack.t
new file mode 100644
index 0000000..943a123
--- /dev/null
+++ b/ext/XS-APItest/t/clone-with-stack.t
@@ -0,0 +1,53 @@
+#!perl
+
+use strict;
+use warnings;
+
+require "../../t/test.pl";
+
+use XS::APItest;
+
+# clone_with_stack creates a clone of the perl interpreter including
+# the stack, then destroys the original interpreter and runs the
+# remaining code using the new one.
+# This is like doing a psuedo-fork and exiting the parent.
+
+use Config;
+if (not $Config{'useithreads'}) {
+ skip_all("clone_with_stack requires threads");
+}
+
+plan(3);
+
+fresh_perl_is( <<'----', <<'====', undef, "minimal clone_with_stack" );
+use XS::APItest;
+clone_with_stack();
+print "ok\n";
+----
+ok
+====
+
+fresh_perl_is( <<'----', <<'====', undef, "inside a subroutine" );
+use XS::APItest;
+sub f {
+ clone_with_stack();
+}
+f();
+print "ok\n";
+----
+ok
+====
+
+{
+ local our $TODO = "clone_with_stack inside a begin block";
+ fresh_perl_is( <<'----', <<'====', undef, "inside a BEGIN block" );
+use XS::APItest;
+BEGIN {
+ clone_with_stack();
+}
+print "ok\n";
+----
+ok
+====
+
+}
--
1.7.5.4
---
Flags:
category=core
severity=low
---
Site configuration information for perl 5.15.0:
Configured by gerard at Mon Jul 4 21:37:14 CEST 2011.
Summary of my perl5 (revision 5 version 15 subversion 0) configuration:
Commit id: c1a284a85da63fc56f97a4152da0c6e5a4fefc7c
Platform:
osname=linux, osvers=2.6.38-2-686-bigmem, archname=i686-linux-thread-multi
uname='linux zeus 2.6.38-2-686-bigmem #1 smp sun may 8 15:43:39 utc 2011 i686 gnulinux '
config_args='-des -DDEBUGGING -Dusethreads -Dusedevel -Doptimize=-O3 -g3 -Dprefix=/home/gerard/perl/inst/madperl'
hint=recommended, useposix=true, d_sigaction=define
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=undef, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O3 -g3',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
ccversion='', gccversion='4.6.1', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
alignbytes=4, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib /usr/lib/i386-linux-gnu /usr/lib64
libs=-lnsl -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
libc=, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version='2.13'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -O3 -g3 -L/usr/local/lib -fstack-protector'
Locally applied patches:
---
@INC for perl 5.15.0:
lib
/home/gerard/perl/inst/madperl/lib/site_perl/5.15.0/i686-linux-thread-multi
/home/gerard/perl/inst/madperl/lib/site_perl/5.15.0
/home/gerard/perl/inst/madperl/lib/5.15.0/i686-linux-thread-multi
/home/gerard/perl/inst/madperl/lib/5.15.0
/home/gerard/perl/inst/madperl/lib/site_perl
.
---
Environment for perl 5.15.0:
HOME=/home/gerard
LANG=en_US.UTF-8
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/home/gerard/bin:/usr/local/bin:/usr/bin:/bin:/usr/games
PERL_BADLANG (unset)
SHELL=/bin/bash
Thread Previous
|
Thread Next