X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=t%2F20-good.t;h=d57de4f0cc009fe71835634ebbfa3f1790c410ff;hp=4a7c3a0fa0fa6e7860787e759ac4e0725860e5de;hb=refs%2Ftags%2Frt83839;hpb=c7b10fa5c0fe7243236bf0efa9a33776bafdc5c1

diff --git a/t/20-good.t b/t/20-good.t
index 4a7c3a0..d57de4f 100644
--- a/t/20-good.t
+++ b/t/20-good.t
@@ -9,10 +9,12 @@ package main;
 use strict;
 use warnings;
 
-use Test::More tests => 56 * 8;
+use Test::More tests => 112 * 8 + 10;
+
+BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
 
 my ($obj, $pkg, $cb, $x, @a);
-our $y;
+our ($y, $meth);
 sub meh;
 sub zap (&);
 
@@ -69,6 +71,98 @@ SKIP:
  }
 }
 
+# These tests must be run outside of eval to be meaningful.
+{
+ sub Zlott::Owww::new { }
+
+ my (@warns, $hook, $desc, $id);
+ BEGIN {
+  $hook = sub { push @warns, indirect::msg(@_) };
+  $desc = "test sort and line endings %d: no indirect construct";
+  $id   = 1;
+ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+          ->new;
+ }
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+               ->new;
+ };
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+                 ->new;
+ }
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+                  ->new;
+ }
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+                   ->new;
+ }
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+                     ->new;
+ }
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+                       ->new;
+ }
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+                          ->new;
+ }
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+                            ->new;
+ }
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+
+ BEGIN { @warns = () }
+ {
+  no indirect hook => $hook;
+  my @stuff = sort Zlott::Owww
+                             ->new;
+ }
+ BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
+}
+
 __DATA__
 
 $obj = Hlagh->new;
@@ -122,6 +216,12 @@ $obj = Hlagh->$cb($pkg);
 ####
 $obj = Hlagh->$cb(sub { 'foo' },  bar => $obj);
 ####
+$obj = Hlagh->$meth;
+####
+$obj =   Hlagh
+   -> 
+          $meth   ( 1,   2   );
+####
 $obj = $pkg->new   ;
 ####
 $obj = $pkg  ->   new  (   );
@@ -147,7 +247,31 @@ $obj = $pkg    ->   ($cb)   ();
 ####
 $obj = $pkg->$cb( $obj  );
 ####
-$obj = $pkg->$cb(qw/foo bar baz/);
+$obj = $pkg->$cb(qw<foo bar baz>);
+####
+$obj = $pkg->$meth;
+####
+$obj 
+ =
+    $pkg
+          ->
+              $meth
+  ( 1 .. 10 );
+####
+$obj = $y->$cb;
+####
+$obj =  $y
+  ->          $cb   (
+  'foo', 1, 2, 'bar'
+);
+####
+$obj = $y->$meth;
+####
+$obj =
+  $y->
+      $meth   (
+ qr(hello),
+);
 ####
 meh;
 ####
@@ -160,9 +284,9 @@ meh $x, 1, 2;
 meh $y;
 ####
 meh $y, 1, 2;
-#### $] < 5.010 # use feature 'state'; state $z
+#### "$]" < 5.010 # use feature 'state'; state $z
 meh $z;
-#### $] < 5.010 # use feature 'state'; state $z
+#### "$]" < 5.010 # use feature 'state'; state $z
 meh $z, 1, 2;
 ####
 print;
@@ -176,18 +300,92 @@ print $x "oh hai\n";
 print $y;
 ####
 print $y "dongs\n";
-#### $] < 5.010 # use feature 'state'; state $z
+#### "$]" < 5.010 # use feature 'state'; state $z
 print $z;
-#### $] < 5.010 # use feature 'state'; state $z
+#### "$]" < 5.010 # use feature 'state'; state $z
 print $z "hlagh\n";
 ####
 print STDOUT "bananananananana\n";
 ####
 $x->foo($pkg->$cb)
 ####
