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 => 56 * 8;
  13
  14 BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
  15
  16 my ($obj, $pkg, $cb, $x, @a);
  17 our $y;
  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 = $pkg->new   ;
 128 ####
 129 $obj = $pkg  ->   new  (   );
 130 ####
 131 $obj = $pkg
 132            ->
 133         new ( $pkg );
 134 ####
 135 $obj =
 136          $pkg
 137 ->
 138 new        (     qr/foo/,
 139       foo => qr/bar/   );
 140 ####
 141 $obj
 142   =
 143 $pkg
 144 ->
 145 $cb
 146 ;
 147 ####
 148 $obj = $pkg    ->   ($cb)   ();
 149 ####
 150 $obj = $pkg->$cb( $obj  );
 151 ####
 152 $obj = $pkg->$cb(qw/foo bar baz/);
 153 ####
 154 meh;
 155 ####
 156 meh $_;
 157 ####
 158 meh $x;
 159 ####
 160 meh $x, 1, 2;
 161 ####
 162 meh $y;
 163 ####
 164 meh $y, 1, 2;
 165 #### $] < 5.010 # use feature 'state'; state $z
 166 meh $z;
 167 #### $] < 5.010 # use feature 'state'; state $z
 168 meh $z, 1, 2;
 169 ####
 170 print;
 171 ####
 172 print $_;
 173 ####
 174 print $x;
 175 ####
 176 print $x "oh hai\n";
 177 ####
 178 print $y;
 179 ####
 180 print $y "dongs\n";
 181 #### $] < 5.010 # use feature 'state'; state $z
 182 print $z;
 183 #### $] < 5.010 # use feature 'state'; state $z
 184 print $z "hlagh\n";
 185 ####
 186 print STDOUT "bananananananana\n";
 187 ####
 188 $x->foo($pkg->$cb)
 189 ####
 190 $obj = "apple ${\(new Hlagh)} pear"
 191 ####
 192 $obj = "apple @{[new Hlagh]} pear"
 193 ####
 194 exec $x $x, @a;
 195 ####
 196 exec { $a[0] } @a;
 197 ####
 198 system $x $x, @a;
 199 ####
 200 system { $a[0] } @a;
 201 ####
 202 zap { };
 203 ####
 204 zap { 1; };
 205 ####
 206 zap { 1; 1; };
 207 ####
 208 zap { zap { }; 1; };