1#!perl
2
3use strict;
4use warnings;
5
6require "../../t/test.pl";
7
8use XS::APItest;
9
10# clone_with_stack creates a clone of the perl interpreter including
11# the stack, then destroys the original interpreter and runs the
12# remaining code using the new one.
13# This is like doing a psuedo-fork and exiting the parent.
14
15use Config;
16if (not $Config{'useithreads'}) {
17    skip_all("clone_with_stack requires threads");
18}
19
20plan(8);
21
22fresh_perl_is( <<'----', <<'====', undef, "minimal clone_with_stack" );
23use XS::APItest;
24clone_with_stack();
25print "ok\n";
26----
27ok
28====
29
30fresh_perl_is( <<'----', <<'====', undef, "inside a subroutine" );
31use XS::APItest;
32sub f {
33    clone_with_stack();
34}
35f();
36print "ok\n";
37----
38ok
39====
40
41{
42    local our $TODO = "clone_with_stack inside a begin block";
43    fresh_perl_is( <<'----', <<'====', undef, "inside a BEGIN block" );
44use XS::APItest;
45BEGIN {
46    clone_with_stack();
47}
48print "ok\n";
49----
50ok
51====
52
53}
54
55{
56    fresh_perl_is( <<'----', <<'====', undef, "clone stack" );
57use XS::APItest;
58sub f {
59    clone_with_stack();
60    0..4;
61}
62print 'X-', 'Y-', join(':', f()), "-Z\n";
63----
64X-Y-0:1:2:3:4-Z
65====
66
67}
68
69{
70    fresh_perl_is( <<'----', <<'====', undef, "with a lexical sub" );
71use XS::APItest;
72use experimental lexical_subs=>;
73my sub f { print "42\n" }
74clone_with_stack();
75f();
76----
7742
78====
79
80}
81
82{
83    fresh_perl_is( <<'----', <<'====', undef, "with localised stuff" );
84use XS::APItest;
85$s = "outer";
86$a[0] = "anterior";
87$h{k} = "hale";
88{
89    local $s = "inner";
90    local $a[0] = 'posterior';
91    local $h{k} = "halt";
92    clone_with_stack();
93}
94print "scl: $s\n";
95print "ary: $a[0]\n";
96print "hsh: $h{k}\n";
97----
98scl: outer
99ary: anterior
100hsh: hale
101====
102
103}
104
105{
106    fresh_perl_is( <<'----', <<'====', undef, "inside a loop inside a fn" );
107use XS::APItest;
108my $a = 'aa';
109sub f {
110    my $b = 'bb';
111    my @c;
112    my $d = 'dd';
113    for my $d (0..4) {
114	clone_with_stack() if $d == 2;
115	push @c, $d;
116    }
117    return @c, $d;
118}
119print "X-$a-", join(':', f()), "-Z\n";
120----
121X-aa-0:1:2:3:4:dd-Z
122====
123
124}
125
126{
127    fresh_perl_is( <<'----', <<'====', undef, "inside fn inside a loop inside a fn" );
128use XS::APItest;
129my $a = 'aa';
130
131sub g {
132    my $e = 'ee';
133    my $f = 'ff';
134    clone_with_stack();
135}
136
137sub f {
138    my $b = 'bb';
139    my @c;
140    my $d = 'dd';
141    for my $d (0..4) {
142	g() if $d == 2;
143	push @c, $d;
144    }
145    return @c, $d;
146}
147print "X-$a-", join(':', f()), "-Z\n";
148----
149X-aa-0:1:2:3:4:dd-Z
150====
151
152}
153