-$obj = "apple ${\(new Hlagh)} pear"
+$obj = "apple ${\($x->new)} pear"
+####
+$obj = "apple @{[$x->new]} pear"
+####
+$obj = "apple ${\($y->new)} pear"
+####
+$obj = "apple @{[$y->new]} pear"
+####
+$obj = "apple ${\($x->$cb)} pear"
+####
+$obj = "apple @{[$x->$cb]} pear"
+####
+$obj = "apple ${\($y->$cb)} pear"
+####
+$obj = "apple @{[$y->$cb]} pear"
+####
+$obj = "apple ${\($x->$meth)} pear"
+####
+$obj = "apple @{[$x->$meth]} pear"
+####
+$obj = "apple ${\($y->$meth)} pear"
+####
+$obj = "apple @{[$y->$meth]} pear"
+#### # local $_ = "foo";
+s/foo/return; Hlagh->new/e;
+#### # local $_ = "bar";
+s/foo/return; Hlagh->new/e;
+#### # local $_ = "foo";
+s/foo/return; Hlagh->$cb/e;
+#### # local $_ = "bar";
+s/foo/return; Hlagh->$cb/e;
+#### # local $_ = "foo";
+s/foo/return; Hlagh->$meth/e;
+#### # local $_ = "bar";
+s/foo/return; Hlagh->$meth/e;
+#### # local $_ = "foo";
+s/foo/return; $x->new/e;
+#### # local $_ = "bar";
+s/foo/return; $x->new/e;
+#### # local $_ = "foo";
+s/foo/return; $x->$cb/e;
+#### # local $_ = "bar";
+s/foo/return; $x->$cb/e;
+#### # local $_ = "foo";
+s/foo/return; $x->$meth/e;
+#### # local $_ = "bar";
+s/foo/return; $x->$meth/e;
+#### # local $_ = "foo";
+s/foo/return; $y->new/e;
+#### # local $_ = "bar";
+s/foo/return; $y->new/e;
+#### # local $_ = "foo";
+s/foo/return; $y->$cb/e;
+#### # local $_ = "bar";
+s/foo/return; $y->$cb/e;
+#### # local $_ = "foo";
+s/foo/return; $y->$meth/e;
+#### # local $_ = "bar";
+s/foo/return; $y->$meth/e;
+####
+"foo" =~ /(?{Hlagh->new})/;
+####
+"foo" =~ /(?{Hlagh->$cb})/;
+####
+"foo" =~ /(?{Hlagh->$meth})/;
 ####
-$obj = "apple @{[new Hlagh]} pear"
+"foo" =~ /(?{$x->new})/;
+####
+"foo" =~ /(?{$x->$cb})/;
+####
+"foo" =~ /(?{$x->$meth})/;
+####
+"foo" =~ /(?{$y->new})/;
+####
+"foo" =~ /(?{$y->$cb})/;
+####
+"foo" =~ /(?{$y->$meth})/;
 ####
 exec $x $x, @a;
 ####
@@ -204,3 +402,42 @@ zap { 1; };
 zap { 1; 1; };
 ####
 zap { zap { }; 1; };
+####
+my @stuff = sort Hlagh
+     ->new;
+####
+my @stuff = sort Hlagh
+              ->new;
+####
+my @stuff = sort Hlagh
+               ->new;
+####
+my @stuff = sort Hlagh
+                ->new;
+####
+my @stuff = sort Hlagh
+                 ->new;
+####
+my @stuff = sort Hlagh
+                   ->new;
+####
+my @stuff = sort Hlagh
+                     ->new;
+####
+my @stuff = sort Hlagh
+                        ->new;
+####
+sub {
+ my $self = shift;
+ return $self->new ? $self : undef;
+}
+####
+sub {
+ my $self = shift;
+ return $self ? $self->new : undef;
+}
+####
+sub {
+ my $self = shift;
+ return $_[0] ? undef : $self->new;
+}