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
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)
--- /dev/null
+#!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
+====
+
+}