12 use Test::More tests => 119 * 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;
52 try "return; $prefix; use indirect; $_";
53 is $@, '', "use indirect: $_";
54 is @warns, 0, 'no reports';
56 try "return; $prefix; no indirect; $_";
57 is $@, '', "no indirect: $_";
58 is @warns, 0, 'no reports';
65 try "return; $prefix; use indirect; $_";
66 is $@, '', "use indirect, defined: $_";
67 is @warns, 0, 'no reports';
69 try "return; $prefix; no indirect; $_";
70 is $@, '', "no indirect, defined: $_";
71 is @warns, 0, 'no reports';
77 # These tests must be run outside of eval to be meaningful.
79 sub Zlott::Owww::new { }
81 my (@warns, $hook, $desc, $id);
83 $hook = sub { push @warns, indirect::msg(@_) };
84 $desc = "test sort and line endings %d: no indirect construct";
90 no indirect hook => $hook;
91 my @stuff = sort Zlott::Owww
94 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
98 no indirect hook => $hook;
99 my @stuff = sort Zlott::Owww
102 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
104 BEGIN { @warns = () }
106 no indirect hook => $hook;
107 my @stuff = sort Zlott::Owww
110 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
112 BEGIN { @warns = () }
114 no indirect hook => $hook;
115 my @stuff = sort Zlott::Owww
118 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
120 BEGIN { @warns = () }
122 no indirect hook => $hook;
123 my @stuff = sort Zlott::Owww
126 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
128 BEGIN { @warns = () }
130 no indirect hook => $hook;
131 my @stuff = sort Zlott::Owww
134 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
136 BEGIN { @warns = () }
138 no indirect hook => $hook;
139 my @stuff = sort Zlott::Owww
142 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
144 BEGIN { @warns = () }
146 no indirect hook => $hook;
147 my @stuff = sort Zlott::Owww
150 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
152 BEGIN { @warns = () }
154 no indirect hook => $hook;
155 my @stuff = sort Zlott::Owww
158 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
160 BEGIN { @warns = () }
162 no indirect hook => $hook;
163 my @stuff = sort Zlott::Owww
166 BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
177 $obj = Pkg->new(q{foo}, bar => $obj);
181 $obj = Pkg -> new ( ) ;
183 $obj = Pkg -> new ( 1 ) ;
185 $obj = Pkg -> new ( 'foo' , bar => $obj );
208 $obj = new->new; # new new
218 $obj = Pkg->$cb($pkg);
220 $obj = Pkg->$cb(sub { 'foo' }, bar => $obj);
230 $obj = $pkg -> new ( );
249 $obj = $pkg -> ($cb) ();
251 $obj = $pkg->$cb( $obj );
253 $obj = $pkg->$cb(qw<foo bar baz>);
290 #### "$]" < 5.010 # use feature 'state'; state $z
292 #### "$]" < 5.010 # use feature 'state'; state $z
305 print $y "hello thar\n";
306 #### "$]" < 5.010 # use feature 'state'; state $z
308 #### "$]" < 5.010 # use feature 'state'; state $z
311 print STDOUT "bananananananana\n";
315 $obj = "apple ${\($x->new)} pear"
317 $obj = "apple @{[$x->new]} pear"
319 $obj = "apple ${\($y->new)} pear"
321 $obj = "apple @{[$y->new]} pear"
323 $obj = "apple ${\($x->$cb)} pear"
325 $obj = "apple @{[$x->$cb]} pear"
327 $obj = "apple ${\($y->$cb)} pear"
329 $obj = "apple @{[$y->$cb]} pear"
331 $obj = "apple ${\($x->$meth)} pear"
333 $obj = "apple @{[$x->$meth]} pear"
335 $obj = "apple ${\($y->$meth)} pear"
337 $obj = "apple @{[$y->$meth]} pear"
338 #### # local $_ = "foo";
339 s/foo/return; Pkg->new/e;
340 #### # local $_ = "bar";
341 s/foo/return; Pkg->new/e;
342 #### # local $_ = "foo";
343 s/foo/return; Pkg->$cb/e;
344 #### # local $_ = "bar";
345 s/foo/return; Pkg->$cb/e;
346 #### # local $_ = "foo";
347 s/foo/return; Pkg->$meth/e;
348 #### # local $_ = "bar";
349 s/foo/return; Pkg->$meth/e;
350 #### # local $_ = "foo";
351 s/foo/return; $x->new/e;
352 #### # local $_ = "bar";
353 s/foo/return; $x->new/e;
354 #### # local $_ = "foo";
355 s/foo/return; $x->$cb/e;
356 #### # local $_ = "bar";
357 s/foo/return; $x->$cb/e;
358 #### # local $_ = "foo";
359 s/foo/return; $x->$meth/e;
360 #### # local $_ = "bar";
361 s/foo/return; $x->$meth/e;
362 #### # local $_ = "foo";
363 s/foo/return; $y->new/e;
364 #### # local $_ = "bar";
365 s/foo/return; $y->new/e;
366 #### # local $_ = "foo";
367 s/foo/return; $y->$cb/e;
368 #### # local $_ = "bar";
369 s/foo/return; $y->$cb/e;
370 #### # local $_ = "foo";
371 s/foo/return; $y->$meth/e;
372 #### # local $_ = "bar";
373 s/foo/return; $y->$meth/e;
375 "foo" =~ /(?{Pkg->new})/;
377 "foo" =~ /(?{Pkg->$cb})/;
379 "foo" =~ /(?{Pkg->$meth})/;
381 "foo" =~ /(?{$x->new})/;
383 "foo" =~ /(?{$x->$cb})/;
385 "foo" =~ /(?{$x->$meth})/;
387 "foo" =~ /(?{$y->new})/;
389 "foo" =~ /(?{$y->$cb})/;
391 "foo" =~ /(?{$y->$meth})/;
435 return $self->new ? $self : undef;
440 return $self ? $self->new : undef;
445 return $_[0] ? undef : $self->new;
452 __PACKAGE__->new # Hurp
459 __PACKAGE__->new # __PACKAGE_
462 __PACKAGE_->new # __PACKAGE__
464 package __PACKAGE___;
465 __PACKAGE__->new # __PACKAGE___
467 package __PACKAGE___;
468 __PACKAGE___->new # __PACKAGE__