d958a1353ca73f546098bcae24c6efbe22441622
[perl/modules/indirect.git] / t / 20-good.t
1 #!perl -T
2
3 package Dongs;
4
5 sub new;
6
7 package main;
8
9 use strict;
10 use warnings;
11
12 use Test::More tests => 109 * 8 + 10;
13
14 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
15
16 my ($obj, $pkg, $cb, $x, @a);
17 our ($y, $meth);
18 sub meh;
19 sub zap (&);
20
21 my @warns;
22
23 sub try {
24  my ($code) = @_;
25
26  @warns = ();
27  {
28   local $SIG{__WARN__} = sub { push @warns, @_ };
29   eval $code;
30  }
31 }
32
33 {
34  local $/ = "####";
35  while (<DATA>) {
36   chomp;
37   s/\s*$//;
38   s/(.*?)$//m;
39   my ($skip, $prefix) = split /#+/, $1;
40   $skip   = 0  unless defined $skip;
41   $prefix = '' unless defined $prefix;
42   s/\s*//;
43
44 SKIP:
45   {
46    skip "$_: $skip" => 8 if eval $skip;
47
48    {
49     try "return; $prefix; use indirect; $_";
50     is $@,     '', "use indirect: $_";
51     is @warns, 0,  'no reports';
52
53     try "return; $prefix; no indirect; $_";
54     is $@,     '', "no indirect: $_";
55     is @warns, 0,  'no reports';
56    }
57
58    {
59     local $_ = $_;
60     s/Hlagh/Dongs/g;
61
62     try "return; $prefix; use indirect; $_";
63     is $@,     '', "use indirect, defined: $_";
64     is @warns, 0,  'no reports';
65
66     try "return; $prefix; no indirect; $_";
67     is $@,     '', "no indirect, defined: $_";
68     is @warns, 0,  'no reports';
69    }
70   }
71  }
72 }
73
74 # These tests must be run outside of eval to be meaningful.
75 {
76  sub Zlott::Owww::new { }
77
78  my (@warns, $hook, $desc, $id);
79  BEGIN {
80   $hook = sub { push @warns, indirect::msg(@_) };
81   $desc = "test sort and line endings %d: no indirect construct";
82   $id   = 1;
83  }
84
85  BEGIN { @warns = () }
86  {
87   no indirect hook => $hook;
88   my @stuff = sort Zlott::Owww
89           ->new;
90  }
91  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
92
93  BEGIN { @warns = () }
94  {
95   no indirect hook => $hook;
96   my @stuff = sort Zlott::Owww
97                ->new;
98  };
99  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
100
101  BEGIN { @warns = () }
102  {
103   no indirect hook => $hook;
104   my @stuff = sort Zlott::Owww
105                  ->new;
106  }
107  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
108
109  BEGIN { @warns = () }
110  {
111   no indirect hook => $hook;
112   my @stuff = sort Zlott::Owww
113                   ->new;
114  }
115  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
116
117  BEGIN { @warns = () }
118  {
119   no indirect hook => $hook;
120   my @stuff = sort Zlott::Owww
121                    ->new;
122  }
123  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
124
125  BEGIN { @warns = () }
126  {
127   no indirect hook => $hook;
128   my @stuff = sort Zlott::Owww
129                      ->new;
130  }
131  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
132
133  BEGIN { @warns = () }
134  {
135   no indirect hook => $hook;
136   my @stuff = sort Zlott::Owww
137                        ->new;
138  }
139  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
140
141  BEGIN { @warns = () }
142  {
143   no indirect hook => $hook;
144   my @stuff = sort Zlott::Owww
145                           ->new;
146  }
147  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
148
149  BEGIN { @warns = () }
150  {
151   no indirect hook => $hook;
152   my @stuff = sort Zlott::Owww
153                             ->new;
154  }
155  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
156
157  BEGIN { @warns = () }
158  {
159   no indirect hook => $hook;
160   my @stuff = sort Zlott::Owww
161                              ->new;
162  }
163  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
164 }
165
166 __DATA__
167
168 $obj = Hlagh->new;
169 ####
170 $obj = Hlagh->new();
171 ####
172 $obj = Hlagh->new(1);
173 ####
174 $obj = Hlagh->new(q{foo}, bar => $obj);
175 ####
176 $obj = Hlagh   ->   new   ;
177 ####
178 $obj = Hlagh   ->   new   (   )   ;
179 ####
180 $obj = Hlagh   ->   new   (   1   )   ;
181 ####
182 $obj = Hlagh   ->   new   (   'foo'   ,   bar =>   $obj   );
183 ####
184 $obj = Hlagh
185             ->
186                           new   ;
187 ####
188 $obj = Hlagh  
189
190       ->   
191 new   ( 
192  )   ;
193 ####
194 $obj = Hlagh
195                                        ->   new   ( 
196                1   )   ;
197 ####
198 $obj = Hlagh   ->
199                               new   (   "foo"
200   ,    bar     
201                =>        $obj       );
202 ####
203 $obj = new->new;
204 ####
205 $obj = new->new; # new new
206 ####
207 $obj = new->newnew;
208 ####
209 $obj = newnew->new;
210 ####
211 $obj = Hlagh->$cb;
212 ####
213 $obj = Hlagh->$cb();
214 ####
215 $obj = Hlagh->$cb($pkg);
216 ####
217 $obj = Hlagh->$cb(sub { 'foo' },  bar => $obj);
218 ####
219 $obj = Hlagh->$meth;
220 ####
221 $obj =   Hlagh
222    -> 
223           $meth   ( 1,   2   );
224 ####
225 $obj = $pkg->new   ;
226 ####
227 $obj = $pkg  ->   new  (   );
228 ####
229 $obj = $pkg       
230            -> 
231         new ( $pkg );
232 ####
233 $obj = 
234          $pkg
235 ->
236 new        (     qr/foo/,
237       foo => qr/bar/   );
238 ####
239 $obj 
240   =  
241 $pkg
242 ->
243 $cb
244 ;
245 ####
246 $obj = $pkg    ->   ($cb)   ();
247 ####
248 $obj = $pkg->$cb( $obj  );
249 ####
250 $obj = $pkg->$cb(qw<foo bar baz>);
251 ####
252 $obj = $pkg->$meth;
253 ####
254 $obj 
255  =
256     $pkg
257           ->
258               $meth
259   ( 1 .. 10 );
260 ####
261 $obj = $y->$cb;
262 ####
263 $obj =  $y
264   ->          $cb   (
265   'foo', 1, 2, 'bar'
266 );
267 ####
268 $obj = $y->$meth;
269 ####
270 $obj =
271   $y->
272       $meth   (
273  qr(hello),
274 );
275 ####
276 meh;
277 ####
278 meh $_;
279 ####
280 meh $x;
281 ####
282 meh $x, 1, 2;
283 ####
284 meh $y;
285 ####
286 meh $y, 1, 2;
287 #### "$]" < 5.010 # use feature 'state'; state $z
288 meh $z;
289 #### "$]" < 5.010 # use feature 'state'; state $z
290 meh $z, 1, 2;
291 ####
292 print;
293 ####
294 print $_;
295 ####
296 print $x;
297 ####
298 print $x "oh hai\n";
299 ####
300 print $y;
301 ####
302 print $y "dongs\n";
303 #### "$]" < 5.010 # use feature 'state'; state $z
304 print $z;
305 #### "$]" < 5.010 # use feature 'state'; state $z
306 print $z "hlagh\n";
307 ####
308 print STDOUT "bananananananana\n";
309 ####
310 $x->foo($pkg->$cb)
311 ####
312 $obj = "apple ${\($x->new)} pear"
313 ####
314 $obj = "apple @{[$x->new]} pear"
315 ####
316 $obj = "apple ${\($y->new)} pear"
317 ####
318 $obj = "apple @{[$y->new]} pear"
319 ####
320 $obj = "apple ${\($x->$cb)} pear"
321 ####
322 $obj = "apple @{[$x->$cb]} pear"
323 ####
324 $obj = "apple ${\($y->$cb)} pear"
325 ####
326 $obj = "apple @{[$y->$cb]} pear"
327 ####
328 $obj = "apple ${\($x->$meth)} pear"
329 ####
330 $obj = "apple @{[$x->$meth]} pear"
331 ####
332 $obj = "apple ${\($y->$meth)} pear"
333 ####
334 $obj = "apple @{[$y->$meth]} pear"
335 #### # local $_ = "foo";
336 s/foo/return; Hlagh->new/e;
337 #### # local $_ = "bar";
338 s/foo/return; Hlagh->new/e;
339 #### # local $_ = "foo";
340 s/foo/return; Hlagh->$cb/e;
341 #### # local $_ = "bar";
342 s/foo/return; Hlagh->$cb/e;
343 #### # local $_ = "foo";
344 s/foo/return; Hlagh->$meth/e;
345 #### # local $_ = "bar";
346 s/foo/return; Hlagh->$meth/e;
347 #### # local $_ = "foo";
348 s/foo/return; $x->new/e;
349 #### # local $_ = "bar";
350 s/foo/return; $x->new/e;
351 #### # local $_ = "foo";
352 s/foo/return; $x->$cb/e;
353 #### # local $_ = "bar";
354 s/foo/return; $x->$cb/e;
355 #### # local $_ = "foo";
356 s/foo/return; $x->$meth/e;
357 #### # local $_ = "bar";
358 s/foo/return; $x->$meth/e;
359 #### # local $_ = "foo";
360 s/foo/return; $y->new/e;
361 #### # local $_ = "bar";
362 s/foo/return; $y->new/e;
363 #### # local $_ = "foo";
364 s/foo/return; $y->$cb/e;
365 #### # local $_ = "bar";
366 s/foo/return; $y->$cb/e;
367 #### # local $_ = "foo";
368 s/foo/return; $y->$meth/e;
369 #### # local $_ = "bar";
370 s/foo/return; $y->$meth/e;
371 ####
372 "foo" =~ /(?{Hlagh->new})/;
373 ####
374 "foo" =~ /(?{Hlagh->$cb})/;
375 ####
376 "foo" =~ /(?{Hlagh->$meth})/;
377 ####
378 "foo" =~ /(?{$x->new})/;
379 ####
380 "foo" =~ /(?{$x->$cb})/;
381 ####
382 "foo" =~ /(?{$x->$meth})/;
383 ####
384 "foo" =~ /(?{$y->new})/;
385 ####
386 "foo" =~ /(?{$y->$cb})/;
387 ####
388 "foo" =~ /(?{$y->$meth})/;
389 ####
390 exec $x $x, @a;
391 ####
392 exec { $a[0] } @a;
393 ####
394 system $x $x, @a;
395 ####
396 system { $a[0] } @a;
397 ####
398 zap { };
399 ####
400 zap { 1; };
401 ####
402 zap { 1; 1; };
403 ####
404 zap { zap { }; 1; };
405 ####
406 my @stuff = sort Hlagh
407      ->new;
408 ####
409 my @stuff = sort Hlagh
410               ->new;
411 ####
412 my @stuff = sort Hlagh
413                ->new;
414 ####
415 my @stuff = sort Hlagh
416                 ->new;
417 ####
418 my @stuff = sort Hlagh
419                  ->new;
420 ####
421 my @stuff = sort Hlagh
422                    ->new;
423 ####
424 my @stuff = sort Hlagh
425                      ->new;
426 ####
427 my @stuff = sort Hlagh
428                         ->new;