t/20-good.t

   1 #!perl -T
   2
   3 package NotEmpty;
   4
   5 sub new;
   6
   7 package main;
   8
   9 use strict;
  10 use warnings;
  11
  12 use Test::More tests => 119 * 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     local $_ = $_;
  50     s/Pkg/Empty/g;
  51
  52     try "return; $prefix; use indirect; $_";
  53     is $@,     '', "use indirect: $_";
  54     is @warns, 0,  'no reports';
  55
  56     try "return; $prefix; no indirect; $_";
  57     is $@,     '', "no indirect: $_";
  58     is @warns, 0,  'no reports';
  59    }
  60
  61    {
  62     local $_ = $_;
  63     s/Pkg/NotEmpty/g;
  64
  65     try "return; $prefix; use indirect; $_";
  66     is $@,     '', "use indirect, defined: $_";
  67     is @warns, 0,  'no reports';
  68
  69     try "return; $prefix; no indirect; $_";
  70     is $@,     '', "no indirect, defined: $_";
  71     is @warns, 0,  'no reports';
  72    }
  73   }
  74  }
  75 }
  76
  77 # These tests must be run outside of eval to be meaningful.
  78 {
  79  sub Zlott::Owww::new { }
  80
  81  my (@warns, $hook, $desc, $id);
  82  BEGIN {
  83   $hook = sub { push @warns, indirect::msg(@_) };
  84   $desc = "test sort and line endings %d: no indirect construct";
  85   $id   = 1;
  86  }
  87
  88  BEGIN { @warns = () }
  89  {
  90   no indirect hook => $hook;
  91   my @stuff = sort Zlott::Owww
  92           ->new;
  93  }
  94  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
  95
  96  BEGIN { @warns = () }
  97  {
  98   no indirect hook => $hook;
  99   my @stuff = sort Zlott::Owww
 100                ->new;
 101  };
 102  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
 103
 104  BEGIN { @warns = () }
 105  {
 106   no indirect hook => $hook;
 107   my @stuff = sort Zlott::Owww
 108                  ->new;
 109  }
 110  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
 111
 112  BEGIN { @warns = () }
 113  {
 114   no indirect hook => $hook;
 115   my @stuff = sort Zlott::Owww
 116                   ->new;
 117  }
 118  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
 119
 120  BEGIN { @warns = () }
 121  {
 122   no indirect hook => $hook;
 123   my @stuff = sort Zlott::Owww
 124                    ->new;
 125  }
 126  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
 127
 128  BEGIN { @warns = () }
 129  {
 130   no indirect hook => $hook;
 131   my @stuff = sort Zlott::Owww
 132                      ->new;
 133  }
 134  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
 135
 136  BEGIN { @warns = () }
 137  {
 138   no indirect hook => $hook;
 139   my @stuff = sort Zlott::Owww
 140                        ->new;
 141  }
 142  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
 143
 144  BEGIN { @warns = () }
 145  {
 146   no indirect hook => $hook;
 147   my @stuff = sort Zlott::Owww
 148                           ->new;
 149  }
 150  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
 151
 152  BEGIN { @warns = () }
 153  {
 154   no indirect hook => $hook;
 155   my @stuff = sort Zlott::Owww
 156                             ->new;
 157  }
 158  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
 159
 160  BEGIN { @warns = () }
 161  {
 162   no indirect hook => $hook;
 163   my @stuff = sort Zlott::Owww
 164                              ->new;
 165  }
 166  BEGIN { is_deeply \@warns, [ ], sprintf $desc, $id++ }
 167 }
 168
 169 __DATA__
 170
 171 $obj = Pkg->new;
 172 ####
 173 $obj = Pkg->new();
 174 ####
 175 $obj = Pkg->new(1);
 176 ####
 177 $obj = Pkg->new(q{foo}, bar => $obj);
 178 ####
 179 $obj = Pkg   ->   new   ;
 180 ####
 181 $obj = Pkg   ->   new   (   )   ;
 182 ####
 183 $obj = Pkg   ->   new   (   1   )   ;
 184 ####
 185 $obj = Pkg   ->   new   (   'foo'   ,   bar =>   $obj   );
 186 ####
 187 $obj = Pkg
 188             ->
 189                           new   ;
 190 ####
 191 $obj = Pkg
 192
 193       ->
 194 new   (
 195  )   ;
 196 ####
 197 $obj = Pkg
 198                                        ->   new   (
 199                1   )   ;
 200 ####
 201 $obj = Pkg   ->
 202                               new   (   "foo"
 203   ,    bar
 204                =>        $obj       );
 205 ####
 206 $obj = new->new;
 207 ####
 208 $obj = new->new; # new new
 209 ####
 210 $obj = new->newnew;
 211 ####
 212 $obj = newnew->new;
 213 ####
 214 $obj = Pkg->$cb;
 215 ####
 216 $obj = Pkg->$cb();
 217 ####
 218 $obj = Pkg->$cb($pkg);
 219 ####
 220 $obj = Pkg->$cb(sub { 'foo' },  bar => $obj);
 221 ####
 222 $obj = Pkg->$meth;
 223 ####
 224 $obj =   Pkg
 225    ->
 226           $meth   ( 1,   2   );
 227 ####
 228 $obj = $pkg->new   ;
 229 ####
 230 $obj = $pkg  ->   new  (   );
 231 ####
 232 $obj = $pkg
 233            ->
 234         new ( $pkg );
 235 ####
 236 $obj =
 237          $pkg
 238 ->
 239 new        (     qr/foo/,
 240       foo => qr/bar/   );
 241 ####
 242 $obj
 243   =
 244 $pkg
 245 ->
 246 $cb
 247 ;
 248 ####
 249 $obj = $pkg    ->   ($cb)   ();
 250 ####
 251 $obj = $pkg->$cb( $obj  );
 252 ####
 253 $obj = $pkg->$cb(qw<foo bar baz>);
 254 ####
 255 $obj = $pkg->$meth;
 256 ####
 257 $obj
 258  =
 259     $pkg
 260           ->
 261               $meth
 262   ( 1 .. 10 );
 263 ####
 264 $obj = $y->$cb;
 265 ####
 266 $obj =  $y
 267   ->          $cb   (
 268   'foo', 1, 2, 'bar'
 269 );
 270 ####
 271 $obj = $y->$meth;
 272 ####
 273 $obj =
 274   $y->
 275       $meth   (
 276  qr(hello),
 277 );
 278 ####
 279 meh;
 280 ####
 281 meh $_;
 282 ####
 283 meh $x;
 284 ####
 285 meh $x, 1, 2;
 286 ####
 287 meh $y;
 288 ####
 289 meh $y, 1, 2;
 290 #### "$]" < 5.010 # use feature 'state'; state $z
 291 meh $z;
 292 #### "$]" < 5.010 # use feature 'state'; state $z
 293 meh $z, 1, 2;
 294 ####
 295 print;
 296 ####
 297 print $_;
 298 ####
 299 print $x;
 300 ####
 301 print $x "oh hai\n";
 302 ####
 303 print $y;
 304 ####
 305 print $y "hello thar\n";
 306 #### "$]" < 5.010 # use feature 'state'; state $z
 307 print $z;
 308 #### "$]" < 5.010 # use feature 'state'; state $z
 309 print $z "lolno\n";
 310 ####
 311 print STDOUT "bananananananana\n";
 312 ####
 313 $x->foo($pkg->$cb)
 314 ####
 315 $obj = "apple ${\($x->new)} pear"
 316 ####
 317 $obj = "apple @{[$x->new]} pear"
 318 ####
 319 $obj = "apple ${\($y->new)} pear"
 320 ####
 321 $obj = "apple @{[$y->new]} pear"
 322 ####
 323 $obj = "apple ${\($x->$cb)} pear"
 324 ####
 325 $obj = "apple @{[$x->$cb]} pear"
 326 ####
 327 $obj = "apple ${\($y->$cb)} pear"
 328 ####
 329 $obj = "apple @{[$y->$cb]} pear"
 330 ####
 331 $obj = "apple ${\($x->$meth)} pear"
 332 ####
 333 $obj = "apple @{[$x->$meth]} pear"
 334 ####
 335 $obj = "apple ${\($y->$meth)} pear"
 336 ####
 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;
 374 ####
 375 "foo" =~ /(?{Pkg->new})/;
 376 ####
 377 "foo" =~ /(?{Pkg->$cb})/;
 378 ####
 379 "foo" =~ /(?{Pkg->$meth})/;
 380 ####
 381 "foo" =~ /(?{$x->new})/;
 382 ####
 383 "foo" =~ /(?{$x->$cb})/;
 384 ####
 385 "foo" =~ /(?{$x->$meth})/;
 386 ####
 387 "foo" =~ /(?{$y->new})/;
 388 ####
 389 "foo" =~ /(?{$y->$cb})/;
 390 ####
 391 "foo" =~ /(?{$y->$meth})/;
 392 ####
 393 exec $x $x, @a;
 394 ####
 395 exec { $a[0] } @a;
 396 ####
 397 system $x $x, @a;
 398 ####
 399 system { $a[0] } @a;
 400 ####
 401 zap { };
 402 ####
 403 zap { 1; };
 404 ####
 405 zap { 1; 1; };
 406 ####
 407 zap { zap { }; 1; };
 408 ####
 409 my @stuff = sort Pkg
 410      ->new;
 411 ####
 412 my @stuff = sort Pkg
 413               ->new;
 414 ####
 415 my @stuff = sort Pkg
 416                ->new;
 417 ####
 418 my @stuff = sort Pkg
 419                 ->new;
 420 ####
 421 my @stuff = sort Pkg
 422                  ->new;
 423 ####
 424 my @stuff = sort Pkg
 425                    ->new;
 426 ####
 427 my @stuff = sort Pkg
 428                      ->new;
 429 ####
 430 my @stuff = sort Pkg
 431                         ->new;
 432 ####
 433 sub {
 434  my $self = shift;
 435  return $self->new ? $self : undef;
 436 }
 437 ####
 438 sub {
 439  my $self = shift;
 440  return $self ? $self->new : undef;
 441 }
 442 ####
 443 sub {
 444  my $self = shift;
 445  return $_[0] ? undef : $self->new;
 446 }
 447 ####
 448 package Hurp;
 449 __PACKAGE__->new;
 450 ####
 451 package Hurp;
 452 __PACKAGE__->new # Hurp
 453 ####
 454 package Hurp;
 455 __PACKAGE__->new;
 456 # Hurp
 457 ####
 458 package __PACKAGE_;
 459 __PACKAGE__->new # __PACKAGE_
 460 ####
 461 package __PACKAGE_;
 462 __PACKAGE_->new # __PACKAGE__
 463 ####
 464 package __PACKAGE___;
 465 __PACKAGE__->new # __PACKAGE___
 466 ####
 467 package __PACKAGE___;
 468 __PACKAGE___->new # __PACKAGE__