document Moose fallback for ::Info
[p5sagit/Function-Parameters.git] / t / lineno-torture.t
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 {
27         test_loc 'LT torture begin.';
28         use integer;
29         my $r = shift;
30
31         my $a = shift;
32         my $b = shift;
33
34         test_loc 'LT torture A.';
35         @_ = (
36                 sub {
37                         my $f = shift;
38                         test_loc 'LT torture B.';
39                         @_ = (
40                                 sub {
41                                         my $f = shift;
42                                         test_loc 'LT torture C.';
43                                         @_ = (
44                                                 sub {
45                                                         my $f = shift;
46                                                         test_loc 'LT torture D.';
47                                                         @_ = (
48                                                                 sub {
49                                                                         my $n = shift;
50                                                                         test_loc 'LT torture end.';
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;
71                                                         test_loc 'LT torture body.';
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;
141                         test_loc 'LT torture boot.';
142                         @_ = ($r, $f);
143                         goto &$f;
144                 }
145         };
146
147 }->(sub { my $n = shift; is $n, 2, '1 + 1 = 2' }, 1, 1);
148
149 {
150         #local $TODO = 'line numbers all fucked up';
151
152         fun ($r, $a, $b) {
153                 test_loc 'LX torture begin.';
154                 use integer;
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.';
159                                 @_ = (
160                                         fun ($f) {
161                                                 test_loc 'LX torture C.';
162                                                 @_ = (
163                                                         fun ($f) {
164                                                                 test_loc 'LX torture D.';
165                                                                 @_ = (
166                                                                         fun ($n) {
167                                                                                 test_loc 'LX torture end.';
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) {
182                                                                 test_loc 'LX torture body.';
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) {
238                                 test_loc 'LX torture boot.';
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__