12 use Test::More tests => 109 * 8 + 10;
14 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
16 my ($obj, $pkg, $cb, $x, @a);
28 local $SIG{__WARN__} = sub { push @warns, @_ };
39 my ($skip, $prefix) = split /#+/, $1;
40 $skip = 0 unless defined $skip;
41 $prefix = '' unless defined $prefix;
46 skip "$_: $skip" => 8 if eval $skip;
49 try "return; $prefix; use indirect; $_";
50 is $@, '', "use indirect: $_";
51 is @warns, 0, 'no reports';
53 try "return; $prefix; no indirect; $_";
54 is $@, '', "no indirect: $_";
55 is @warns, 0, 'no reports';
62 try "return; $prefix; use indirect; $_";
63 is $@, '', "use indirect, defined: $_";
64 is @warns, 0, 'no reports';
66 try "return; $prefix; no indirect; $_";
67 is $@, '', "no indirect, defined: $_";
68 is @warns, 0, 'no reports';
74 # These tests must be run outside of eval to be meaningful.
76 sub Zlott::Owww::new { }
78 my (@warns, $hook, $desc, $id);
80 $hook = sub { push @warns, indirect::msg(@_) };
81 $desc = "test sort and line endings %d: no indirect construct";
87 no indirect hook => $hook;
88 my @stuff = sort Zlott::Owww
91 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
95 no indirect hook => $hook;
96 my @stuff = sort Zlott::Owww
99 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
101 BEGIN { @warns = () }
103 no indirect hook => $hook;
104 my @stuff = sort Zlott::Owww
107 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
109 BEGIN { @warns = () }
111 no indirect hook => $hook;
112 my @stuff = sort Zlott::Owww
115 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
117 BEGIN { @warns = () }
119 no indirect hook => $hook;
120 my @stuff = sort Zlott::Owww
123 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
125 BEGIN { @warns = () }
127 no indirect hook => $hook;
128 my @stuff = sort Zlott::Owww
131 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
133 BEGIN { @warns = () }
135 no indirect hook => $hook;
136 my @stuff = sort Zlott::Owww
139 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
141 BEGIN { @warns = () }
143 no indirect hook => $hook;
144 my @stuff = sort Zlott::Owww
147 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
149 BEGIN { @warns = () }
151 no indirect hook => $hook;
152 my @stuff = sort Zlott::Owww
155 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
157 BEGIN { @warns = () }
159 no indirect hook => $hook;
160 my @stuff = sort Zlott::Owww
163 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
172 $obj = Hlagh->new(1);
174 $obj = Hlagh->new(q{foo}, bar => $obj);
176 $obj = Hlagh -> new ;
178 $obj = Hlagh -> new ( ) ;
180 $obj = Hlagh -> new ( 1 ) ;
182 $obj = Hlagh -> new ( 'foo' , bar => $obj );
205 $obj = new->new; # new new
215 $obj = Hlagh->$cb($pkg);
217 $obj = Hlagh->$cb(sub { 'foo' }, bar => $obj);
227 $obj = $pkg -> new ( );
246 $obj = $pkg -> ($cb) ();
248 $obj = $pkg->$cb( $obj );
250 $obj = $pkg->$cb(qw<foo bar baz>);
287 #### "$]" < 5.010 # use feature 'state'; state $z
289 #### "$]" < 5.010 # use feature 'state'; state $z
303 #### "$]" < 5.010 # use feature 'state'; state $z
305 #### "$]" < 5.010 # use feature 'state'; state $z
308 print STDOUT "bananananananana\n";
312 $obj = "apple ${\($x->new)} pear"
314 $obj = "apple @{[$x->new]} pear"
316 $obj = "apple ${\($y->new)} pear"
318 $obj = "apple @{[$y->new]} pear"
320 $obj = "apple ${\($x->$cb)} pear"
322 $obj = "apple @{[$x->$cb]} pear"
324 $obj = "apple ${\($y->$cb)} pear"
326 $obj = "apple @{[$y->$cb]} pear"
328 $obj = "apple ${\($x->$meth)} pear"
330 $obj = "apple @{[$x->$meth]} pear"
332 $obj = "apple ${\($y->$meth)} pear"
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;
372 "foo" =~ /(?{Hlagh->new})/;
374 "foo" =~ /(?{Hlagh->$cb})/;
376 "foo" =~ /(?{Hlagh->$meth})/;
378 "foo" =~ /(?{$x->new})/;
380 "foo" =~ /(?{$x->$cb})/;
382 "foo" =~ /(?{$x->$meth})/;
384 "foo" =~ /(?{$y->new})/;
386 "foo" =~ /(?{$y->$cb})/;
388 "foo" =~ /(?{$y->$meth})/;
406 my @stuff = sort Hlagh
409 my @stuff = sort Hlagh
412 my @stuff = sort Hlagh
415 my @stuff = sort Hlagh
418 my @stuff = sort Hlagh
421 my @stuff = sort Hlagh
424 my @stuff = sort Hlagh
427 my @stuff = sort Hlagh