Commit | Line | Data |
d5ac8da0 |
1 | use warnings; |
2 | use strict; |
3 | |
4 | use Test::More; |
5 | |
6 | use Function::Parameters; |
7 | |
8 | fun actual_location_of_line_with($marker) { |
9 | seek DATA, 0, 0 or die "seek DATA: $!"; |
10 | my $loc = 0; |
11 | while (my $line = readline DATA) { |
12 | $loc++; |
13 | index($line, $marker) >= 0 |
14 | and return $loc; |
15 | } |
16 | undef |
17 | } |
18 | |
19 | fun test_loc($marker) { |
20 | my $expected = actual_location_of_line_with $marker; |
21 | defined $expected or die "$marker: something done fucked up"; |
22 | my $got = (caller)[2]; |
23 | is $got, $expected, "location of '$marker'"; |
24 | } |
25 | |
26 | sub { |
b9c259ea |
27 | test_loc 'LT torture begin.'; |
d5ac8da0 |
28 | use integer; |
29 | my $r = shift; |
30 | |
31 | my $a = shift; |
32 | my $b = shift; |
33 | |
b9c259ea |
34 | test_loc 'LT torture A.'; |
d5ac8da0 |
35 | @_ = ( |
36 | sub { |
37 | my $f = shift; |
b9c259ea |
38 | test_loc 'LT torture B.'; |
d5ac8da0 |
39 | @_ = ( |
40 | sub { |
41 | my $f = shift; |
b9c259ea |
42 | test_loc 'LT torture C.'; |
d5ac8da0 |
43 | @_ = ( |
44 | sub { |
45 | my $f = shift; |
b9c259ea |
46 | test_loc 'LT torture D.'; |
d5ac8da0 |
47 | @_ = ( |
48 | sub { |
49 | my $n = shift; |
b9c259ea |
50 | test_loc 'LT torture end.'; |
d5ac8da0 |
51 | @_ = $n; |
52 | goto &$r; |
53 | }, |
54 | $b |
55 | ); |
56 | goto &$f; |
57 | }, |
58 | $a |
59 | ); |
60 | goto &$f; |
61 | }, |
62 | sub { |
63 | my $r = shift; |
64 | my $f = shift; |
65 | @_ = sub { |
66 | my $r = shift; |
67 | my $x = shift; |
68 | @_ = sub { |
69 | my $r = shift; |
70 | my $y = shift; |
b9c259ea |
71 | test_loc 'LT torture body.'; |
d5ac8da0 |
72 | if ($x && $y) { |
73 | @_ = ( |
74 | sub { |
75 | my $f = shift; |
76 | @_ = ($r, ($x & $y) << 1); |
77 | goto &$f; |
78 | }, |
79 | $x ^ $y |
80 | ); |
81 | goto &$f; |
82 | } |
83 | @_ = $x ^ $y; |
84 | goto &$r; |
85 | }; |
86 | goto &$r; |
87 | }; |
88 | goto &$r; |
89 | } |
90 | ); |
91 | goto &$f; |
92 | }, |
93 | sub { |
94 | my $r = shift; |
95 | my $y = shift; |
96 | @_ = sub { |
97 | my $r = shift; |
98 | my $f = shift; |
99 | @_ = sub { |
100 | my $r = shift; |
101 | my $x = shift; |
102 | @_ = ( |
103 | sub { |
104 | my $f = shift; |
105 | @_ = ($r, $x); |
106 | goto &$f; |
107 | }, |
108 | sub { |
109 | my $r = shift; |
110 | my $x = shift; |
111 | @_ = ( |
112 | sub { |
113 | my $g = shift; |
114 | @_ = ( |
115 | sub { |
116 | my $f = shift; |
117 | @_ = ($r, $x); |
118 | goto &$f; |
119 | }, |
120 | $f |
121 | ); |
122 | goto &$g; |
123 | }, |
124 | $y |
125 | ); |
126 | goto &$y; |
127 | } |
128 | ); |
129 | goto &$f; |
130 | }; |
131 | goto &$r; |
132 | }; |
133 | goto &$r; |
134 | } |
135 | ); |
136 | |
137 | goto & { |
138 | sub { |
139 | my $r = shift; |
140 | my $f = shift; |
b9c259ea |
141 | test_loc 'LT torture boot.'; |
d5ac8da0 |
142 | @_ = ($r, $f); |
143 | goto &$f; |
144 | } |
145 | }; |
146 | |
147 | }->(sub { my $n = shift; is $n, 2, '1 + 1 = 2' }, 1, 1); |
148 | |
f15a0819 |
149 | { |
150 | #local $TODO = 'line numbers all fucked up'; |
d5ac8da0 |
151 | |
152 | fun ($r, $a, $b) { |
b9c259ea |
153 | test_loc 'LX torture begin.'; |
d5ac8da0 |
154 | use integer; |
b9c259ea |
155 | test_loc 'LX torture A.'; |
156 | @_ = ( do { test_loc 'LX torture A-post.'; () }, |
157 | do { test_loc 'LX torture B-pre.'; () }, fun ($f) { test_loc 'LX torture B-pre.'; |
158 | test_loc 'LX torture B.'; |
d5ac8da0 |
159 | @_ = ( |
160 | fun ($f) { |
b9c259ea |
161 | test_loc 'LX torture C.'; |
d5ac8da0 |
162 | @_ = ( |
163 | fun ($f) { |
b9c259ea |
164 | test_loc 'LX torture D.'; |
d5ac8da0 |
165 | @_ = ( |
166 | fun ($n) { |
b9c259ea |
167 | test_loc 'LX torture end.'; |
d5ac8da0 |
168 | @_ = $n; |
169 | goto &$r; |
170 | }, |
171 | $b |
172 | ); |
173 | goto &$f; |
174 | }, |
175 | $a |
176 | ); |
177 | goto &$f; |
178 | }, |
179 | fun ($r, $f) { |
180 | @_ = fun ($r, $x) { |
181 | @_ = fun ($r, $y) { |
b9c259ea |
182 | test_loc 'LX torture body.'; |
d5ac8da0 |
183 | if ($x && $y) { |
184 | @_ = ( |
185 | fun ($f) { |
186 | @_ = ($r, ($x & $y) << 1); |
187 | goto &$f; |
188 | }, |
189 | $x ^ $y |
190 | ); |
191 | goto &$f; |
192 | } |
193 | @_ = $x ^ $y; |
194 | goto &$r; |
195 | }; |
196 | goto &$r; |
197 | }; |
198 | goto &$r; |
199 | } |
200 | ); |
201 | goto &$f; |
202 | }, |
203 | fun ($r, $y) { |
204 | @_ = fun ($r, $f) { |
205 | @_ = fun ($r, $x) { |
206 | @_ = ( |
207 | fun ($f) { |
208 | @_ = ($r, $x); |
209 | goto &$f; |
210 | }, |
211 | fun ($r, $x) { |
212 | @_ = ( |
213 | fun ($g) { |
214 | @_ = ( |
215 | fun ($f) { |
216 | @_ = ($r, $x); |
217 | goto &$f; |
218 | }, |
219 | $f |
220 | ); |
221 | goto &$g; |
222 | }, |
223 | $y |
224 | ); |
225 | goto &$y; |
226 | } |
227 | ); |
228 | goto &$f; |
229 | }; |
230 | goto &$r; |
231 | }; |
232 | goto &$r; |
233 | } |
234 | ); |
235 | |
236 | goto & { |
237 | fun ($r, $f) { |
b9c259ea |
238 | test_loc 'LX torture boot.'; |
d5ac8da0 |
239 | @_ = ($r, $f); |
240 | goto &$f; |
241 | } |
242 | }; |
243 | |
244 | }->(fun ($n) { is $n, 2, '1 + 1 = 2' }, 1, 1); |
245 | |
246 | } |
247 | |
248 | done_testing; |
249 | __DATA__ |