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 => 86 * 8;
  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 __DATA__
  75
  76 $obj = Hlagh->new;
  77 ####
  78 $obj = Hlagh->new();
  79 ####
  80 $obj = Hlagh->new(1);
  81 ####
  82 $obj = Hlagh->new(q{foo}, bar => $obj);
  83 ####
  84 $obj = Hlagh   ->   new   ;
  85 ####
  86 $obj = Hlagh   ->   new   (   )   ;
  87 ####
  88 $obj = Hlagh   ->   new   (   1   )   ;
  89 ####
  90 $obj = Hlagh   ->   new   (   'foo'   ,   bar =>   $obj   );
  91 ####
  92 $obj = Hlagh
  93             ->
  94                           new   ;
  95 ####
  96 $obj = Hlagh
  97
  98       ->
  99 new   (
 100  )   ;
 101 ####
 102 $obj = Hlagh
 103                                        ->   new   (
 104                1   )   ;
 105 ####
 106 $obj = Hlagh   ->
 107                               new   (   "foo"
 108   ,    bar
 109                =>        $obj       );
 110 ####
 111 $obj = new->new;
 112 ####
 113 $obj = new->new; # new new
 114 ####
 115 $obj = new->newnew;
 116 ####
 117 $obj = newnew->new;
 118 ####
 119 $obj = Hlagh->$cb;
 120 ####
 121 $obj = Hlagh->$cb();
 122 ####
 123 $obj = Hlagh->$cb($pkg);
 124 ####
 125 $obj = Hlagh->$cb(sub { 'foo' },  bar => $obj);
 126 ####
 127 $obj = Hlagh->$meth;
 128 ####
 129 $obj =   Hlagh
 130    ->
 131           $meth   ( 1,   2   );
 132 ####
 133 $obj = $pkg->new   ;
 134 ####
 135 $obj = $pkg  ->   new  (   );
 136 ####
 137 $obj = $pkg
 138            ->
 139         new ( $pkg );
 140 ####
 141 $obj =
 142          $pkg
 143 ->
 144 new        (     qr/foo/,
 145       foo => qr/bar/   );
 146 ####
 147 $obj
 148   =
 149 $pkg
 150 ->
 151 $cb
 152 ;
 153 ####
 154 $obj = $pkg    ->   ($cb)   ();
 155 ####
 156 $obj = $pkg->$cb( $obj  );
 157 ####
 158 $obj = $pkg->$cb(qw/foo bar baz/);
 159 ####
 160 $obj = $pkg->$meth;
 161 ####
 162 $obj
 163  =
 164     $pkg
 165           ->
 166               $meth
 167   ( 1 .. 10 );
 168 ####
 169 $obj = $y->$cb;
 170 ####
 171 $obj =  $y
 172   ->          $cb   (
 173   'foo', 1, 2, 'bar'
 174 );
 175 ####
 176 $obj = $y->$meth;
 177 ####
 178 $obj =
 179   $y->
 180       $meth   (
 181  qr(hello),
 182 );
 183 ####
 184 meh;
 185 ####
 186 meh $_;
 187 ####
 188 meh $x;
 189 ####
 190 meh $x, 1, 2;
 191 ####
 192 meh $y;
 193 ####
 194 meh $y, 1, 2;
 195 #### $] < 5.010 # use feature 'state'; state $z
 196 meh $z;
 197 #### $] < 5.010 # use feature 'state'; state $z
 198 meh $z, 1, 2;
 199 ####
 200 print;
 201 ####
 202 print $_;
 203 ####
 204 print $x;
 205 ####
 206 print $x "oh hai\n";
 207 ####
 208 print $y;
 209 ####
 210 print $y "dongs\n";
 211 #### $] < 5.010 # use feature 'state'; state $z
 212 print $z;
 213 #### $] < 5.010 # use feature 'state'; state $z
 214 print $z "hlagh\n";
 215 ####
 216 print STDOUT "bananananananana\n";
 217 ####
 218 $x->foo($pkg->$cb)
 219 ####
 220 $obj = "apple ${\($x->new)} pear"
 221 ####
 222 $obj = "apple @{[$x->new]} pear"
 223 ####
 224 $obj = "apple ${\($y->new)} pear"
 225 ####
 226 $obj = "apple @{[$y->new]} pear"
 227 ####
 228 $obj = "apple ${\($x->$cb)} pear"
 229 ####
 230 $obj = "apple @{[$x->$cb]} pear"
 231 ####
 232 $obj = "apple ${\($y->$cb)} pear"
 233 ####
 234 $obj = "apple @{[$y->$cb]} pear"
 235 ####
 236 $obj = "apple ${\($x->$meth)} pear"
 237 ####
 238 $obj = "apple @{[$x->$meth]} pear"
 239 ####
 240 $obj = "apple ${\($y->$meth)} pear"
 241 ####
 242 $obj = "apple @{[$y->$meth]} pear"
 243 #### # local $_ = "foo";
 244 s/foo/return; Hlagh->new/e;
 245 #### # local $_ = "bar";
 246 s/foo/return; Hlagh->new/e;
 247 #### # local $_ = "foo";
 248 s/foo/return; Hlagh->$cb/e;
 249 #### # local $_ = "bar";
 250 s/foo/return; Hlagh->$cb/e;
 251 #### # local $_ = "foo";
 252 s/foo/return; Hlagh->$meth/e;
 253 #### # local $_ = "bar";
 254 s/foo/return; Hlagh->$meth/e;
 255 #### # local $_ = "foo";
 256 s/foo/return; $pkg->new/e;
 257 #### # local $_ = "bar";
 258 s/foo/return; $pkg->new/e;
 259 #### # local $_ = "foo";
 260 s/foo/return; $pkg->$cb/e;
 261 #### # local $_ = "bar";
 262 s/foo/return; $pkg->$cb/e;
 263 #### # local $_ = "foo";
 264 s/foo/return; $pkg->$meth/e;
 265 #### # local $_ = "bar";
 266 s/foo/return; $pkg->$meth/e;
 267 ####
 268 exec $x $x, @a;
 269 ####
 270 exec { $a[0] } @a;
 271 ####
 272 system $x $x, @a;
 273 ####
 274 system { $a[0] } @a;
 275 ####
 276 zap { };
 277 ####
 278 zap { 1; };
 279 ####
 280 zap { 1; 1; };
 281 ####
 282 zap { zap { }; 1; };